|
0
|
1 #!/usr/bin/perl -w |
|
|
2 |
|
|
3 # bins_edit for BINS Photo Album version 1.1.29 |
|
|
4 # Copyright (C) 2001-2004 J?r?me Sautret (Jerome@Sautret.org) |
|
|
5 # |
|
|
6 # $Id: bins_edit,v 1.21 2004/10/24 13:19:16 jerome Exp $ |
|
|
7 # |
|
|
8 # This program is free software; you can redistribute it and/or modify |
|
|
9 # it under the terms of the GNU General Public License as published by |
|
|
10 # the Free Software Foundation; either version 2 of the License, or |
|
|
11 # (at your option) any later version. |
|
|
12 # |
|
|
13 # This program is distributed in the hope that it will be useful, |
|
|
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
|
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
|
16 # GNU General Public License for more details. |
|
|
17 # |
|
|
18 # You should have received a copy of the GNU General Public License |
|
|
19 # along with this program; see the file COPYING. If not, write to |
|
|
20 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
|
|
21 # Boston, MA 02111-1307, USA. |
|
|
22 |
|
|
23 # Type "bins_edit -h" on command line for usage information. |
|
|
24 |
|
|
25 use strict; |
|
|
26 |
|
|
27 use Getopt::Long; |
|
|
28 use IO::File; |
|
|
29 use UNIVERSAL qw(isa); |
|
|
30 |
|
|
31 # XML parsing & writing |
|
|
32 use XML::Grove; |
|
|
33 use XML::Grove::Builder; |
|
|
34 use XML::Grove::Path; |
|
|
35 use XML::Grove::PerlSAX; |
|
|
36 use XML::Parser::PerlSAX; |
|
|
37 #use XML::Handler::XMLWriter; |
|
|
38 use XML::Handler::YAWriter; |
|
|
39 use Text::Iconv; |
|
|
40 use HTML::Entities; |
|
|
41 |
|
|
42 my $verbose = 1; |
|
|
43 my $html=0; |
|
|
44 |
|
|
45 my $localEncoding; |
|
|
46 $localEncoding = `locale charmap`; |
|
|
47 if ($? != 0 ) { |
|
|
48 $localEncoding = "LATIN1"; |
|
|
49 } |
|
|
50 else { |
|
|
51 if (! $localEncoding or ($localEncoding eq "ANSI_X3.4-1968")) { |
|
|
52 chop($localEncoding); |
|
|
53 # ANSI is unspeakably primitive, promote it. |
|
|
54 $localEncoding = "LATIN1"; |
|
|
55 print "Forcing encoding to $localEncoding\n" if ($verbose >=2); |
|
|
56 } |
|
|
57 } |
|
|
58 my $converter = Text::Iconv->new($localEncoding, "UTF-8"); |
|
|
59 |
|
|
60 # decode HTML entites which doesn't exist in XML |
|
|
61 sub decodeEntites{ |
|
|
62 my $s = shift; |
|
|
63 |
|
|
64 my %entities = ( |
|
|
65 AElig => '?', # capital AE diphthong (ligature) |
|
|
66 Aacute => '?', # capital A, acute accent |
|
|
67 Acirc => '?', # capital A, circumflex accent |
|
|
68 Agrave => '?', # capital A, grave accent |
|
|
69 Aring => '?', # capital A, ring |
|
|
70 Atilde => '?', # capital A, tilde |
|
|
71 Auml => '?', # capital A, dieresis or umlaut mark |
|
|
72 Ccedil => '?', # capital C, cedilla |
|
|
73 ETH => '?', # capital Eth, Icelandic |
|
|
74 Eacute => '?', # capital E, acute accent |
|
|
75 Ecirc => '?', # capital E, circumflex accent |
|
|
76 Egrave => '?', # capital E, grave accent |
|
|
77 Euml => '?', # capital E, dieresis or umlaut mark |
|
|
78 Iacute => '?', # capital I, acute accent |
|
|
79 Icirc => '?', # capital I, circumflex accent |
|
|
80 Igrave => '?', # capital I, grave accent |
|
|
81 Iuml => '?', # capital I, dieresis or umlaut mark |
|
|
82 Ntilde => '?', # capital N, tilde |
|
|
83 Oacute => '?', # capital O, acute accent |
|
|
84 Ocirc => '?', # capital O, circumflex accent |
|
|
85 Ograve => '?', # capital O, grave accent |
|
|
86 Oslash => '?', # capital O, slash |
|
|
87 Otilde => '?', # capital O, tilde |
|
|
88 Ouml => '?', # capital O, dieresis or umlaut mark |
|
|
89 THORN => '?', # capital THORN, Icelandic |
|
|
90 Uacute => '?', # capital U, acute accent |
|
|
91 Ucirc => '?', # capital U, circumflex accent |
|
|
92 Ugrave => '?', # capital U, grave accent |
|
|
93 Uuml => '?', # capital U, dieresis or umlaut mark |
|
|
94 Yacute => '?', # capital Y, acute accent |
|
|
95 aacute => '?', # small a, acute accent |
|
|
96 acirc => '?', # small a, circumflex accent |
|
|
97 aelig => '?', # small ae diphthong (ligature) |
|
|
98 agrave => '?', # small a, grave accent |
|
|
99 aring => '?', # small a, ring |
|
|
100 atilde => '?', # small a, tilde |
|
|
101 auml => '?', # small a, dieresis or umlaut mark |
|
|
102 ccedil => '?', # small c, cedilla |
|
|
103 eacute => '?', # small e, acute accent |
|
|
104 ecirc => '?', # small e, circumflex accent |
|
|
105 egrave => '?', # small e, grave accent |
|
|
106 eth => '?', # small eth, Icelandic |
|
|
107 euml => '?', # small e, dieresis or umlaut mark |
|
|
108 iacute => '?', # small i, acute accent |
|
|
109 icirc => '?', # small i, circumflex accent |
|
|
110 igrave => '?', # small i, grave accent |
|
|
111 iuml => '?', # small i, dieresis or umlaut mark |
|
|
112 ntilde => '?', # small n, tilde |
|
|
113 oacute => '?', # small o, acute accent |
|
|
114 ocirc => '?', # small o, circumflex accent |
|
|
115 ograve => '?', # small o, grave accent |
|
|
116 oslash => '?', # small o, slash |
|
|
117 otilde => '?', # small o, tilde |
|
|
118 ouml => '?', # small o, dieresis or umlaut mark |
|
|
119 szlig => '?', # small sharp s, German (sz ligature) |
|
|
120 thorn => '?', # small thorn, Icelandic |
|
|
121 uacute => '?', # small u, acute accent |
|
|
122 ucirc => '?', # small u, circumflex accent |
|
|
123 ugrave => '?', # small u, grave accent |
|
|
124 uuml => '?', # small u, dieresis or umlaut mark |
|
|
125 yacute => '?', # small y, acute accent |
|
|
126 yuml => '?', # small y, dieresis or umlaut mark |
|
|
127 |
|
|
128 # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96) |
|
|
129 copy => '?', # copyright sign |
|
|
130 reg => '?', # registered sign |
|
|
131 nbsp => "\240", # non breaking space |
|
|
132 |
|
|
133 # Additional ISO-8859/1 entities listed in rfc1866 (section 14) |
|
|
134 iexcl => '?', |
|
|
135 cent => '?', |
|
|
136 pound => '?', |
|
|
137 curren => '?', |
|
|
138 yen => '?', |
|
|
139 brvbar => '?', |
|
|
140 sect => '?', |
|
|
141 uml => '?', |
|
|
142 ordf => '?', |
|
|
143 laquo => '?', |
|
|
144 'not' => '?', # not is a keyword in perl |
|
|
145 shy => '?', |
|
|
146 macr => '?', |
|
|
147 deg => '?', |
|
|
148 plusmn => '?', |
|
|
149 sup1 => '?', |
|
|
150 sup2 => '?', |
|
|
151 sup3 => '?', |
|
|
152 acute => '?', |
|
|
153 micro => '?', |
|
|
154 para => '?', |
|
|
155 middot => '?', |
|
|
156 cedil => '?', |
|
|
157 ordm => '?', |
|
|
158 raquo => '?', |
|
|
159 frac14 => '?', |
|
|
160 frac12 => '?', |
|
|
161 frac34 => '?', |
|
|
162 iquest => '?', |
|
|
163 'times' => '?', # times is a keyword in perl |
|
|
164 divide => '?', |
|
|
165 ); |
|
|
166 |
|
|
167 while (my($entity, $char) = each(%entities)) { |
|
|
168 $s =~ s/\&$entity\;/$char/g; |
|
|
169 } |
|
|
170 return $s; |
|
|
171 } |
|
|
172 |
|
|
173 sub charac_indent{ |
|
|
174 my $n = shift(@_); |
|
|
175 my $s="\n"; |
|
|
176 for (1..$n){ |
|
|
177 $s .= " "; |
|
|
178 } |
|
|
179 return XML::Grove::Characters->new ( Data => $s ); |
|
|
180 } |
|
|
181 |
|
|
182 sub setField{ |
|
|
183 my $field = shift(@_); # field to add or modify |
|
|
184 my $value = shift(@_); # value to set to field |
|
|
185 my $fileType = shift(@_); # type of file (iamge or album) |
|
|
186 my $document = shift(@_); # XML document as a Grove |
|
|
187 |
|
|
188 if (! $html) { |
|
|
189 $value = encode_entities($value, '\00-\31<&"'); |
|
|
190 } |
|
|
191 |
|
|
192 my $characters = |
|
|
193 XML::Grove::Characters->new( Data => |
|
|
194 decodeEntites($value)); |
|
|
195 #my $characters = XML::Grove::Characters->new ( Data => $value ); |
|
|
196 |
|
|
197 my $fieldName; |
|
|
198 my $fieldValue; |
|
|
199 foreach my $element |
|
|
200 (@{$document->at_path('/'.$fileType.'/description')->{Contents}}) { |
|
|
201 if (isa($element, 'XML::Grove::Element') && $element->{Name} eq "field") { |
|
|
202 $fieldName = $element->{Attributes}{'name'}; |
|
|
203 $fieldValue = ""; |
|
|
204 if ($fieldName eq $field) { |
|
|
205 print " Modifying field '$fieldName' to '$value'... " |
|
|
206 if ($verbose >= 3); |
|
|
207 @{$element->{Contents}} = ( charac_indent(3), |
|
|
208 $characters, |
|
|
209 charac_indent(2)); |
|
|
210 print "OK.\n" if ($verbose >= 3); |
|
|
211 return; |
|
|
212 } |
|
|
213 } |
|
|
214 } |
|
|
215 |
|
|
216 print " Adding field '$field' with value '$value'... " if ($verbose >= 2); |
|
|
217 my $element = XML::Grove::Element->new ( Name => 'field', |
|
|
218 Contents => [charac_indent(3), |
|
|
219 $characters, |
|
|
220 charac_indent(2)], |
|
|
221 Attributes => {"name" => $field}); |
|
|
222 push @{$document->at_path('/'.$fileType.'/description')->{Contents}}, |
|
|
223 (charac_indent(2), $element, charac_indent(1)); |
|
|
224 |
|
|
225 print "OK.\n" if ($verbose >= 2); |
|
|
226 } |
|
|
227 |
|
|
228 sub setFields{ |
|
|
229 my $file = shift(@_); |
|
|
230 my $fields = shift(@_); |
|
|
231 my $album = shift(@_); # type of file (0 if image or 1 if album) |
|
|
232 my $document; |
|
|
233 |
|
|
234 my $fileType; |
|
|
235 if ($album) { |
|
|
236 $fileType = "album"; |
|
|
237 } else{ |
|
|
238 $fileType = "image"; |
|
|
239 } |
|
|
240 |
|
|
241 if (-e $file) { |
|
|
242 # Get XML document as a Grove |
|
|
243 print " Reading file '$file'... " if ($verbose >= 2); |
|
|
244 my $grove_builder = XML::Grove::Builder->new; |
|
|
245 my $parser = XML::Parser::PerlSAX->new ( Handler => $grove_builder ); |
|
|
246 $document = $parser->parse ( Source => { SystemId => $file } ); |
|
|
247 print "OK.\n" if ($verbose >= 2); |
|
|
248 } else { |
|
|
249 print " Creating file '$file'... " if ($verbose >= 2); |
|
|
250 my @elements; |
|
|
251 push @elements, (charac_indent(1), |
|
|
252 XML::Grove::Element->new ( Name => 'description', |
|
|
253 Contents => [charac_indent(1)]), |
|
|
254 charac_indent(1), |
|
|
255 XML::Grove::Element->new ( Name => 'bins', |
|
|
256 Contents => [charac_indent(1)]), |
|
|
257 ); |
|
|
258 if (!$album) { |
|
|
259 push @elements, ( charac_indent(1), |
|
|
260 XML::Grove::Element->new ( Name => 'exif', |
|
|
261 Contents => |
|
|
262 [charac_indent(1)]), |
|
|
263 ); |
|
|
264 } |
|
|
265 push @elements, charac_indent(0); |
|
|
266 my $element = |
|
|
267 XML::Grove::Element->new ( Name => $fileType, |
|
|
268 Contents => \@elements); |
|
|
269 $document = XML::Grove::Document->new ( Contents => [ $element ] ); |
|
|
270 print "OK.\n" if ($verbose >= 3); |
|
|
271 } |
|
|
272 |
|
|
273 my $fieldName; |
|
|
274 my $fieldValue; |
|
|
275 while ( ($fieldName, $fieldValue) = each(%$fields) ) { |
|
|
276 if (defined $fieldValue) { |
|
|
277 setField($fieldName, $fieldValue, $fileType, $document); |
|
|
278 } |
|
|
279 } |
|
|
280 |
|
|
281 print " Writing file '$file'... " if ($verbose >= 2); |
|
|
282 # Write the Grove to the desc file |
|
|
283 my $fileHandler = new IO::File; |
|
|
284 open($fileHandler, '>', $file) |
|
|
285 or die("Cannot open file $file to write Exif tag ($!)"); |
|
|
286 binmode($fileHandler, ":utf8") if $^V ge v5.8.0; |
|
|
287 |
|
|
288 my $my_handler = new XML::Handler::YAWriter( 'Output' => $fileHandler, |
|
|
289 # 'Escape' => { |
|
|
290 # '--' => '—', |
|
|
291 #'&' => '&', |
|
|
292 # }, |
|
|
293 'Encoding' => "UTF-8", |
|
|
294 ); |
|
|
295 # my $my_handler = XML::Handler::XMLWriter->new( Output => $fileHandler, |
|
|
296 # Newlines => 0); |
|
|
297 $document->parse(DocumentHandler => $my_handler); |
|
|
298 close ($fileHandler) || bail ("can't close $file ($!)"); |
|
|
299 print "OK.\n" if ($verbose >= 2); |
|
|
300 } |
|
|
301 |
|
|
302 sub copyleft{ |
|
|
303 print "\nbins_edit for BINS Photo Album 1.1.29 (http://bins.sautret.org/)\n"; |
|
|
304 print "Copyright ? 2001-2004 J?r?me Sautret (Jerome\@Sautret.org)\n"; |
|
|
305 print "This is free software with ABSOLUTELY NO WARRANTY.\n"; |
|
|
306 print "See COPYING file for details.\n\n"; |
|
|
307 } |
|
|
308 |
|
|
309 sub usage{ |
|
|
310 my $exit=shift; # should we exit after usage information ? |
|
|
311 copyleft(); |
|
|
312 |
|
|
313 print <<EoF ; |
|
|
314 bins_edit is a script to set fields in XML pictures description files for BINS. |
|
|
315 |
|
|
316 usage: |
|
|
317 bins_edit [-a|--album] [-m|--html] |
|
|
318 [-t|--title title] [-e|--event event] [-l|--location location] |
|
|
319 [-p|--people people] [-y|--date date] [-d|--description description] |
|
|
320 [--longdesc longDescription] [--shortdesc shortDesription] |
|
|
321 [--sample pictureFileName] |
|
|
322 [-g|--generic tag=value] |
|
|
323 [-h|--help] [-v|--verbose] [-q|--quiet] file [files...] |
|
|
324 |
|
|
325 EoF |
|
|
326 |
|
|
327 if ($exit){ |
|
|
328 print "Type bins_edit --help for complete help.\n"; |
|
|
329 exit ($exit); |
|
|
330 } |
|
|
331 } |
|
|
332 |
|
|
333 |
|
|
334 sub help{ |
|
|
335 usage(0); |
|
|
336 print <<EoF ; |
|
|
337 Options: |
|
|
338 -t, --title, -e, --event event, -l, --location, |
|
|
339 -p, --people, -y, --date, -d, --description : |
|
|
340 these switchs are used to set a value to a picture |
|
|
341 desciption field. |
|
|
342 -t, --title, --longdesc, --shortdesc, --sample : |
|
|
343 these switchs are used to set a value to an album |
|
|
344 desciption field (with --album option) |
|
|
345 -a, --album : edit album description. |
|
|
346 (default is editing image description) |
|
|
347 In this case, the file parameter must be the |
|
|
348 source directory of the album. |
|
|
349 Only the --title, --longdesc, --shortdesc and --sample |
|
|
350 switchs have sense with this option. |
|
|
351 -m, --html : input value will be considering as HTML code, thus, |
|
|
352 no HTML encoding will be done. |
|
|
353 -v, --verbose : this switch can appear several times to increase |
|
|
354 verbosity level. |
|
|
355 -q, --quiet : suppress output |
|
|
356 |
|
|
357 If filenames have no .xml suffix, it is added, so you can directly give |
|
|
358 picture names on the command line. |
|
|
359 Spaces and other special characters (even newlines) can be used in values |
|
|
360 given as parameters as long as they are enclosed between quotes. |
|
|
361 |
|
|
362 Examples: |
|
|
363 Set the title of the Image.jpg file to "My picture": |
|
|
364 bins_edit -t "My picture" Image.jpg |
|
|
365 |
|
|
366 Set the title and location of all JPEG pictures in the directory: |
|
|
367 bins_edit --title Holiday --location Paris *.jpg |
|
|
368 |
|
|
369 Use of HTML values: |
|
|
370 bins_edit --html --description '<b>BINS</b> is cool' file.jpg |
|
|
371 |
|
|
372 Set the title short description and sample image of the album |
|
|
373 in the current directory (note the dot as final parameter): |
|
|
374 bins_edit -a -t "My Album" --sample image.jpg --shortdesc "This is my album" . |
|
|
375 |
|
|
376 EoF |
|
|
377 |
|
|
378 exit 1; |
|
|
379 } |
|
|
380 |
|
|
381 |
|
|
382 sub main{ |
|
|
383 my %values; |
|
|
384 my $album = 0; # 1 if it a album description file |
|
|
385 |
|
|
386 |
|
|
387 # process args |
|
|
388 Getopt::Long::Configure("bundling"); |
|
|
389 GetOptions('t|title:s' => \$values{title}, |
|
|
390 'e|event:s' => \$values{event}, |
|
|
391 'l|location:s' => \$values{location}, |
|
|
392 'p|people:s' => \$values{people}, |
|
|
393 'y|date:s' => \$values{date}, |
|
|
394 'd|description:s' => \$values{description}, |
|
|
395 'longdesc:s' => \$values{longdesc}, |
|
|
396 'shortdesc:s' => \$values{shortdesc}, |
|
|
397 'sample:s' => \$values{sampleimage}, |
|
|
398 'g|generic=s%' => \%values, |
|
|
399 'm|html' => \$html, |
|
|
400 'a|album' => \$album, |
|
|
401 'v|verbose+' => \$verbose, |
|
|
402 'q|quiet' => sub { $verbose = 0 }, |
|
|
403 'h|help' => sub { help() }, |
|
|
404 'copyright' => sub { copyleft() }, |
|
|
405 ) |
|
|
406 or usage(1); |
|
|
407 |
|
|
408 my @files; |
|
|
409 if ($#ARGV < 0) { |
|
|
410 if ($album) { |
|
|
411 @files = ("."); |
|
|
412 } else { |
|
|
413 print "No files specified.\n"; |
|
|
414 usage(1) |
|
|
415 } |
|
|
416 } else { |
|
|
417 @files = @ARGV; |
|
|
418 } |
|
|
419 |
|
|
420 copyleft() if ($verbose >=2); |
|
|
421 |
|
|
422 foreach my $file (@files) { |
|
|
423 if ($album) { |
|
|
424 $file .= "/album.xml"; |
|
|
425 } |
|
|
426 if ($file !~ m/.xml$/) { |
|
|
427 $file .= ".xml"; |
|
|
428 } |
|
|
429 print "Processing file '$file'... " if ($verbose >= 1); |
|
|
430 print "\n" if ($verbose >= 2); |
|
|
431 setFields($file, \%values, $album); |
|
|
432 print "OK.\n" if ($verbose == 1); |
|
|
433 } |
|
|
434 } |
|
|
435 |
|
|
436 main(); |
