· 7 years ago · Nov 07, 2018, 09:14 PM
1#!/usr/bin/perl -w
2#------------------------------------------------------------------------------
3# File: exiftool
4#
5# Description: Read/write meta information
6#
7# Revisions: Nov. 12/03 - P. Harvey Created
8# (See html/history.html for revision history)
9#
10# References: ATV - Alexander Vonk, private communication
11#------------------------------------------------------------------------------
12#
13# Copyright 2003-2017, Phil Harvey
14#
15# This is free software; you can redistribute it and/or modify it under the
16# same terms as Perl itself.
17#
18# "pdf2john.pl" was glued together by Dhiru Kholia.
19
20use strict;
21require 5.004;
22
23my $version = '8.99';
24
25# add our 'lib' directory to the include list BEFORE 'use ExifTool'
26my $exeDir;
27BEGIN {
28 # get exe directory
29 $exeDir = ($0 =~ /(.*)[\\\/]/) ? $1 : '.';
30 # add lib directory at start of include path
31 unshift @INC, "$exeDir/lib";
32 # load or disable config file if specified
33 if (@ARGV and lc($ARGV[0]) eq '-config') {
34 shift;
35 $ExifTool::configFile = shift;
36 }
37}
38use ExifTool qw{:Public Open};
39
40# function prototypes
41sub SigInt();
42sub SigCont();
43sub Cleanup();
44sub GetImageInfo($$);
45sub SetImageInfo($$$);
46sub CleanXML($);
47sub EncodeXML($);
48sub FormatXML($$$);
49sub EscapeJSON($;$);
50sub FormatJSON($$$);
51sub PrintCSV();
52sub ConvertBinary($);
53sub AddSetTagsFile($;$);
54sub DoSetFromFile($$$);
55sub CleanFilename($);
56sub ProcessFiles($;$);
57sub ScanDir($$;$);
58sub PreserveTime();
59sub LoadPrintFormat($);
60sub FilenameSPrintf($;$);
61sub NextUnusedFilename($;$);
62sub CreateDirectory($);
63sub OpenOutputFile($);
64sub AcceptFile($);
65sub SlurpFile($$);
66sub Rename($$);
67sub ReadStayOpen($);
68sub PrintTagList($@);
69sub PrintErrors($$$);
70
71$SIG{INT} = 'SigInt'; # do cleanup on Ctrl-C
72$SIG{CONT} = 'SigCont'; # (allows break-out of delays)
73END {
74 Cleanup();
75}
76
77# declare all static file-scope variables
78my @commonArgs; # arguments common to all commands
79my @csvFiles; # list of files when reading with CSV option
80my @csvTags; # order of tags for first file with CSV option (lower case)
81my @delFiles; # list of files to delete
82my @dynamicFiles; # list of -tagsFromFile files with dynamic names and -TAG<=FMT pairs
83my @exclude; # list of excluded tags
84my @files; # list of files and directories to scan
85my @moreArgs; # more arguments to process after -stay_open -@
86my @newValues; # list of new tag values to set
87my @srcFmt; # source file name format strings
88my @tags; # list of tags to extract
89my %csvTags; # lookup for all found tags with CSV option (lower case keys)
90my %database; # lookup for database information based on file name
91my %filterExt; # lookup for filtered extensions
92my %ignore; # directory names to ignore
93my %preserveTime; # preserved timestamps for files
94my %printFmt; # the contents of the print format file
95my %setTags; # hash of list references for tags to set from files
96my %setTagsList; # list of other tag lists for multiple -tagsFromFile from the same file
97my %warnedOnce; # lookup for once-only warnings
98my $allGroup; # show group name for all tags
99my $argFormat; # use exiftool argument-format output
100my $binaryOutput; # flag for binary output (undef or 1, or 0 for binary XML/PHP)
101my $binaryStdout; # flag set if we output binary to stdout
102my $comma; # flag set if we need a comma in JSON output
103my $condition; # conditional processing of files
104my $count; # count of files scanned
105my $countBad; # count of files with errors
106my $countBadCr; # count files not created due to errors
107my $countBadWr; # count write errors
108my $countCopyWr; # count of files copied without being changed
109my $countCreated; # count output files created
110my $countDir; # count of directories scanned
111my $countFailed; # count files that failed condition
112my $countGoodCr; # count files created OK
113my $countGoodWr; # count files written OK
114my $countNewDir; # count of directories created
115my $countSameWr; # count files written OK but not changed
116my $critical; # flag for critical operations (disable CTRL-C)
117my $csv; # flag for CSV option (set to "CSV", or maybe "JSON" when writing)
118my $csvAdd; # flag to add CSV information to existing lists
119my $csvSaveCount; # save counter for last CSV file loaded
120my $deleteOrig; # 0=restore original files, 1=delete originals, 2=delete w/o asking
121my $disableOutput; # flag to disable normal output
122my $doSetFileName; # flag set if FileName may be written
123my $doUnzip; # flag to extract info from .gz and .bz2 files
124my $escapeHTML; # flag to escape printed values for html
125my $evalWarning; # warning from eval
126my $executeID; # -execute ID number
127my $fileHeader; # header to print to output file (or console, once)
128my $fileTrailer; # trailer for output file
129my $filtered; # flag indicating file was filtered by name
130my $filterFlag; # file filter flag (0x01=deny extensions, 0x02=allow extensions)
131my $fixLen; # flag to fix description lengths when writing alternate languages
132my $forcePrint; # force printing of tags whose values weren't found
133my $helped; # flag to avoid printing help if no tags specified
134my $html; # flag for html-formatted output (2=html dump)
135my $interrupted; # flag set if CTRL-C is pressed during a critical process
136my $isWriting; # flag set if we are writing tags
137my $joinLists; # flag set to join list values into a single string
138my $json; # flag for JSON/PHP output format (1=JSON, 2=PHP)
139my $listItem; # item number for extracting single item from a list
140my $listSep; # list item separator (', ' by default)
141my $mainTool; # main ExifTool object
142my $multiFile; # non-zero if we are scanning multiple files
143my $outFormat; # -1=Canon format, 0=same-line, 1=tag names, 2=values only
144my $outOpt; # output file or directory name
145my $overwriteOrig; # flag to overwrite original file
146my $pause; # pause before returning
147my $preserveTime; # flag to preserve times of updated files
148my $progress; # progress cound
149my $progressMax; # total number of files to process
150my $progStr; # progress message string
151my $quiet; # flag to disable printing of informational messages / warnings
152my $recurse; # recurse into subdirectories
153my $rtnVal; # command return value (0=success)
154my $saveCount; # count the number of times we will/did call SaveNewValues()
155my $scanWritable; # flag to process only writable file types
156my $seqFileNum; # sequential file number used for %C
157my $showGroup; # number of group to show (may be zero or '')
158my $showTagID; # non-zero to show tag ID's
159my $stayOpenBuff='';# buffer for -stay_open file
160my $stayOpenFile; # name of the current -stay_open argfile
161my $structOpt; # output structured XMP information (JSON and XML output only)
162my $tabFormat; # non-zero for tab output format
163my $textOut; # extension for text output file (or undef for no output)
164my $textOverwrite; # flag to overwrite existing text output file
165my $tmpFile; # temporary file to delete on exit
166my $tmpText; # temporary text file
167my $utf8; # flag set if we are using UTF-8 encoding
168my $validFile; # flag indicating we processed a valid file
169my $verbose; # verbose setting
170my $xml; # flag for XML-formatted output
171
172# flag to keep the input -@ argfile open:
173# 0 = normal behaviour
174# 1 = received "-stay_open true" and waiting for argfile to keep open
175# 2 = currently reading from STAYOPEN argfile
176# 3 = waiting for -@ to switch to a new STAYOPEN argfile
177my $stayOpen = 0;
178
179# lookup for O/S names which may use a backslash as a directory separator
180# (ref File::Spec of PathTools-3.2701)
181my %hasBackslash = ( MSWin32 => 1, os2 => 1, dos => 1, NetWare => 1, symbian => 1, cygwin => 1 );
182
183# lookup for O/S names which use CR/LF newlines
184my $isCRLF = { MSWin32 => 1, os2 => 1, dos => 1 }->{$^O};
185
186# lookup for JSON characters that we escape specially
187my %jsonChar = ( '"'=>'"', '\\'=>'\\', "\t"=>'t', "\n"=>'n', "\r"=>'r' );
188
189# options requiring additional arguments
190# (used only to skip over these arguments when reading -stay_open ARGFILE)
191my %optArgs = (
192 '-tagsfromfile' => 1, '-addtagsfromfile' => 1, '-alltagsfromfile' => 1,
193 '-@' => 1,
194 '-c' => 1, '-coordformat' => 1,
195 '-charset' => 0, # (optional arg; OK because arg cannot begin with "-")
196 '-config' => 1,
197 '-d' => 1, '-dateformat' => 1,
198 '-D' => 0, # nececessary to avoid matching lower-case equivalent
199 '-echo' => 1, '-echo2' => 1,
200 '-ext' => 1, '--ext' => 1, '-extension' => 1, '--extension' => 1,
201 '-fileorder' => 1,
202 '-geotag' => 1,
203 '-i' => 1, '-ignore' => 1,
204 '-if' => 1,
205 '-lang' => 0, # (optional arg; cannot begin with "-")
206 '-listitem' => 1,
207 '-o' => 1, '-out' => 1,
208 '-p' => 1, '-printformat' => 1,
209 '-P' => 0,
210 '-password' => 1,
211 '-require' => 1,
212 '-sep' => 1, '-separator' => 1,
213 '-srcfile' => 1,
214 '-stay_open' => 1,
215 '-use' => 1,
216 '-w' => 1, '-w!' => 1, '-textout' => 1, '-textout!' => 1,
217 '-x' => 1, '-exclude' => 1,
218 '-X' => 0,
219);
220
221# exit routine
222sub Exit {
223 if ($pause) {
224 if (eval 'require Term::ReadKey') {
225 print STDERR "-- press any key --";
226 Term::ReadKey::ReadMode('cbreak');
227 Term::ReadKey::ReadKey(0);
228 Term::ReadKey::ReadMode(0);
229 print STDERR "\b \b" x 20;
230 } else {
231 print STDERR "-- press RETURN --\n";
232 <STDIN>;
233 }
234 }
235 exit shift;
236}
237# my warning and error routines (NEVER say "die"!)
238sub Warn { warn(@_) if $quiet < 2 or $_[0] =~ /^Error/; }
239sub Error { Warn @_; $rtnVal = 1; }
240sub WarnOnce($) {
241 Warn(@_) and $warnedOnce{$_[0]} = 1 unless $warnedOnce{$_[0]};
242}
243
244# define signal handlers and cleanup routine
245sub SigInt() {
246 $critical and $interrupted = 1, return;
247 Cleanup();
248 exit 1;
249}
250sub SigCont() { }
251sub Cleanup() {
252 unlink $tmpFile if defined $tmpFile;
253 unlink $tmpText if defined $tmpText;
254 undef $tmpFile;
255 undef $tmpText;
256 PreserveTime() if %preserveTime;
257}
258
259#------------------------------------------------------------------------------
260# main script
261#
262
263# isolate arguments common to all commands
264if (grep /^-common_args$/i, @ARGV) {
265 my (@newArgs, $common);
266 foreach (@ARGV) {
267 if (/^-common_args$/i) {
268 $common = 1;
269 } elsif ($common) {
270 push @commonArgs, $_;
271 } else {
272 push @newArgs, $_;
273 }
274 }
275 @ARGV = @newArgs if $common;
276}
277
278#..............................................................................
279# loop over sets of command-line arguments separated by "-execute"
280Command: while (@ARGV or not defined $rtnVal or $stayOpen >= 2 or @commonArgs)
281{
282
283# attempt to restore text mode for STDOUT if necessary
284if ($binaryStdout) {
285 binmode(STDOUT,':crlf') if $] >= 5.006 and $isCRLF;
286 $binaryStdout = 0;
287}
288
289# flush console and print "{ready}" message if -stay_open is in effect
290if ($stayOpen >= 2 and not $quiet) {
291 eval 'require IO::Handle' and STDERR->flush();
292 my $id = defined $executeID ? $executeID : '';
293 my $save = $|;
294 $| = 1; # turn on output autoflush for stdout
295 print "{ready$id}\n";
296 $| = $save; # restore original autoflush setting
297}
298
299$rtnVal = 0 unless defined $rtnVal;
300
301# initialize necessary static file-scope variables
302# (not done: @commonArgs, @moreArgs, $critical, $binaryStdout, $helped,
303# $interrupted, $mainTool, $pause, $rtnVal, $stayOpen, $stayOpenBuff, $stayOpenFile)
304undef @dynamicFiles;
305undef @exclude;
306undef @files;
307undef @newValues;
308undef @srcFmt;
309undef @tags;
310undef %database;
311undef %filterExt;
312undef %ignore;
313undef %printFmt;
314undef %preserveTime;
315undef %setTags;
316undef %setTagsList;
317undef %warnedOnce;
318undef $allGroup;
319undef $argFormat;
320undef $binaryOutput;
321undef $comma;
322undef $condition;
323undef $deleteOrig;
324undef $disableOutput;
325undef $doSetFileName;
326undef $escapeHTML;
327undef $evalWarning;
328undef $executeID;
329undef $fileHeader;
330undef $fileTrailer;
331undef $filtered;
332undef $fixLen;
333undef $forcePrint;
334undef $joinLists;
335undef $listItem;
336undef $multiFile;
337undef $outOpt;
338undef $preserveTime;
339undef $progress;
340undef $progressMax;
341undef $recurse;
342undef $scanWritable;
343undef $showGroup;
344undef $showTagID;
345undef $structOpt;
346undef $textOut;
347undef $textOverwrite;
348undef $tmpFile;
349undef $tmpText;
350undef $validFile;
351undef $verbose;
352
353$count = 0;
354$countBad = 0;
355$countBadCr = 0;
356$countBadWr = 0;
357$countCopyWr = 0;
358$countCreated = 0;
359$countDir = 0;
360$countFailed = 0;
361$countGoodCr = 0;
362$countGoodWr = 0;
363$countNewDir = 0;
364$countSameWr = 0;
365$csvSaveCount = 0;
366$filterFlag = 0;
367$html = 0;
368$isWriting = 0;
369$json = 0;
370$listSep = ', ';
371$outFormat = 0;
372$overwriteOrig = 0;
373$progStr = '';
374$quiet = 0;
375$saveCount = 0;
376$seqFileNum = 0;
377$tabFormat = 0;
378$utf8 = 1;
379$xml = 0;
380
381# define local variables used only in this command loop
382my @fileOrder; # tags to use for ordering of input files
383my %excludeGrp; # hash of tags excluded by group
384my $addGeotime; # automatically added geotime argument
385my $allInGroup; # flag to show all tags in a group
386my $doGlob; # flag set to do filename wildcard expansion
387my $escapeXML; # flag to escape printed values for xml
388my $setTagsFile; # filename for last TagsFromFile option
389my $sortOpt; # sort option is used
390my $useMWG; # flag set if we are using any MWG tag
391
392my ($argsLeft, @nextPass);
393my $pass = 0;
394
395# for Windows, use globbing for wildcard expansion if available - MK/20061010
396if ($^O eq 'MSWin32' and eval 'require File::Glob') {
397 # override the core glob forcing case insensitivity
398 import File::Glob qw(:globally :nocase);
399 $doGlob = 1;
400}
401
402$mainTool = new ExifTool; # create ExifTool object
403
404# don't extract duplicates by default unless set by UserDefined::Options
405$mainTool->Options(Duplicates => 0) unless %ExifTool::UserDefined::Options
406 and defined $ExifTool::UserDefined::Options{Duplicates};
407
408# parse command-line options in 2 passes...
409# pass 1: set all of our ExifTool options
410# pass 2: print all of our help and informational output (-list, -ver, etc)
411for (;;) {
412
413 # execute the command now if no more arguments or -execute is used
414 if (not @ARGV or $ARGV[0] =~ /^-execute(\d*)$/i) {
415 if (@ARGV) {
416 $executeID = $1; # save -execute number for "{ready}" response
417 $helped = 1; # don't show help if we used -execute
418 } elsif ($stayOpen >= 2) {
419 ReadStayOpen(\@ARGV); # read more arguments from -stay_open file
420 next;
421 }
422 if ($pass == 0) {
423 # insert common arguments now if not done already
424 if (@commonArgs and not defined $argsLeft) {
425 # count the number of arguments remaining for subsequent commands
426 $argsLeft = scalar(@ARGV) + scalar(@moreArgs);
427 unshift @ARGV, @commonArgs;
428 # all done with commonArgs if this is the end of the command
429 undef @commonArgs unless $argsLeft;
430 next;
431 }
432 # check if we have more arguments now than we did before we processed
433 # the common arguments. If so, then we have an infinite processing loop
434 if (defined $argsLeft and $argsLeft < scalar(@ARGV) + scalar(@moreArgs)) {
435 Warn "Ignoring -common_args from $ARGV[0] onwards to avoid infinite recursion\n";
436 while ($argsLeft < scalar(@ARGV) + scalar(@moreArgs)) {
437 @ARGV and shift(@ARGV), next;
438 shift @moreArgs;
439 }
440 }
441 # require MWG module if used in any argument
442 # (note: this also covers the -p option because these tags were added to @tags)
443 $useMWG = 1 if not $useMWG and grep /^mwg:/i, @tags;
444 require ExifTool::MWG if $useMWG;
445 }
446 if (@nextPass) {
447 # process arguments which were deferred to the next pass
448 unshift @ARGV, @nextPass;
449 undef @nextPass;
450 ++$pass;
451 next;
452 }
453 @ARGV and shift; # remove -execute from argument list
454 last; # process the command now
455 }
456 $_ = shift;
457 if (s/^(-|\xe2\x88\x92)//) { # allow funny dashes (nroff dash bug for cut-n-paste from pod)
458 s/^\xe2\x88\x92/-/; # translate double-dash too
459 my $a = lc $_;
460 if (/^list([wfrdx]|wf|g(\d*))?$/i) {
461 $pass or push(@nextPass,"-$_");
462 my $type = lc($1 || '');
463 if (not $type or $type eq 'w' or $type eq 'x') {
464 my $group;
465 if ($ARGV[0] and $ARGV[0] =~ /^(-|\xe2\x88\x92)(.+):(all|\*)$/i) {
466 if ($pass == 0) {
467 $useMWG = 1 if lc($2) eq 'mwg';
468 push(@nextPass, shift);
469 next;
470 }
471 $group = $2;
472 shift;
473 $group =~ /IFD/i and Warn("Can't list tags for specific IFD\n"), next;
474 $group =~ /^(all|\*)$/ and undef $group;
475 } else {
476 $pass or next;
477 }
478 $helped = 1;
479 if ($type eq 'x') {
480 require ExifTool::TagInfoXML;
481 my %opts;
482 $opts{Flags} = 1 if $forcePrint;
483 $opts{NoDesc} = 1 if $outFormat > 0;
484 ExifTool::TagInfoXML::Write(undef, $group, %opts);
485 next;
486 }
487 my $wr = ($type eq 'w');
488 my $msg = ($wr ? 'Writable' : 'Available') . ($group ? " $group" : '') . ' tags';
489 PrintTagList($msg, $wr ? GetWritableTags($group) : GetAllTags($group));
490 # also print shortcuts if listing all tags
491 next if $group or $wr;
492 my @tagList = GetShortcuts();
493 PrintTagList('Command-line shortcuts', @tagList) if @tagList;
494 next;
495 }
496 $pass or next;
497 $helped = 1;
498 if ($type eq 'wf') {
499 my @wf;
500 CanWrite($_) and push @wf, $_ foreach GetFileType();
501 PrintTagList('Writable file extensions', @wf);
502 } elsif ($type eq 'f') {
503 PrintTagList('Supported file extensions', GetFileType());
504 } elsif ($type eq 'r') {
505 PrintTagList('Recognized file extensions', GetFileType(undef, 0));
506 } elsif ($type eq 'd') {
507 PrintTagList('Deletable groups', GetDeleteGroups());
508 } else { # 'g(\d*)'
509 # list all groups in specified family
510 my $family = $2 || 0;
511 PrintTagList("Groups in family $family", GetAllGroups($family));
512 }
513 next;
514 }
515 if (/^(all|add)?tagsfromfile(=.*)?$/i) {
516 $setTagsFile = $2 ? substr($2,1) : (@ARGV ? shift : '');
517 if ($setTagsFile eq '') {
518 Error("File must be specified for -tagsFromFile option\n");
519 next Command;
520 }
521 # create necessary lists, etc for this new -tagsFromFile file
522 AddSetTagsFile($setTagsFile, { Replace => ($1 and lc($1) eq 'add') ? 0 : 1 } );
523 next;
524 }
525 if ($a eq '@') {
526 my $argFile = shift or Error("Expecting filename for -\@ option\n"), next Command;
527 # switch to new ARGFILE if using chained -stay_open options
528 if ($stayOpen == 1) {
529 # defer remaining arguments until we close this argfile
530 @moreArgs = @ARGV;
531 undef @ARGV;
532 } elsif ($stayOpen == 3) {
533 if ($stayOpenFile and $stayOpenFile ne '-' and $argFile eq $stayOpenFile) {
534 # don't allow user to switch to the same -stay_open argfile
535 # because it will result in endless recursion
536 $stayOpen = 2;
537 Warn "Ignoring request to switch to the same -stay_open ARGFILE ($argFile)\n";
538 next;
539 }
540 close STAYOPEN;
541 $stayOpen = 1; # switch to this -stay_open file
542 }
543 my $fp = ($stayOpen == 1 ? \*STAYOPEN : \*ARGFILE);
544 unless (Open($fp, $argFile)) {
545 unless ($argFile !~ /^\// and Open($fp, "$exeDir/$argFile")) {
546 Error "Error opening arg file $argFile\n";
547 next Command;
548 }
549 }
550 if ($stayOpen == 1) {
551 $stayOpenFile = $argFile; # remember the name of the file we have open
552 $stayOpenBuff = ''; # initialize buffer for reading this file
553 $stayOpen = 2;
554 $helped = 1;
555 ReadStayOpen(\@ARGV);
556 next;
557 }
558 my (@newArgs, $didBOM);
559 foreach (<ARGFILE>) {
560 # filter Byte Order Mark if it exists from start of UTF-8 text file
561 unless ($didBOM) {
562 s/^\xef\xbb\xbf//;
563 $didBOM = 1;
564 }
565 s/^\s+//; s/[\x0d\x0a]+$//s; # remove leading white space and trailing newline
566 # remove white space before, and single space after '=', '+=', '-=' or '<='
567 s/^(-[-:\w]+#?)\s*([-+<]?=) ?/$1$2/;
568 push @newArgs, $_ unless $_ eq '' or /^#/;
569 }
570 close ARGFILE;
571 unshift @ARGV, @newArgs;
572 next;
573 }
574 /^(-?)(a|duplicates)$/i and $mainTool->Options(Duplicates => ($1 ? 0 : 1)), next;
575 /^arg(s|format)$/i and $argFormat = 1, next;
576 /^b(inary)?$/i and $mainTool->Options(Binary => 1), $binaryOutput = 1, next;
577 if (/^c(oordFormat)?$/i) {
578 my $fmt = shift;
579 $fmt or Error("Expecting coordinate format for -c option\n"), next Command;
580 $mainTool->Options('CoordFormat', $fmt);
581 next;
582 }
583 if ($a eq 'charset') {
584 my $charset = (@ARGV and $ARGV[0] !~ /^(-|\xe2\x88\x92)/) ? shift : undef;
585 if (not $charset) {
586 $pass or push(@nextPass, '-charset'), next;
587 my %charsets;
588 $charsets{$_} = 1 foreach values %ExifTool::charsetName;
589 PrintTagList('Available character sets', sort keys %charsets);
590 $helped = 1;
591 } elsif ($charset !~ s/^(\w+)=// or lc($1) eq 'exiftool') {
592 $mainTool->Options(Charset => $charset);
593 $utf8 = ($mainTool->Options('Charset') eq 'UTF8');
594 } else {
595 # set internal encoding of specified metadata type
596 my $type = { id3 => 'ID3', iptc => 'IPTC', exif => 'EXIF',
597 photoshop => 'Photoshop', quicktime => 'QuickTime' }->{lc $1};
598 $type or Warn("Unknown type for -charset option: $1\n"), next;
599 $mainTool->Options("Charset$type" => $charset);
600 }
601 next;
602 }
603 /^config$/i and Warn("Ignored -config option (not first on command line)\n"), shift, next;
604 if (/^csv(\+?=.*)?/i) {
605 my $csvFile = $1;
606 # must process on 2nd pass so -f option is available
607 unless ($pass) {
608 push(@nextPass,"-$_");
609 if ($csvFile) {
610 push @newValues, { SaveCount => ++$saveCount }; # marker to save new values now
611 $csvSaveCount = $saveCount;
612 }
613 next;
614 }
615 if ($csvFile) {
616 $csvFile =~ s/^(\+?=)//;
617 $csvAdd = 2 if $1 eq '+=';
618 $verbose and print "Reading CSV file $csvFile\n";
619 require ExifTool::Import;
620 my $msg = ExifTool::Import::ReadCSV($csvFile, \%database, $forcePrint);
621 $msg and Warn("$msg\n");
622 $isWriting = 1;
623 }
624 $csv = 'CSV';
625 next;
626 }
627 if (/^d$/ or $a eq 'dateformat') {
628 my $fmt = shift;
629 $fmt or Error("Expecting date format for -d option\n"), next Command;
630 $mainTool->Options('DateFormat', $fmt);
631 next;
632 }
633 (/^D$/ or $a eq 'decimal') and $showTagID = 'D', next;
634 /^delete_original(!?)$/i and $deleteOrig = ($1 ? 2 : 1), next;
635 (/^e$/ or $a eq '-composite') and $mainTool->Options(Composite => 0), next;
636 (/^-e$/ or $a eq 'composite') and $mainTool->Options(Composite => 1), next;
637 (/^E$/ or $a eq 'escapehtml') and require ExifTool::HTML and $escapeHTML = 1, next;
638 ($a eq 'ex' or $a eq 'escapexml') and $escapeXML = 1, next;
639 if (/^echo(2)?$/i) {
640 next unless @ARGV;
641 $pass or push(@nextPass, "-$_", shift), next;
642 print {$1 ? \*STDERR : \*STDOUT} shift, "\n";
643 $helped = 1;
644 next;
645 }
646 if (/^(ee|extractembedded)$/i) {
647 $mainTool->Options(ExtractEmbedded => 1);
648 $mainTool->Options(Duplicates => 1);
649 next;
650 }
651 # (-execute handled at top of loop)
652 if (/^-?ext(ension)?$/i) {
653 my $ext = shift;
654 defined $ext or Error("Expecting extension for -ext option\n"), next Command;
655 $ext =~ s/^\.//; # remove leading '.' if it exists
656 my $flag = /^-/ ? 0 : 1;
657 $filterFlag |= (0x01 << $flag);
658 $filterExt{uc($ext)} = $flag;
659 next;
660 }
661 if (/^f$/ or $a eq 'forceprint') {
662 $forcePrint = 1;
663 $mainTool->Options(MissingTagValue => '-');
664 next;
665 }
666 if (/^F([-+]?\d*)$/ or /^fixbase([-+]?\d*)$/i) {
667 $mainTool->Options(FixBase => $1);
668 next;
669 }
670 if (/^fast(\d*)$/i) {
671 $mainTool->Options(FastScan => (length $1 ? $1 : 1));
672 next;
673 }
674 if ($a eq 'fileorder') {
675 push @fileOrder, shift if @ARGV;
676 next;
677 }
678 $a eq 'globaltimeshift' and $mainTool->Options(GlobalTimeShift => shift), next;
679 if (/^(g)(roupHeadings|roupNames)?([\d:]*)$/i) {
680 $showGroup = $3 || 0;
681 $allGroup = ($2 ? lc($2) eq 'roupnames' : $1 eq 'G');
682 $mainTool->Options(SavePath => 1) if $showGroup =~ /\b5\b/;
683 next;
684 }
685 if ($a eq 'geotag') {
686 my $trkfile = shift;
687 $trkfile or Error("Expecting file name for -geotag option\n"), next Command;
688 # allow wildcards in filename
689 if ($trkfile =~ /[*?]/) {
690 # CORE::glob() splits on white space, so use File::Glob if possible
691 my @trks = eval('require File::Glob') ? File::Glob::bsd_glob($trkfile) : glob($trkfile);
692 @trks or Error("No matching file found for -geotag option\n"), next Command;
693 push @newValues, 'geotag='.shift(@trks) while @trks > 1;
694 $trkfile = pop(@trks);
695 }
696 $_ = "geotag=$trkfile";
697 # (fall through!)
698 }
699 if (/^h$/ or $a eq 'htmlformat') {
700 require ExifTool::HTML;
701 $html = $escapeHTML = 1;
702 $json = $xml = 0;
703 next;
704 }
705 (/^H$/ or $a eq 'hex') and $showTagID = 'H', next;
706 if (/^htmldump([-+]?\d+)?$/i) {
707 $verbose = ($verbose || 0) + 1;
708 $html = 2;
709 $mainTool->Options(HtmlDumpBase => $1) if defined $1;
710 next;
711 }
712 if (/^i(gnore)?$/i) {
713 my $dir = shift;
714 defined $dir or Error("Expecting directory name for -i option\n"), next Command;
715 $ignore{$dir} = 1;
716 next;
717 }
718 if ($a eq 'if') {
719 my $cond = shift;
720 defined $cond or Error("Expecting expression for -if option\n"), next Command;
721 $useMWG = 1 if $cond =~ /\$\{?mwg:/i;
722 if (defined $condition) {
723 $condition .= " and ($cond)";
724 } else {
725 $condition = "($cond)";
726 }
727 next;
728 }
729 if (/^j(son)?(\+?=.*)?$/i) {
730 if ($2) {
731 # must process on 2nd pass because we need -f and -charset options
732 unless ($pass) {
733 push(@nextPass,"-$_");
734 push @newValues, { SaveCount => ++$saveCount }; # marker to save new values now
735 $csvSaveCount = $saveCount;
736 next;
737 }
738 my $jsonFile = $2;
739 $jsonFile =~ s/^(\+?=)//;
740 $csvAdd = 2 if $1 eq '+=';
741 $verbose and print "Reading JSON file $jsonFile\n";
742 my $chset = $mainTool->Options('Charset');
743 require ExifTool::Import;
744 my $msg = ExifTool::Import::ReadJSON($jsonFile, \%database, $forcePrint, $chset);
745 $msg and Warn("$msg\n");
746 $isWriting = 1;
747 $csv = 'JSON';
748 } else {
749 $json = 1;
750 $html = $xml = 0;
751 $mainTool->Options(Duplicates => 1);
752 require ExifTool::XMP; # for FixUTF8()
753 }
754 next;
755 }
756 /^(k|pause)$/i and $pause = 1, next;
757 (/^l$/ or $a eq 'long') and --$outFormat, next;
758 (/^L$/ or $a eq 'latin') and $utf8 = 0, $mainTool->Options(Charset => 'Latin'), next;
759 if ($a eq 'lang') {
760 my $lang = (@ARGV and $ARGV[0] !~ /^-/) ? shift : undef;
761 if ($lang) {
762 # make lower case and use underline as a separator (ie. 'en_ca')
763 $lang =~ tr/-A-Z/_a-z/;
764 $mainTool->Options(Lang => $lang);
765 next if $lang eq $mainTool->Options('Lang');
766 } else {
767 $pass or push(@nextPass, '-lang'), next;
768 }
769 my $langs = "Available languages:\n";
770 $langs .= " $_ - $ExifTool::langName{$_}\n" foreach @ExifTool::langs;
771 $langs =~ tr/_/-/; # display dashes instead of underlines in language codes
772 $langs = $mainTool->Decode($langs, 'UTF8');
773 $langs = ExifTool::HTML::EscapeHTML($langs) if $escapeHTML;
774 $lang and Error("Invalid or unsupported language '$lang'.\n$langs"), next Command;
775 print $langs;
776 $helped = 1;
777 next;
778 }
779 if ($a eq 'listitem') {
780 $listItem = shift;
781 defined $listItem or Warn("Expecting index for -listItem option\n");
782 next;
783 }
784 /^(m|ignoreminorerrors)$/i and $mainTool->Options(IgnoreMinorErrors => 1), next;
785 /^(n|-printconv)$/i and $mainTool->Options(PrintConv => 0), next;
786 /^(-n|printconv)$/i and $mainTool->Options(PrintConv => 1), next;
787 if (/^o(ut)?$/i) {
788 $outOpt = shift;
789 defined $outOpt or Error("Expected output file or directory name for -o option\n"), next Command;
790 CleanFilename($outOpt);
791 next;
792 }
793 /^overwrite_original$/i and $overwriteOrig = 1, next;
794 /^overwrite_original_in_place$/i and $overwriteOrig = 2, next;
795 (/^p$/ or $a eq 'printformat') and LoadPrintFormat(shift), next;
796 (/^P$/ or $a eq 'preserve') and $preserveTime = 1, next;
797 /^password$/i and $mainTool->Options(Password => shift), next;
798 if ($a eq 'progress') {
799 $progress = 0;
800 $verbose = 0 unless defined $verbose;
801 next;
802 }
803 /^q(uiet)?$/i and ++$quiet, next;
804 /^r(ecurse)?$/i and $recurse = 1, next;
805 if ($a eq 'require') { # undocumented, added in version 8.65
806 my $ver = shift;
807 unless (defined $ver and ExifTool::IsFloat($ver)) {
808 Error("Expecting version number for -require option\n");
809 next Command;
810 }
811 unless ($ExifTool::VERSION >= $ver) {
812 Error("Requires ExifTool version $ver or later\n");
813 next Command;
814 }
815 next;
816 }
817 /^restore_original$/i and $deleteOrig = 0, next;
818 (/^S$/ or $a eq 'veryshort') and $outFormat+=2, next;
819 /^s(hort)?(\d*)$/i and $outFormat = $2 eq '' ? $outFormat + 1 : $2, next;
820 /^scanforxmp$/i and $mainTool->Options(ScanForXMP => 1), next;
821 if (/^sep(arator)?$/i) {
822 $listSep = shift;
823 defined $listSep or Error("Expecting list item separator for -sep option\n"), next Command;
824 $mainTool->Options(ListSep => $listSep);
825 $joinLists = 1;
826 # also split when writing values
827 my $listSplit = quotemeta $listSep;
828 # a space in the string matches zero or more whitespace characters
829 $listSplit =~ s/(\\ )+/\\s\*/g;
830 # but a single space alone matches one or more whitespace characters
831 $listSplit = '\\s+' if $listSplit eq '\\s*';
832 $mainTool->Options(ListSplit => $listSplit);
833 next;
834 }
835 /^sort$/i and $sortOpt = 1, next;
836 if ($a eq 'srcfile') {
837 @ARGV or Warn("Expecting FMT for -srcfile option\n"), next;
838 push @srcFmt, shift;
839 next;
840 }
841 if ($a eq 'stay_open') {
842 my $arg = shift;
843 defined $arg or Warn("Expecting argument for -stay_open option\n"), next;
844 if ($arg =~ /^(1|true)$/i) {
845 if (not $stayOpen) {
846 $stayOpen = 1;
847 } elsif ($stayOpen == 2) {
848 $stayOpen = 3; # chained -stay_open options
849 } else {
850 Warn "-stay_open already active\n";
851 }
852 } elsif ($arg =~ /^(0|false)$/i) {
853 if ($stayOpen >= 2) {
854 # close -stay_open argfile and process arguments up to this point
855 close STAYOPEN;
856 push @ARGV, @moreArgs;
857 undef @moreArgs;
858 } elsif (not $stayOpen) {
859 Warn("-stay_open wasn't active\n");
860 }
861 $stayOpen = 0;
862 } else {
863 Warn "Invalid argument for -stay_open\n";
864 }
865 next;
866 }
867 if (/^(-)?struct$/i) {
868 $structOpt = $1 ? 0 : 1;
869 $mainTool->Options(Struct => $structOpt);
870 # require XMPStruct in case we need to serialize a structure
871 require 'Image/ExifTool/XMPStruct.pl' if $structOpt;
872 next;
873 }
874 /^t(ab)?$/ and $tabFormat = 1, next;
875 if (/^T$/ or $a eq 'table') {
876 $tabFormat = 1; $outFormat+=2; ++$quiet; $forcePrint = 1;
877 $mainTool->Options(MissingTagValue => '-');
878 next;
879 }
880 if (/^(u)(nknown(2)?)?$/i) {
881 my $inc = ($3 or (not $2 and $1 eq 'U')) ? 2 : 1;
882 $mainTool->Options(Unknown => $mainTool->Options('Unknown') + $inc);
883 next;
884 }
885 if ($a eq 'use') {
886 my $module = shift;
887 $module or Error("Expecting module name for -use option\n"), next Command;
888 lc $module eq 'mwg' and $useMWG = 1, next;
889 local $SIG{'__WARN__'} = sub { $evalWarning = $_[0] };
890 unless (eval "require ExifTool::$module" or
891 eval "require $module" or
892 eval "require '$module'")
893 {
894 delete $SIG{'__WARN__'};
895 Error("Error using module $module\n");
896 next Command;
897 }
898 next;
899 }
900 if (/^v(erbose)?(\d*)$/i) {
901 $verbose = ($2 eq '') ? ($verbose || 0) + 1 : $2;
902 next;
903 }
904 if (/^(w|textout)(!?)$/i) {
905 $textOut = shift || Warn("Expecting output extension for -$_ option\n");
906 $textOverwrite = $2;
907 next;
908 }
909 if (/^x$/ or $a eq 'exclude') {
910 my $tag = shift;
911 defined $tag or Error("Expecting tag name for -x option\n"), next Command;
912 $tag =~ s/\ball\b/\*/ig; # replace 'all' with '*' in tag names
913 if ($setTagsFile) {
914 push @{$setTags{$setTagsFile}}, "-$tag";
915 } else {
916 push @exclude, $tag;
917 }
918 next;
919 }
920 (/^X$/ or $a eq 'xmlformat') and $xml = 1, $html = $json = 0, $mainTool->Options(Duplicates => 1), next;
921 if (/^php$/i) {
922 $json = 2;
923 $html = $xml = 0;
924 $mainTool->Options(Duplicates=>1);
925 next;
926 }
927 /^z(ip)?$/i and $doUnzip = 1, $mainTool->Options(Compress => 1, Compact => 1), next;
928 $_ eq '' and push(@files, '-'), next; # read STDIN
929 length $_ eq 1 and $_ ne '*' and Error("Unknown option -$_\n"), next Command;
930 if (/^[^<]+(<?)=(.*)/s) {
931 my $val = $2;
932 if ($1 and length($val) and ($val eq '@' or not defined FilenameSPrintf($val))) {
933 # save count of new values before a dynamic value
934 push @newValues, { SaveCount => ++$saveCount };
935 }
936 push @newValues, $_;
937 if (/^mwg:/i) {
938 $useMWG = 1;
939 } elsif (/^([-\w]+:)*(filename|directory)\b/i) {
940 $doSetFileName = 1;
941 } elsif (/^([-\w]+:)*(geotag|geotime)\b/i) {
942 if (lc $2 eq 'geotag') {
943 if ((not defined $addGeotime or $addGeotime) and length $val) {
944 $addGeotime = ($1 || '') . 'Geotime<DateTimeOriginal';
945 }
946 } else {
947 $addGeotime = '';
948 }
949 }
950 } else {
951 # assume '-tagsFromFile @' if tags are being redirected
952 # and -tagsFromFile hasn't already been specified
953 AddSetTagsFile($setTagsFile = '@') if not $setTagsFile and /(<|>)/;
954 if ($setTagsFile) {
955 push @{$setTags{$setTagsFile}}, $_;
956 if (/>/) {
957 $useMWG = 1 if /^(.*>\s*)?mwg:/si;
958 if (/\b(filename|directory)#?$/i) {
959 $doSetFileName = 1;
960 } elsif (/\bgeotime#?$/i) {
961 $addGeotime = '';
962 }
963 } else {
964 $useMWG = 1 if /^([^<]+<\s*(.*\$\{?)?)?mwg:/si;
965 if (/^([-\w]+:)*(filename|directory)\b/i) {
966 $doSetFileName = 1;
967 } elsif (/^([-\w]+:)*geotime\b/i) {
968 $addGeotime = '';
969 }
970 }
971 } elsif (/^-(.*)/) {
972 push @exclude, $1;
973 } else {
974 push @tags, $_;
975 }
976 }
977 } elsif ($doGlob and /[*?]/) {
978 # glob each filespec if necessary - MK/20061010
979 push @files, File::Glob::bsd_glob($_);
980 $doGlob = 2;
981 } else {
982 push @files, $_;
983 }
984}
985
986# change default EXIF string encoding if MWG used
987if ($useMWG and not defined $mainTool->Options('CharsetEXIF')) {
988 $mainTool->Options(CharsetEXIF => 'UTF8');
989}
990
991# print help
992unless ((@tags and not $outOpt) or @files or @newValues) {
993 if ($doGlob and $doGlob == 2) {
994 Warn "No matching files\n";
995 $rtnVal = 1;
996 next;
997 }
998 if ($outOpt) {
999 Warn "Nothing to write\n";
1000 $rtnVal = 1;
1001 next;
1002 }
1003 unless ($helped) {
1004 # catch warnings if we have problems running perldoc
1005 local $SIG{'__WARN__'} = sub { $evalWarning = $_[0] };
1006 my $dummy = \*SAVEERR; # avoid "used only once" warning
1007 unless ($^O eq 'os2') {
1008 open SAVEERR, ">&STDERR";
1009 open STDERR, '>/dev/null';
1010 }
1011 if (system('perldoc',$0)) {
1012 print "Syntax: pdf2john.pl <.pdf file(s)>\n";
1013 # print "Consult the exiftool documentation for a full list of options.\n";
1014 }
1015 unless ($^O eq 'os2') {
1016 close STDERR;
1017 open STDERR, '>&SAVEERR';
1018 }
1019 }
1020 next;
1021}
1022
1023# do sanity check on -delete_original and -restore_original
1024if (defined $deleteOrig and (@newValues or @tags)) {
1025 if (not @newValues) {
1026 my $verb = $deleteOrig ? 'deleting' : 'restoring from';
1027 Warn "Can't specify tags when $verb originals\n";
1028 } elsif ($deleteOrig) {
1029 Warn "Can't use -delete_original when writing.\n";
1030 Warn "Maybe you meant -overwrite_original ?\n";
1031 } else {
1032 Warn "It makes no sense to use -restore_original when writing\n";
1033 }
1034 $rtnVal = 1;
1035 next;
1036}
1037
1038if ($overwriteOrig > 1 and $outOpt) {
1039 Warn "Can't overwrite in place when -o option is used\n";
1040 $rtnVal = 1;
1041 next;
1042}
1043
1044if ($escapeHTML or $json) {
1045 # must be UTF8 for HTML conversion and JSON output
1046 $mainTool->Options(Charset => 'UTF8');
1047 # use Escape option to do our HTML escaping unless XML output
1048 $mainTool->Options(Escape => 'HTML') if $escapeHTML and not $xml;
1049} elsif ($escapeXML and not $xml) {
1050 $mainTool->Options(Escape => 'XML');
1051}
1052
1053# set sort option
1054if ($sortOpt) {
1055 # (note that -csv sorts alphabetically by default anyway if more than 1 file)
1056 my $sort = ($outFormat > 0 or $xml or $json or $csv) ? 'Tag' : 'Descr';
1057 $mainTool->Options(Sort => $sort, Sort2 => $sort);
1058}
1059
1060# set up for RDF/XML, JSON and PHP output formats
1061if ($xml) {
1062 require ExifTool::XMP; # for EscapeXML()
1063 my $charset = $mainTool->Options('Charset');
1064 # standard XML encoding names for supported Charset settings
1065 # (ref http://www.iana.org/assignments/character-sets)
1066 my %encoding = (
1067 UTF8 => 'UTF-8',
1068 Latin => 'windows-1252',
1069 Latin2 => 'windows-1250',
1070 Cyrillic => 'windows-1251',
1071 Greek => 'windows-1253',
1072 Turkish => 'windows-1254',
1073 Hebrew => 'windows-1255',
1074 Arabic => 'windows-1256',
1075 Baltic => 'windows-1257',
1076 Vietnam => 'windows-1258',
1077 MacRoman => 'macintosh',
1078 );
1079 # switch to UTF-8 if we don't have a standard encoding name
1080 unless ($encoding{$charset}) {
1081 $charset = 'UTF8';
1082 $mainTool->Options(Charset => $charset);
1083 }
1084 # set file header/trailer for XML output
1085 $fileHeader = "<?xml version='1.0' encoding='$encoding{$charset}'?>\n" .
1086 "<rdf:RDF xmlns:rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#'>\n";
1087 $fileTrailer = "</rdf:RDF>\n";
1088 # extract as a list unless short output format
1089 $joinLists = 1 if $outFormat > 0;
1090 $mainTool->Options(List => 1) unless $joinLists;
1091 $showGroup = $allGroup = 1; # always show group 1
1092 # set binaryOutput flag to 0 or undef (0 = output encoded binary in XML)
1093 $binaryOutput = ($outFormat > 0 ? undef : 0) if $binaryOutput;
1094 $showTagID = 'D' if $tabFormat and not $showTagID;
1095} elsif ($json) {
1096 if ($json == 1) { # JSON
1097 $fileHeader = '[';
1098 $fileTrailer = "]\n";
1099 undef $binaryOutput; # can't currently use -b with -json
1100 } else { # PHP
1101 $fileHeader = 'Array(';
1102 $fileTrailer = ");\n";
1103 # allow binary output in a text-mode file when -php and -b used together
1104 # (this works because PHP strings are simple arrays of bytes, and CR/LF
1105 # won't be messed up in the text mode output because they are converted
1106 # to escape sequences in the strings)
1107 $binaryOutput = 0 if $binaryOutput;
1108 }
1109 $mainTool->Options(List => 1) unless $joinLists;
1110 $mainTool->Options(Duplicates => 0) unless defined $showGroup;
1111} elsif ($structOpt) {
1112 $mainTool->Options(List => 1);
1113} else {
1114 $joinLists = 1; # join lists for all other unstructured output formats
1115}
1116
1117if ($argFormat) {
1118 $outFormat = 3;
1119 $allGroup = 1 if defined $showGroup;
1120}
1121
1122# change to forward slashes if necessary in all filenames (like CleanFilename)
1123if ($hasBackslash{$^O}) {
1124 tr/\\/\// foreach @files;
1125}
1126
1127# can't do anything if no file specified
1128unless (@files) {
1129 unless ($outOpt) {
1130 Warn "No file specified\n";
1131 $rtnVal = 1;
1132 next;
1133 }
1134 push @files, ''; # create file from nothing
1135}
1136
1137# set Verbose and HtmlDump options
1138if ($verbose) {
1139 $disableOutput = 1 unless @tags or @exclude;
1140 undef $binaryOutput; # disable conflicting option
1141 if ($html) {
1142 $html = 2; # flag for html dump
1143 $mainTool->Options(HtmlDump => $verbose);
1144 } else {
1145 $mainTool->Options(Verbose => $verbose);
1146 }
1147} elsif (defined $verbose) {
1148 # auto-flush output when -v0 is used
1149 require FileHandle;
1150 STDOUT->autoflush(1);
1151 STDERR->autoflush(1);
1152}
1153
1154# validate all tags we're writing
1155my $needSave = 1;
1156if (@newValues) {
1157 # assume -geotime value if -geotag specified without -geotime
1158 if ($addGeotime) {
1159 AddSetTagsFile($setTagsFile = '@') unless $setTagsFile and $setTagsFile eq '@';
1160 push @{$setTags{$setTagsFile}}, $addGeotime;
1161 $verbose and print qq{Argument "-$addGeotime" is assumed\n};
1162 }
1163 my %setTagsIndex;
1164 # add/delete option lookup
1165 my %addDelOpt = ( '+' => 'AddValue', '-' => 'DelValue', "\xe2\x88\x92" => 'DelValue' );
1166 $saveCount = 0;
1167 foreach (@newValues) {
1168 if (ref $_ eq 'HASH') {
1169 # save new values now if we stored a "SaveCount" marker
1170 if ($$_{SaveCount}) {
1171 $saveCount = $mainTool->SaveNewValues();
1172 $needSave = 0;
1173 # insert marker to load values from CSV file now if this was the CSV file
1174 push @dynamicFiles, \$csv if $$_{SaveCount} == $csvSaveCount;
1175 }
1176 next;
1177 }
1178 /(.*?)=(.*)/s or next;
1179 my ($tag, $newVal) = ($1, $2);
1180 $tag =~ s/\ball\b/\*/ig; # replace 'all' with '*' in tag names
1181 $newVal eq '' and undef $newVal; # undefined to delete tag
1182 if ($tag =~ /^(All)?TagsFromFile$/i) {
1183 defined $newVal or Error("Need file name for -tagsFromFile\n"), next Command;
1184 ++$isWriting;
1185 if ($newVal eq '@' or not defined FilenameSPrintf($newVal)) {
1186 push @dynamicFiles, $newVal;
1187 next; # set tags from dynamic file later
1188 }
1189 unless (-e $newVal) {
1190 Warn "File '$newVal' does not exist for -tagsFromFile option\n";
1191 $rtnVal = 1;
1192 next Command;
1193 }
1194 my $setTags = $setTags{$newVal};
1195 # do we have multiple -tagsFromFile options with this file?
1196 if ($setTagsList{$newVal}) {
1197 # use the tags set in the i-th occurrence
1198 my $i = $setTagsIndex{$newVal} || 0;
1199 $setTagsIndex{$newVal} = $i + 1;
1200 $setTags = $setTagsList{$newVal}[$i] if $setTagsList{$newVal}[$i];
1201 }
1202 # set specified tags from this file
1203 unless (DoSetFromFile($mainTool, $newVal, $setTags)) {
1204 $rtnVal = 1;
1205 next Command;
1206 }
1207 $needSave = 1;
1208 next;
1209 }
1210 my %opts = (
1211 Protected => 1, # allow writing of 'unsafe' tags
1212 Shift => 0, # shift values if possible instead of adding/deleting
1213 );
1214 if ($tag =~ s/<// and defined $newVal) {
1215 if (defined FilenameSPrintf($newVal)) {
1216 SlurpFile($newVal, \$newVal) or next;
1217 } else {
1218 $tag =~ s/([-+]|\xe2\x88\x92)$// and $opts{$addDelOpt{$1}} = 1;
1219 # verify that this tag can be written
1220 my $result = ExifTool::IsWritable($tag);
1221 if ($result) {
1222 $opts{ProtectSaved} = $saveCount; # protect new values set after this
1223 # add to list of dynamic tag values
1224 push @dynamicFiles, [ $tag, $newVal, \%opts ];
1225 ++$isWriting;
1226 } elsif (defined $result) {
1227 Warn "Tag '$tag' is not writable\n";
1228 } else {
1229 Warn "Tag '$tag' does not exist\n";
1230 }
1231 next;
1232 }
1233 }
1234 if ($tag =~ s/([-+]|\xe2\x88\x92)$//) {
1235 $opts{$addDelOpt{$1}} = 1; # set AddValue or DelValue option
1236 # set $newVal to '' if deleting nothing
1237 $newVal = '' if $1 eq '-' and not defined $newVal;
1238 }
1239 my ($rtn, $wrn) = $mainTool->SetNewValue($tag, $newVal, %opts);
1240 $needSave = 1;
1241 ++$isWriting if $rtn;
1242 $wrn and Warn "Warning: $wrn\n";
1243 }
1244 # exclude specified tags
1245 foreach (@exclude) {
1246 $mainTool->SetNewValue($_, undef, Replace => 2);
1247 $needSave = 1;
1248 }
1249 unless ($isWriting or $outOpt or @tags) {
1250 Warn "Nothing to do.\n";
1251 $rtnVal = 1;
1252 next;
1253 }
1254} elsif (grep /^(\*:)?\*$/, @exclude) {
1255 Warn "All tags excluded -- nothing to do.\n";
1256 $rtnVal = 1;
1257 next;
1258}
1259if ($isWriting and @tags and not $outOpt) {
1260 my ($tg, $s) = @tags > 1 ? ("$tags[0] ...", 's') : ($tags[0], '');
1261 Warn "Ignored superfluous tag name$s or invalid option$s: -$tg\n";
1262}
1263# save current state of new values if setting values from target file
1264# or if we may be translating to a different format
1265$mainTool->SaveNewValues() if $outOpt or (@dynamicFiles and $needSave);
1266
1267$multiFile = 1 if @files > 1;
1268@exclude and $mainTool->Options(Exclude => \@exclude);
1269
1270# set flag to fix description lengths if necessary
1271$fixLen = ($utf8 and $mainTool->Options('Lang') ne 'en' and eval 'require Encode');
1272
1273# sort input files if specified
1274if (@fileOrder) {
1275 my @allFiles;
1276 ProcessFiles(undef, \@allFiles);
1277 my $sortTool = new ExifTool;
1278 $sortTool->Options(PrintConv => $mainTool->Options('PrintConv'));
1279 $sortTool->Options(Duplicates => 0);
1280 my (%sortBy, %isFloat, @rev, $file);
1281 # save reverse sort flags
1282 push @rev, (s/^-// ? 1 : 0) foreach @fileOrder;
1283 foreach $file (@allFiles) {
1284 my @tags;
1285 my $info = $sortTool->ImageInfo($file, @fileOrder, \@tags);
1286 # get values of all tags (or '~' to sort last if not defined)
1287 foreach (@tags) {
1288 $_ = $$info{$_};
1289 defined $_ or $_ = '~', next;
1290 $isFloat{$_} = 1 if /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
1291 }
1292 $sortBy{$file} = \@tags; # save tag values for each file
1293 }
1294 # sort in specified order
1295 @files = sort {
1296 my ($i, $cmp);
1297 for ($i=0; $i<@rev; ++$i) {
1298 my $u = $sortBy{$a}[$i];
1299 my $v = $sortBy{$b}[$i];
1300 if (not $isFloat{$u} and not $isFloat{$v}) {
1301 $cmp = $u cmp $v; # alphabetically
1302 } elsif ($isFloat{$u} and $isFloat{$v}) {
1303 $cmp = $u <=> $v; # numerically
1304 } else {
1305 $cmp = $isFloat{$u} ? -1 : 1; # numbers first
1306 }
1307 return $rev[$i] ? -$cmp : $cmp if $cmp;
1308 }
1309 return $a cmp $b; # default to sort by name
1310 } @allFiles;
1311} elsif (defined $progress) {
1312 # expand FILE argument to count the number of files to process
1313 my @allFiles;
1314 ProcessFiles(undef, \@allFiles);
1315 @files = @allFiles;
1316}
1317# set file count for progress message
1318$progressMax = scalar @files if defined $progress;
1319
1320# store duplicate database information under canonical filenames
1321my @dbKeys = keys %database;
1322if (@dbKeys and require Cwd) {
1323 foreach (@dbKeys) {
1324 my $canonFile = Cwd::abs_path($_);
1325 if (defined $canonFile) {
1326 $database{$canonFile} = $database{$_} unless $database{$canonFile};
1327 } else {
1328 # (may happen on Mac if the filename encoding is incorrect in the database)
1329 Warn "Error generating canonical filename for $_\n";
1330 }
1331 }
1332}
1333
1334# process all specified files
1335ProcessFiles($mainTool);
1336
1337if ($filtered and not $validFile) {
1338 Warn "No file with specified extension\n";
1339 $rtnVal = 1;
1340}
1341
1342# print file trailer if necessary
1343print $fileTrailer if $fileTrailer and not $textOut and not $fileHeader;
1344
1345if (defined $deleteOrig) {
1346
1347 # print summary and delete requested files
1348 unless ($quiet) {
1349 printf "%5d directories scanned\n", $countDir if $countDir;
1350 printf "%5d directories created\n", $countNewDir if $countNewDir;
1351 printf "%5d files failed condition\n", $countFailed if $countFailed;
1352 printf "%5d image files found\n", $count;
1353 }
1354 if (@delFiles) {
1355 # verify deletion unless "-delete_original!" was specified
1356 if ($deleteOrig == 1) {
1357 printf '%5d originals will be deleted! Are you sure [y/n]? ', scalar(@delFiles);
1358 my $response = <STDIN>;
1359 unless ($response =~ /^(y|yes)\s*$/i) {
1360 Warn "Originals not deleted.\n";
1361 next;
1362 }
1363 }
1364 $countGoodWr = unlink @delFiles;
1365 $countBad = scalar(@delFiles) - $countGoodWr;
1366 }
1367 if ($quiet) {
1368 # no more messages
1369 } elsif ($count and not $countGoodWr and not $countBad) {
1370 printf "%5d original files found\n", $countGoodWr;
1371 } elsif ($deleteOrig) {
1372 printf "%5d original files deleted\n", $countGoodWr if $count;
1373 printf "%5d originals not deleted due to errors\n", $countBad if $countBad;
1374 } else {
1375 printf "%5d image files restored from original\n", $countGoodWr if $count;
1376 printf "%5d files not restored due to errors\n", $countBad if $countBad;
1377 }
1378
1379} elsif (not $binaryStdout and not $quiet) {
1380
1381}
1382
1383# set error status if we had any errors or if all files failed the "-if" condition
1384$rtnVal = 1 if $countBadWr or $countBadCr or $countBad or ($countFailed and not $count);
1385
1386# last ditch effort to preserve filemodifydate
1387PreserveTime() if %preserveTime;
1388
1389} # end "Command" loop ........................................................
1390
1391close STAYOPEN if $stayOpen >= 2;
1392
1393Exit $rtnVal; # all done
1394
1395
1396#------------------------------------------------------------------------------
1397# Get image information from EXIF data in file
1398# Inputs: 0) ExifTool object reference, 1) file name
1399sub GetImageInfo($$)
1400{
1401 my ($exifTool, $orig) = @_;
1402 my (@foundTags, $info, $file, $ind);
1403
1404 # determine the name of the source file based on the original input file name
1405 if (@srcFmt) {
1406 my ($fmt, $first);
1407 foreach $fmt (@srcFmt) {
1408 $file = $fmt eq '@' ? $orig : FilenameSPrintf($fmt, $orig);
1409 # use this file if it exists
1410 -e $file and undef($first), last;
1411 $verbose and print "Source file $file does not exist\n";
1412 $first = $file unless defined $first;
1413 }
1414 $file = $first if defined $first;
1415 } else {
1416 $file = $orig;
1417 }
1418 printf("%s:", $file);
1419
1420 my $pipe = $file;
1421 if ($doUnzip) {
1422 # pipe through gzip or bzip2 if necessary
1423 if ($file =~ /\.gz$/i) {
1424 $pipe = qq{gzip -dc "$file" |};
1425 } elsif ($file =~ /\.bz2$/i) {
1426 $pipe = qq{bzip2 -dc "$file" |};
1427 }
1428 }
1429 # evaluate -if expression for conditional processing
1430 if (defined $condition) {
1431 unless ($file eq '-' or -e $file) {
1432 Warn "File not found: $file\n";
1433 ++$countBad;
1434 return;
1435 }
1436 # catch run time errors as well as compile errors
1437 undef $evalWarning;
1438 local $SIG{'__WARN__'} = sub { $evalWarning = $_[0] };
1439
1440 my %info;
1441 # extract information and build expression for evaluation
1442 my $opts = { Duplicates => 1, Verbose => 0, HtmlDump => 0 };
1443 # return all tags but explicitly mention tags on command line so
1444 # requested images will generate the appropriate warnings
1445 @foundTags = ('*', @tags) if @tags;
1446 $info = $exifTool->ImageInfo($pipe, \@foundTags, $opts);
1447 my $cond = $exifTool->InsertTagValues(\@foundTags, $condition, \%info);
1448
1449 #### eval "-if" condition (%info)
1450 my $result = eval $cond;
1451
1452 $@ and $evalWarning = $@;
1453 if ($evalWarning) {
1454 # fail condition if warning is issued
1455 undef $result;
1456 if ($verbose) {
1457 chomp $evalWarning;
1458 $evalWarning =~ s/ at \(eval .*//s;
1459 delete $SIG{'__WARN__'};
1460 Warn "Condition: $evalWarning - $file\n";
1461 }
1462 }
1463 unless ($result) {
1464 $verbose and print "-------- $file (failed condition)$progStr\n";
1465 ++$countFailed;
1466 return;
1467 }
1468 # can't make use of $info if verbose because we must reprocess
1469 # the file anyway to generate the verbose output
1470 undef $info if $verbose;
1471 }
1472 if (defined $deleteOrig) {
1473 #print "======== $file$progStr\n" if defined $verbose;
1474 ++$count;
1475 my $original = "${file}_original";
1476 -e $original or return;
1477 if ($deleteOrig) {
1478 $verbose and print "Scheduled for deletion: $original\n";
1479 push @delFiles, $original;
1480 } elsif (rename $original, $file) {
1481 $verbose and print "Restored from $original\n";
1482 ++$countGoodWr;
1483 } else {
1484 Warn "Error renaming $original\n";
1485 ++$countBad;
1486 }
1487 return;
1488 }
1489 my $lineCount = 0;
1490 my ($fp, $outfile);
1491 #if ($textOut and $verbose) {
1492 # ($fp, $outfile) = OpenOutputFile($orig);
1493 # $fp or ++$countBad, return;
1494 # $tmpText = $outfile; # deletes file if we exit prematurely
1495 # $exifTool->Options(TextOut => $fp);
1496 #}
1497
1498 if ($isWriting) {
1499 #print "======== $file$progStr\n" if defined $verbose;
1500 SetImageInfo($exifTool, $file, $orig);
1501 $info = $exifTool->GetInfo('Warning', 'Error');
1502 PrintErrors($exifTool, $info, $file);
1503 # close output text file if necessary
1504 if ($outfile) {
1505 undef $tmpText;
1506 close($fp);
1507 $exifTool->Options(TextOut => \*STDOUT);
1508 if ($info->{Error}) {
1509 unlink $outfile; # erase bad file
1510 } else {
1511 ++$countCreated;
1512 }
1513 }
1514 return;
1515 }
1516
1517 # extract information from this file
1518 unless ($file eq '-' or -e $file) {
1519 Warn "File not found: $file\n";
1520 $outfile and close($fp), undef($tmpText), unlink($outfile);
1521 ++$countBad;
1522 return;
1523 }
1524 # print file/progress message
1525 my $o;
1526 unless ($binaryOutput or $textOut or %printFmt or $html > 1 or $csv) {
1527 if ($html) {
1528 require ExifTool::HTML;
1529 my $f = ExifTool::HTML::EscapeHTML($file);
1530 print "<!-- $f -->\n";
1531 } elsif (not ($json or $xml)) {
1532 $o = \*STDOUT if ($multiFile and not $quiet) or $progress;
1533 }
1534 }
1535 $o = \*STDERR if $progress and not $o;
1536 #$o and print $o "======== $file$progStr\n";
1537 if ($info) {
1538 # get the information we wanted
1539 if (@tags and not %printFmt) {
1540 @foundTags = @tags;
1541 $info = $exifTool->GetInfo(\@foundTags);
1542 }
1543 } else {
1544 # request specified tags unless using print format option
1545 my $oldDups = $exifTool->Options('Duplicates');
1546 if (%printFmt) {
1547 $exifTool->Options(Duplicates => 1);
1548 } else {
1549 @foundTags = @tags;
1550 }
1551 # extract the information
1552 $info = $exifTool->ImageInfo($pipe, \@foundTags);
1553 $exifTool->Options(Duplicates => $oldDups);
1554 }
1555 # all done now if we already wrote output text file (ie. verbose option)
1556 if ($fp) {
1557 if ($outfile) {
1558 $exifTool->Options(TextOut => \*STDOUT);
1559 undef $tmpText;
1560 if ($info->{Error}) {
1561 close($fp);
1562 unlink $outfile; # erase bad file
1563 } else {
1564 ++$lineCount; # output text file (likely) is not empty
1565 }
1566 }
1567 if ($info->{Error}) {
1568 Warn "Error: $info->{Error} - $file\n";
1569 ++$countBad;
1570 return;
1571 }
1572 }
1573
1574 # print warnings to stderr if using binary output
1575 # (because we are likely ignoring them and piping stdout to file)
1576 # or if there is none of the requested information available
1577 if ($binaryOutput or not %$info) {
1578 my $errs = $exifTool->GetInfo('Warning', 'Error');
1579 PrintErrors($exifTool, $errs, $file);
1580 }
1581
1582 ++$count;
1583}
1584
1585#------------------------------------------------------------------------------
1586# Translate backslashes to forward slashes in filename if necessary
1587# Inputs: 0) Filename
1588# Returns: nothing, but changes filename if necessary
1589sub CleanFilename($)
1590{
1591 $_[0] =~ tr/\\/\// if $hasBackslash{$^O};
1592}
1593
1594#------------------------------------------------------------------------------
1595# process files in our @files list
1596# Inputs: 0) ExifTool ref, 1) list ref to just return full file names
1597# Notes: arg 0 is not used if arg 1 is defined
1598sub ProcessFiles($;$)
1599{
1600 my ($exifTool, $list) = @_;
1601 my $file;
1602 foreach $file (@files) {
1603 if (defined $progressMax) {
1604 ++$progress;
1605 $progStr = " [$progress/$progressMax]";
1606 }
1607 if (-d $file) {
1608 $multiFile = $validFile = 1;
1609 ScanDir($mainTool, $file, $list);
1610 } elsif ($filterFlag and not AcceptFile($file)) {
1611 if (-e $file) {
1612 $filtered = 1;
1613 $verbose and print "-------- $file (wrong extension)$progStr\n";
1614 } else {
1615 Warn "File not found: $file\n";
1616 $rtnVal = 1;
1617 }
1618 } else {
1619 $validFile = 1;
1620 $list and push(@$list, $file), next;
1621 GetImageInfo($exifTool, $file);
1622 }
1623 }
1624}