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