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