Mercurial > bins

comparison bins_edit @ 0:a84c32f131df 1.1.29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import vendor version
author Peter Gervai <grin@grin.hu>
date Wed, 15 Oct 2008 23:28:56 +0200
parents
children 3021deef1599
comparison
equal deleted inserted replaced
-1:000000000000 0:a84c32f131df
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 # '--' => '&mdash;',
291 #'&' => '&amp;',
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();