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 );
+ − 411
+ − 412 my @files ;
+ − 413 if ( $#ARGV < 0 ) {
+ − 414 if ( $album ) {
+ − 415 @files = ( "." );
+ − 416 } else {
+ − 417 print "No files specified.\n" ;
+ − 418 usage ( 1 )
+ − 419 }
+ − 420 } else {
+ − 421 @files = @ARGV ;
+ − 422 }
+ − 423
+ − 424 copyleft () if ( $verbose >= 2 );
+ − 425
+ − 426 foreach my $file ( @files ) {
+ − 427 if ( $album ) {
+ − 428 $file .= "/album.xml" ;
+ − 429 }
+ − 430 if ( $file !~ m/.xml$/ ) {
+ − 431 $file .= ".xml" ;
+ − 432 }
+ − 433 print "Processing file '$file'... " if ( $verbose >= 1 );
+ − 434 print "\n" if ( $verbose >= 2 );
+ − 435 setFields ( $file , \ %values , $album );
+ − 436 print "OK.\n" if ( $verbose == 1 );
+ − 437 }
+ − 438 }
+ − 439
+ − 440 main ();
