mirrors-perl
/
exiftool
mirror of https://github.com/exiftool/exiftool.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity Software
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
299 Commits
1 Branch
271 Tags
19 MiB
 
 
 
Branch: master
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'master'
${ noResults }
exiftool/windows_exiftool

7214 lines
316 KiB
Raw Permalink Blame History

#!/usr/bin/perl -w
#------------------------------------------------------------------------------
# File: windows_exiftool
#
# Description: exiftool version for Windows EXE bundle
#
# Revisions: Nov. 12/03 - P. Harvey Created
# (See html/history.html for revision history)
#------------------------------------------------------------------------------
use strict;
use warnings;
require 5.004;
my $version = '12.42';
# add our 'lib' directory to the include list BEFORE 'use Image::ExifTool'
my $exePath;
BEGIN {
# (undocumented -xpath option added in 11.91, must come before other options)
$exePath = @ARGV && lc($ARGV[0]) eq '-xpath' && shift() ? $^X : $0;
# get exe directory
$Image::ExifTool::exeDir = ($exePath =~ /(.*)[\\\/]/) ? $1 : '.';
# (no link following for Windows exe version)
# add lib directory at start of include path
unshift @INC, ($0 =~ /(.*)[\\\/]/) ? "$1/lib" : './lib';
# load or disable config file if specified
if (@ARGV and lc($ARGV[0]) eq '-config') {
shift;
$Image::ExifTool::configFile = shift;
}
}
use Image::ExifTool qw{:Public};
# function prototypes
sub SigInt();
sub SigCont();
sub Cleanup();
sub GetImageInfo($$);
sub SetImageInfo($$$);
sub DoHardLink($$$$$);
sub CleanXML($);
sub EncodeXML($);
sub FormatXML($$$);
sub EscapeJSON($;$);
sub FormatJSON($$$);
sub PrintCSV();
sub AddGroups($$$$);
sub ConvertBinary($);
sub IsEqual($$);
sub Infile($;$);
sub AddSetTagsFile($;$);
sub DoSetFromFile($$$);
sub CleanFilename($);
sub SetWindowTitle($);
sub ProcessFiles($;$);
sub ScanDir($$;$);
sub FindFileWindows($$);
sub FileNotFound($);
sub PreserveTime();
sub AbsPath($);
sub MyConvertFileName($$);
sub SuggestedExtension($$$);
sub LoadPrintFormat($);
sub FilenameSPrintf($;$@);
sub NextUnusedFilename($;$);
sub CreateDirectory($);
sub OpenOutputFile($;@);
sub AcceptFile($);
sub SlurpFile($$);
sub FilterArgfileLine($);
sub ReadStayOpen($);
sub PrintTagList($@);
sub PrintErrors($$$);
sub Help();
$SIG{INT} = 'SigInt'; # do cleanup on Ctrl-C
$SIG{CONT} = 'SigCont'; # (allows break-out of delays)
END {
Cleanup();
}
# declare all static file-scope variables
my @commonArgs; # arguments common to all commands
my @condition; # conditional processing of files
my @csvFiles; # list of files when reading with CSV option (in ExifTool Charset)
my @csvTags; # order of tags for first file with CSV option (lower case)
my @delFiles; # list of files to delete
my @dynamicFiles; # list of -tagsFromFile files with dynamic names and -TAG<=FMT pairs
my @efile; # files for writing list of error/fail/same file names
my @exclude; # list of excluded tags
my (@echo3, @echo4);# stdout and stderr echo after processing is complete
my @files; # list of files and directories to scan
my @moreArgs; # more arguments to process after -stay_open -@
my @newValues; # list of new tag values to set
my @requestTags; # tags to request (for -p or -if option arguments)
my @srcFmt; # source file name format strings
my @tags; # list of tags to extract
my %appended; # list of files appended to
my %countLink; # count hard and symbolic links made
my %created; # list of files we created
my %csvTags; # lookup for all found tags with CSV option (lower case keys)
my %database; # lookup for database information based on file name (in ExifTool Charset)
my %filterExt; # lookup for filtered extensions
my %ignore; # directory names to ignore
my $ignoreHidden; # flag to ignore hidden files
my %outComma; # flag that output text file needs a comma
my %outTrailer; # trailer for output text file
my %preserveTime; # preserved timestamps for files
my %printFmt; # the contents of the print format file
my %setTags; # hash of list references for tags to set from files
my %setTagsList; # list of other tag lists for multiple -tagsFromFile from the same file
my %usedFileName; # lookup for file names we already used in TestName feature
my %utf8FileName; # lookup for file names that are UTF-8 encoded
my %warnedOnce; # lookup for once-only warnings
my %wext; # -W extensions to write
my $allGroup; # show group name for all tags
my $altEnc; # alternate character encoding if not UTF-8
my $argFormat; # use exiftool argument-format output
my $binaryOutput; # flag for binary output (undef or 1, or 0 for binary XML/PHP)
my $binaryStdout; # flag set if we output binary to stdout
my $binSep; # separator used for list items in binary output
my $binTerm; # terminator used for binary output
my $comma; # flag set if we need a comma in JSON output
my $count; # count of files scanned when reading or deleting originals
my $countBad; # count of files with errors
my $countBadCr; # count files not created due to errors
my $countBadWr; # count write errors
my $countCopyWr; # count of files copied without being changed
my $countDir; # count of directories scanned
my $countFailed; # count files that failed condition
my $countGoodCr; # count files created OK
my $countGoodWr; # count files written OK
my $countNewDir; # count of directories created
my $countSameWr; # count files written OK but not changed
my $critical; # flag for critical operations (disable CTRL-C)
my $csv; # flag for CSV option (set to "CSV", or maybe "JSON" when writing)
my $csvAdd; # flag to add CSV information to existing lists
my $csvDelim; # delimiter for CSV files
my $csvSaveCount; # save counter for last CSV file loaded
my $deleteOrig; # 0=restore original files, 1=delete originals, 2=delete w/o asking
my $disableOutput; # flag to disable normal output
my $doSetFileName; # flag set if FileName may be written
my $doUnzip; # flag to extract info from .gz and .bz2 files
my ($end,$endDir,%endDir); # flags to end processing
my $escapeC; # C-style escape
my $escapeHTML; # flag to escape printed values for html
my $evalWarning; # warning from eval
my $executeID; # -execute ID number
my $failCondition; # flag to fail -if condition
my $fastCondition; # flag for fast -if condition
my $fileHeader; # header to print to output file (or console, once)
my $fileTrailer; # trailer for output file
my $filtered; # flag indicating file was filtered by name
my $filterFlag; # file filter flag (0x01=deny extensions, 0x02=allow extensions, 0x04=add ext)
my $fixLen; # flag to fix description lengths when writing alternate languages
my $forcePrint; # string to use for missing tag values (undef to not print them)
my $helped; # flag to avoid printing help if no tags specified
my $html; # flag for html-formatted output (2=html dump)
my $interrupted; # flag set if CTRL-C is pressed during a critical process
my $isBinary; # true if value is a SCALAR ref
my $isWriting; # flag set if we are writing tags
my $joinLists; # flag set to join list values into a single string
my $json; # flag for JSON/PHP output format (1=JSON, 2=PHP)
my $langOpt; # language option
my $listDir; # treat a directory as a regular file
my $listItem; # item number for extracting single item from a list
my $listSep; # list item separator (', ' by default)
my $mt; # main ExifTool object
my $multiFile; # non-zero if we are scanning multiple files
my $noBinary; # flag set to ignore binary tags
my $outFormat; # -1=Canon format, 0=same-line, 1=tag names, 2=values only
my $outOpt; # output file or directory name
my $overwriteOrig; # flag to overwrite original file (1=overwrite, 2=in place)
my $pause; # pause before returning
my $preserveTime; # flag to preserve times of updated files (2=preserve FileCreateDate only)
my $progress; # flag to calculate total files to process (0=calculate but don't display)
my $progressCount; # count of files processed
my $progressMax; # total number of files to process
my $progStr; # progress message string
my $quiet; # flag to disable printing of informational messages / warnings
my $rafStdin; # File::RandomAccess for stdin (if necessary to rewind)
my $recurse; # recurse into subdirectories (2=also hidden directories)
my $rtnVal; # command return value (0=success)
my $rtnValPrev; # previous command return value (0=success)
my $saveCount; # count the number of times we will/did call SaveNewValues()
my $scanWritable; # flag to process only writable file types
my $sectHeader; # current section header for -p option
my $sectTrailer; # section trailer for -p option
my $seqFileBase; # sequential file number at start of directory
my $seqFileNum; # sequential file number used for %C
my $setCharset; # character set setting ('default' if not set and -csv -b used)
my $showGroup; # number of group to show (may be zero or '')
my $showTagID; # non-zero to show tag ID's
my $stayOpenBuff='';# buffer for -stay_open file
my $stayOpenFile; # name of the current -stay_open argfile
my $structOpt; # output structured XMP information (JSON and XML output only)
my $tabFormat; # non-zero for tab output format
my $tagOut; # flag for separate text output file for each tag
my $textOut; # extension for text output file (or undef for no output)
my $textOverwrite; # flag to overwrite existing text output file (2=append, 3=over+append)
my $tmpFile; # temporary file to delete on exit
my $tmpText; # temporary text file
my $validFile; # flag indicating we processed a valid file
my $verbose; # verbose setting
my $vout; # verbose output file reference (\*STDOUT or \*STDERR)
my $windowTitle; # title for console window
my $xml; # flag for XML-formatted output
# flag to keep the input -@ argfile open:
# 0 = normal behaviour
# 1 = received "-stay_open true" and waiting for argfile to keep open
# 2 = currently reading from STAYOPEN argfile
# 3 = waiting for -@ to switch to a new STAYOPEN argfile
my $stayOpen = 0;
my $rtnValApp = 0; # app return value (0=success)
my $curTitle = ''; # current window title
# lookup for O/S names which may use a backslash as a directory separator
# (ref File::Spec of PathTools-3.2701)
my %hasBackslash = ( MSWin32 => 1, os2 => 1, dos => 1, NetWare => 1, symbian => 1, cygwin => 1 );
# lookup for O/S names which use CR/LF newlines
my $isCRLF = { MSWin32 => 1, os2 => 1, dos => 1 }->{$^O};
# lookup for JSON characters that we escape specially
my %jsonChar = ( '"'=>'"', '\\'=>'\\', "\t"=>'t', "\n"=>'n', "\r"=>'r' );
# lookup for C-style escape sequences
my %escC = ( "\n" => '\n', "\r" => '\r', "\t" => '\t', '\\' => '\\\\');
my %unescC = ( a => "\a", b => "\b", f => "\f", n => "\n", r => "\r",
t => "\t", 0 => "\0", '\\' => '\\' );
# options requiring additional arguments
# (used only to skip over these arguments when reading -stay_open ARGFILE)
# (arg is converted to lower case then tested again unless an entry was found with the same case)
my %optArgs = (
'-tagsfromfile' => 1, '-addtagsfromfile' => 1, '-alltagsfromfile' => 1,
'-@' => 1,
'-api' => 1,
'-c' => 1, '-coordformat' => 1,
'-charset' => 0, # (optional arg; OK because arg cannot begin with "-")
'-config' => 1,
'-csvdelim' => 1,
'-d' => 1, '-dateformat' => 1,
'-D' => 0, # necessary to avoid matching lower-case equivalent
'-echo' => 1, '-echo1' => 1, '-echo2' => 1, '-echo3' => 1, '-echo4' => 1,
'-efile' => 1, '-efile1' => 1, '-efile2' => 1, '-efile3' => 1, '-efile4' => 1,
'-efile!' => 1, '-efile1!' => 1, '-efile2!' => 1, '-efile3!' => 1, '-efile4!' => 1,
'-ext' => 1, '--ext' => 1, '-ext+' => 1, '--ext+' => 1,
'-extension' => 1, '--extension' => 1, '-extension+' => 1, '--extension+' => 1,
'-fileorder' => 1, '-fileorder0' => 1, '-fileorder1' => 1, '-fileorder2' => 1,
'-fileorder3' => 1, '-fileorder4' => 1, '-fileorder5' => 1,
'-geotag' => 1,
'-globaltimeshift' => 1,
'-i' => 1, '-ignore' => 1,
'-if' => 1, '-if0' => 1, '-if1' => 1, '-if2' => 1, '-if3' => 1, '-if4' => 1, '-if5' => 1,
'-lang' => 0, # (optional arg; cannot begin with "-")
'-listitem' => 1,
'-o' => 1, '-out' => 1,
'-p' => 1, '-printformat' => 1,
'-P' => 0,
'-password' => 1,
'-require' => 1,
'-sep' => 1, '-separator' => 1,
'-srcfile' => 1,
'-stay_open' => 1,
'-use' => 1,
'-userparam' => 1,
'-w' => 1, '-w!' => 1, '-w+' => 1, '-w+!' => 1, '-w!+' => 1,
'-textout' => 1, '-textout!' => 1, '-textout+' => 1, '-textout+!' => 1, '-textout!+' => 1,
'-tagout' => 1, '-tagout!' => 1, '-tagout+' => 1, '-tagout+!' => 1, '-tagout!+' => 1,
'-wext' => 1,
'-wm' => 1, '-writemode' => 1,
'-x' => 1, '-exclude' => 1,
'-X' => 0,
);
# recommended packages and alternatives
my @recommends = qw(
Archive::Zip
Compress::Zlib
Digest::MD5
Digest::SHA
IO::Compress::Bzip2
POSIX::strptime
Time::Local
Unicode::LineBreak
IO::Compress::RawDeflate
IO::Uncompress::RawInflate
Win32::API
Win32::FindFile
Win32API::File
);
my %altRecommends = (
'POSIX::strptime' => 'Time::Piece', # (can use Time::Piece instead of POSIX::strptime)
);
my %unescapeChar = ( 't'=>"\t", 'n'=>"\n", 'r'=>"\r" );
# special subroutines used in -if condition
sub Image::ExifTool::EndDir() { return $endDir = 1 }
sub Image::ExifTool::End() { return $end = 1 }
# exit routine
sub Exit {
if ($pause) {
if (eval { require Term::ReadKey }) {
print STDERR "-- press any key --";
Term::ReadKey::ReadMode('cbreak');
Term::ReadKey::ReadKey(0);
Term::ReadKey::ReadMode(0);
print STDERR "\b \b" x 20;
} else {
print STDERR "-- press ENTER --\n";
<STDIN>;
}
}
exit shift;
}
# my warning and error routines (NEVER say "die"!)
sub Warn {
if ($quiet < 2 or $_[0] =~ /^Error/) {
my $oldWarn = $SIG{'__WARN__'};
delete $SIG{'__WARN__'};
warn(@_);
$SIG{'__WARN__'} = $oldWarn if defined $oldWarn;
}
}
sub Error { Warn @_; $rtnVal = 1; }
sub WarnOnce($) {
Warn(@_) and $warnedOnce{$_[0]} = 1 unless $warnedOnce{$_[0]};
}
# define signal handlers and cleanup routine
sub SigInt() {
$critical and $interrupted = 1, return;
Cleanup();
exit 1;
}
sub SigCont() { }
sub Cleanup() {
$mt->Unlink($tmpFile) if defined $tmpFile;
$mt->Unlink($tmpText) if defined $tmpText;
undef $tmpFile;
undef $tmpText;
PreserveTime() if %preserveTime;
SetWindowTitle('');
}
#------------------------------------------------------------------------------
# main script
#
# add arguments embedded in filename (Windows .exe version only)
if ($exePath =~ /\(([^\\\/]+)\)(.exe|.pl)?$/i) {
my $argstr = $1;
# divide into separate quoted or whitespace-delineated arguments
my (@args, $arg, $quote);
while ($argstr =~ /(\s*)(\S+)/g) {
$arg = $quote ? "$arg$1" : ''; # include quoted white space in arg
my $a = $2;
for (;;) {
my $q = $quote || q{['"]}; # look for current (or any) quote
$a =~ /(.*?)($q)/gs or last; # get string up to quote
$quote = $quote ? undef : $2; # define next quote char for search
$arg .= $1; # add to this argument
$a = substr($a, pos($a)); # done parsing up to current position
}
$arg .= $a; # add unquoted part of string
push @args, $arg unless $quote; # save in argument list
}
unshift @ARGV, @args; # add before other command-line arguments
}
# isolate arguments common to all commands
if (grep /^-common_args$/i, @ARGV) {
my (@newArgs, $common);
foreach (@ARGV) {
if (/^-common_args$/i) {
$common = 1;
} elsif ($common) {
push @commonArgs, $_;
} else {
push @newArgs, $_;
}
}
@ARGV = @newArgs if $common;
}
#..............................................................................
# loop over sets of command-line arguments separated by "-execute"
Command: for (;;) {
if (@echo3) {
my $str = join("\n", @echo3) . "\n";
$str =~ s/\$\{status\}/$rtnVal/ig;
print STDOUT $str;
}
if (@echo4) {
my $str = join("\n", @echo4) . "\n";
$str =~ s/\$\{status\}/$rtnVal/ig;
print STDERR $str;
}
$rafStdin->Close() if $rafStdin;
undef $rafStdin;
# save our previous return codes
$rtnValPrev = $rtnVal;
$rtnValApp = $rtnVal if $rtnVal;
# exit Command loop now if we are all done processing commands
last unless @ARGV or not defined $rtnVal or $stayOpen >= 2 or @commonArgs;
# attempt to restore text mode for STDOUT if necessary
if ($binaryStdout) {
binmode(STDOUT,':crlf') if $] >= 5.006 and $isCRLF;
$binaryStdout = 0;
}
# flush console and print "{ready}" message if -stay_open is in effect
if ($stayOpen >= 2) {
if ($quiet and not defined $executeID) {
# flush output if possible
eval { require IO::Handle } and STDERR->flush(), STDOUT->flush();
} else {
eval { require IO::Handle } and STDERR->flush();
my $id = defined $executeID ? $executeID : '';
my $save = $|;
$| = 1; # turn on output autoflush for stdout
print "{ready$id}\n";
$| = $save; # restore original autoflush setting
}
}
# initialize necessary static file-scope variables
# (not done: @commonArgs, @moreArgs, $critical, $binaryStdout, $helped,
# $interrupted, $mt, $pause, $rtnValApp, $rtnValPrev, $stayOpen, $stayOpenBuff, $stayOpenFile)
undef @condition;
undef @csvFiles;
undef @csvTags;
undef @delFiles;
undef @dynamicFiles;
undef @echo3;
undef @echo4;
undef @efile;
undef @exclude;
undef @files;
undef @newValues;
undef @srcFmt;
undef @tags;
undef %appended;
undef %countLink;
undef %created;
undef %csvTags;
undef %database;
undef %endDir;
undef %filterExt;
undef %ignore;
undef %outComma;
undef %outTrailer;
undef %printFmt;
undef %preserveTime;
undef %setTags;
undef %setTagsList;
undef %usedFileName;
undef %utf8FileName;
undef %warnedOnce;
undef %wext;
undef $allGroup;
undef $altEnc;
undef $argFormat;
undef $binaryOutput;
undef $binSep;
undef $binTerm;
undef $comma;
undef $csv;
undef $csvAdd;
undef $deleteOrig;
undef $disableOutput;
undef $doSetFileName;
undef $doUnzip;
undef $end;
undef $endDir;
undef $escapeHTML;
undef $escapeC;
undef $evalWarning;
undef $executeID;
undef $failCondition;
undef $fastCondition;
undef $fileHeader;
undef $filtered;
undef $fixLen;
undef $forcePrint;
undef $ignoreHidden;
undef $joinLists;
undef $langOpt;
undef $listItem;
undef $multiFile;
undef $noBinary;
undef $outOpt;
undef $preserveTime;
undef $progress;
undef $progressCount;
undef $progressMax;
undef $recurse;
undef $scanWritable;
undef $sectHeader;
undef $setCharset;
undef $showGroup;
undef $showTagID;
undef $structOpt;
undef $tagOut;
undef $textOut;
undef $textOverwrite;
undef $tmpFile;
undef $tmpText;
undef $validFile;
undef $verbose;
undef $windowTitle;
$count = 0;
$countBad = 0;
$countBadCr = 0;
$countBadWr = 0;
$countCopyWr = 0;
$countDir = 0;
$countFailed = 0;
$countGoodCr = 0;
$countGoodWr = 0;
$countNewDir = 0;
$countSameWr = 0;
$csvDelim = ',';
$csvSaveCount = 0;
$fileTrailer = '';
$filterFlag = 0;
$html = 0;
$isWriting = 0;
$json = 0;
$listSep = ', ';
$outFormat = 0;
$overwriteOrig = 0;
$progStr = '';
$quiet = 0;
$rtnVal = 0;
$saveCount = 0;
$sectTrailer = '';
$seqFileBase = 0;
$seqFileNum = 0;
$tabFormat = 0;
$vout = \*STDOUT;
$xml = 0;
# define local variables used only in this command loop
my @fileOrder; # tags to use for ordering of input files
my $fileOrderFast; # -fast level for -fileOrder option
my $addGeotime; # automatically added geotime argument
my $doGlob; # flag set to do filename wildcard expansion
my $endOfOpts; # flag set if "--" option encountered
my $escapeXML; # flag to escape printed values for xml
my $setTagsFile; # filename for last TagsFromFile option
my $sortOpt; # sort option is used
my $srcStdin; # one of the source files is STDIN
my $useMWG; # flag set if we are using any MWG tag
my ($argsLeft, @nextPass, $badCmd);
my $pass = 0;
# for Windows, use globbing for wildcard expansion if available - MK/20061010
if ($^O eq 'MSWin32' and eval { require File::Glob }) {
# override the core glob forcing case insensitivity
import File::Glob qw(:globally :nocase);
$doGlob = 1;
}
$mt = new Image::ExifTool; # create ExifTool object
# don't extract duplicates by default unless set by UserDefined::Options
$mt->Options(Duplicates => 0) unless %Image::ExifTool::UserDefined::Options
and defined $Image::ExifTool::UserDefined::Options{Duplicates};
# default is to join lists if the List option was set to zero in the config file
$joinLists = 1 if defined $mt->Options('List') and not $mt->Options('List');
# preserve FileCreateDate if possible
if (not $preserveTime and $^O eq 'MSWin32') {
$preserveTime = 2 if eval { require Win32::API } and eval { require Win32API::File };
}
# parse command-line options in 2 passes...
# pass 1: set all of our ExifTool options
# pass 2: print all of our help and informational output (-list, -ver, etc)
for (;;) {
# execute the command now if no more arguments or -execute is used
if (not @ARGV or ($ARGV[0] =~ /^(-|\xe2\x88\x92)execute(\d+)?$/i and not $endOfOpts)) {
if (@ARGV) {
$executeID = $2; # save -execute number for "{ready}" response
$helped = 1; # don't show help if we used -execute
$badCmd and shift, $rtnVal=1, next Command;
} elsif ($stayOpen >= 2) {
ReadStayOpen(\@ARGV); # read more arguments from -stay_open file
next;
} elsif ($badCmd) {
undef @commonArgs; # all done. Flush common arguments
$rtnVal = 1;
next Command;
}
if ($pass == 0) {
# insert common arguments now if not done already
if (@commonArgs and not defined $argsLeft) {
# count the number of arguments remaining for subsequent commands
$argsLeft = scalar(@ARGV) + scalar(@moreArgs);
unshift @ARGV, @commonArgs;
# all done with commonArgs if this is the end of the command
undef @commonArgs unless $argsLeft;
next;
}
# check if we have more arguments now than we did before we processed
# the common arguments. If so, then we have an infinite processing loop
if (defined $argsLeft and $argsLeft < scalar(@ARGV) + scalar(@moreArgs)) {
Warn "Ignoring -common_args from $ARGV[0] onwards to avoid infinite recursion\n";
while ($argsLeft < scalar(@ARGV) + scalar(@moreArgs)) {
@ARGV and shift(@ARGV), next;
shift @moreArgs;
}
}
# require MWG module if used in any argument
# (note: doesn't cover the -p option because these tags will be parsed on the 2nd pass)
$useMWG = 1 if not $useMWG and grep /^mwg:/i, @tags, @requestTags;
if ($useMWG) {
require Image::ExifTool::MWG;
Image::ExifTool::MWG::Load();
}
# update necessary variables for 2nd pass
if (defined $forcePrint) {
unless (defined $mt->Options('MissingTagValue')) {
$mt->Options(MissingTagValue => '-');
}
$forcePrint = $mt->Options('MissingTagValue');
}
}
if (@nextPass) {
# process arguments which were deferred to the next pass
unshift @ARGV, @nextPass;
undef @nextPass;
undef $endOfOpts;
++$pass;
next;
}
@ARGV and shift; # remove -execute from argument list
last; # process the command now
}
$_ = shift;
next if $badCmd; # flush remaining arguments if aborting this command
# allow funny dashes (nroff dash bug for cut-n-paste from pod)
if (not $endOfOpts and s/^(-|\xe2\x88\x92)//) {
s/^\xe2\x88\x92/-/; # translate double-dash too
if ($_ eq '-') {
$pass or push @nextPass, '--';
$endOfOpts = 1;
next;
}
my $a = lc $_;
if (/^list([wfrdx]|wf|g(\d*))?$/i) {
$pass or push @nextPass, "-$_";
my $type = lc($1 || '');
if (not $type or $type eq 'w' or $type eq 'x') {
my $group;
if ($ARGV[0] and $ARGV[0] =~ /^(-|\xe2\x88\x92)(.+):(all|\*)$/i) {
if ($pass == 0) {
$useMWG = 1 if lc($2) eq 'mwg';
push @nextPass, shift;
next;
}
$group = $2;
shift;
$group =~ /IFD/i and Warn("Can't list tags for specific IFD\n"), next;
$group =~ /^(all|\*)$/ and undef $group;
} else {
$pass or next;
}
$helped = 1;
if ($type eq 'x') {
require Image::ExifTool::TagInfoXML;
my %opts;
$opts{Flags} = 1 if defined $forcePrint;
$opts{NoDesc} = 1 if $outFormat > 0;
$opts{Lang} = $langOpt;
Image::ExifTool::TagInfoXML::Write(undef, $group, %opts);
next;
}
my $wr = ($type eq 'w');
my $msg = ($wr ? 'Writable' : 'Available') . ($group ? " $group" : '') . ' tags';
PrintTagList($msg, $wr ? GetWritableTags($group) : GetAllTags($group));
# also print shortcuts if listing all tags
next if $group or $wr;
my @tagList = GetShortcuts();
PrintTagList('Command-line shortcuts', @tagList) if @tagList;
next;
}
$pass or next;
$helped = 1;
if ($type eq 'wf') {
my @wf;
CanWrite($_) and push @wf, $_ foreach GetFileType();
PrintTagList('Writable file extensions', @wf);
} elsif ($type eq 'f') {
PrintTagList('Supported file extensions', GetFileType());
} elsif ($type eq 'r') {
PrintTagList('Recognized file extensions', GetFileType(undef, 0));
} elsif ($type eq 'd') {
PrintTagList('Deletable groups', GetDeleteGroups());
} else { # 'g(\d*)'
# list all groups in specified family
my $family = $2 || 0;
PrintTagList("Groups in family $family", $mt->GetAllGroups($family));
}
next;
}
if ($a eq 'ver') {
$pass or push(@nextPass,'-ver'), next;
my $libVer = $Image::ExifTool::VERSION;
my $str = $libVer eq $version ? '' : " [Warning: Library version is $libVer]";
if ($verbose) {
print "ExifTool version $version$str$Image::ExifTool::RELEASE\n";
printf "Perl version %s%s\n", $], (defined ${^UNICODE} ? " (-C${^UNICODE})" : '');
print "Platform: $^O\n";
print "Optional libraries:\n";
foreach (@recommends) {
next if /^Win32/ and $^O ne 'MSWin32';
my $ver = eval "require $_ and \$${_}::VERSION";
my $alt = $altRecommends{$_};
# check for alternative if primary not available
$ver = eval "require $alt and \$${alt}::VERSION" and $_ = $alt if not $ver and $alt;
printf " %-28s %s\n", $_, $ver || '(not installed)';
}
if ($verbose > 1) {
print "Include directories:\n";
print " $_\n" foreach @INC;
}
} else {
print "$version$str$Image::ExifTool::RELEASE\n";
}
$helped = 1;
next;
}
if (/^(all|add)?tagsfromfile(=.*)?$/i) {
$setTagsFile = $2 ? substr($2,1) : (@ARGV ? shift : '');
if ($setTagsFile eq '') {
Error("File must be specified for -tagsFromFile option\n");
$badCmd = 1;
next;
}
# create necessary lists, etc for this new -tagsFromFile file
AddSetTagsFile($setTagsFile, { Replace => ($1 and lc($1) eq 'add') ? 0 : 1 } );
next;
}
if ($a eq '@') {
my $argFile = shift or Error("Expecting filename for -\@ option\n"), $badCmd=1, next;
# switch to new ARGFILE if using chained -stay_open options
if ($stayOpen == 1) {
# defer remaining arguments until we close this argfile
@moreArgs = @ARGV;
undef @ARGV;
} elsif ($stayOpen == 3) {
if ($stayOpenFile and $stayOpenFile ne '-' and $argFile eq $stayOpenFile) {
# don't allow user to switch to the same -stay_open argfile
# because it will result in endless recursion
$stayOpen = 2;
Warn "Ignoring request to switch to the same -stay_open ARGFILE ($argFile)\n";
next;
}
close STAYOPEN;
$stayOpen = 1; # switch to this -stay_open file
}
my $fp = ($stayOpen == 1 ? \*STAYOPEN : \*ARGFILE);
unless ($mt->Open($fp, $argFile)) {
unless ($argFile !~ /^\// and $mt->Open($fp, "$Image::ExifTool::exeDir/$argFile")) {
Error "Error opening arg file $argFile\n";
$badCmd = 1;
next
}
}
if ($stayOpen == 1) {
$stayOpenFile = $argFile; # remember the name of the file we have open
$stayOpenBuff = ''; # initialize buffer for reading this file
$stayOpen = 2;
$helped = 1;
ReadStayOpen(\@ARGV);
next;
}
my (@newArgs, $didBOM);
foreach (<ARGFILE>) {
# filter Byte Order Mark if it exists from start of UTF-8 text file
unless ($didBOM) {
s/^\xef\xbb\xbf//;
$didBOM = 1;
}
$_ = FilterArgfileLine($_);
push @newArgs, $_ if defined $_;
}
close ARGFILE;
unshift @ARGV, @newArgs;
next;
}
/^(-?)(a|duplicates)$/i and $mt->Options(Duplicates => ($1 ? 0 : 1)), next;
if ($a eq 'api') {
my $opt = shift;
defined $opt or Error("Expected OPT[=VAL] argument for -api option\n"), $badCmd=1, next;
my $val = ($opt =~ s/=(.*)//s) ? $1 : 1;
# empty string means an undefined value unless ^= is used
$val = undef unless $opt =~ s/\^$// or length $val;
$mt->Options($opt => $val);
next;
}
/^arg(s|format)$/i and $argFormat = 1, next;
if (/^(-?)b(inary)?$/i) {
($binaryOutput, $noBinary) = $1 ? (undef, 1) : (1, undef);
$mt->Options(Binary => $binaryOutput, NoPDFList => $binaryOutput);
next;
}
if (/^c(oordFormat)?$/i) {
my $fmt = shift;
$fmt or Error("Expecting coordinate format for -c option\n"), $badCmd=1, next;
$mt->Options('CoordFormat', $fmt);
next;
}
if ($a eq 'charset') {
my $charset = (@ARGV and $ARGV[0] !~ /^(-|\xe2\x88\x92)/) ? shift : undef;
if (not $charset) {
$pass or push(@nextPass, '-charset'), next;
my %charsets;
$charsets{$_} = 1 foreach values %Image::ExifTool::charsetName;
PrintTagList('Available character sets', sort keys %charsets);
$helped = 1;
} elsif ($charset !~ s/^(\w+)=// or lc($1) eq 'exiftool') {
{
local $SIG{'__WARN__'} = sub { $evalWarning = $_[0] };
undef $evalWarning;
$mt->Options(Charset => $charset);
}
if ($evalWarning) {
warn $evalWarning;
} else {
$setCharset = $mt->Options('Charset');
}
} else {
# set internal encoding of specified metadata type
my $type = { id3 => 'ID3', iptc => 'IPTC', exif => 'EXIF', filename => 'FileName',
photoshop => 'Photoshop', quicktime => 'QuickTime', riff=>'RIFF' }->{lc $1};
$type or Warn("Unknown type for -charset option: $1\n"), next;
$mt->Options("Charset$type" => $charset);
}
next;
}
/^config$/i and Warn("Ignored -config option (not first on command line)\n"), shift, next;
if (/^csv(\+?=.*)?$/i) {
my $csvFile = $1;
# must process on 2nd pass so -f and -charset options are available
unless ($pass) {
push @nextPass, "-$_";
if ($csvFile) {
push @newValues, { SaveCount => ++$saveCount }; # marker to save new values now
$csvSaveCount = $saveCount;
}
next;
}
if ($csvFile) {
$csvFile =~ s/^(\+?=)//;
$csvAdd = 2 if $1 eq '+=';
$vout = \*STDERR if $srcStdin;
$verbose and print $vout "Reading CSV file $csvFile\n";
my $msg;
if ($mt->Open(\*CSVFILE, $csvFile)) {
binmode CSVFILE;
require Image::ExifTool::Import;
$msg = Image::ExifTool::Import::ReadCSV(\*CSVFILE, \%database, $forcePrint, $csvDelim);
close(CSVFILE);
} else {
$msg = "Error opening CSV file '${csvFile}'";
}
$msg and Warn("$msg\n");
$isWriting = 1;
}
$csv = 'CSV';
next;
}
if (/^csvdelim$/i) {
$csvDelim = shift;
defined $csvDelim or Error("Expecting argument for -csvDelim option\n"), $badCmd=1, next;
$csvDelim =~ /"/ and Error("CSV delimiter can not contain a double quote\n"), $badCmd=1, next;
my %unescape = ( 't'=>"\t", 'n'=>"\n", 'r'=>"\r", '\\' => '\\' );
$csvDelim =~ s/\\(.)/$unescape{$1}||"\\$1"/sge;
$mt->Options(CSVDelim => $csvDelim);
next;
}
if (/^d$/ or $a eq 'dateformat') {
my $fmt = shift;
$fmt or Error("Expecting date format for -d option\n"), $badCmd=1, next;
$mt->Options('DateFormat', $fmt);
next;
}
(/^D$/ or $a eq 'decimal') and $showTagID = 'D', next;
/^delete_original(!?)$/i and $deleteOrig = ($1 ? 2 : 1), next;
/^list_dir$/i and $listDir = 1, next;
(/^e$/ or $a eq '-composite') and $mt->Options(Composite => 0), next;
(/^-e$/ or $a eq 'composite') and $mt->Options(Composite => 1), next;
(/^E$/ or $a eq 'escapehtml') and require Image::ExifTool::HTML and $escapeHTML = 1, next;
($a eq 'ec' or $a eq 'escapec') and $escapeC = 1, next;
($a eq 'ex' or $a eq 'escapexml') and $escapeXML = 1, next;
if (/^echo(\d)?$/i) {
my $n = $1 || 1;
my $arg = shift;
next unless defined $arg;
$n > 4 and Warn("Invalid -echo number\n"), next;
if ($n > 2) {
$n == 3 ? push(@echo3, $arg) : push(@echo4, $arg);
} else {
print {$n==2 ? \*STDERR : \*STDOUT} $arg, "\n";
}
$helped = 1;
next;
}
if (/^(ee|extractembedded)(\d*)$/i) {
$mt->Options(ExtractEmbedded => $2 || 1);
$mt->Options(Duplicates => 1);
next;
}
if (/^efile(\d)?(!)?$/i) {
my $arg = shift;
defined $arg or Error("Expecting file name for -$_ option\n"), $badCmd=1, next;
$efile[0] = $arg if not $1 or $1 & 0x01;
$efile[1] = $arg if $1 and $1 & 0x02;
$efile[2] = $arg if $1 and $1 & 0x04;
unlink $arg if $2;
next;
}
# (-execute handled at top of loop)
if (/^-?ext(ension)?(\+)?$/i) {
my $ext = shift;
defined $ext or Error("Expecting extension for -ext option\n"), $badCmd=1, next;
my $flag = /^-/ ? 0 : ($2 ? 2 : 1);
$filterFlag |= (0x01 << $flag);
$ext =~ s/^\.//; # remove leading '.' if it exists
$filterExt{uc($ext)} = $flag ? 1 : 0;
next;
}
if (/^f$/ or $a eq 'forceprint') {
$forcePrint = 1;
next;
}
if (/^F([-+]?\d*)$/ or /^fixbase([-+]?\d*)$/i) {
$mt->Options(FixBase => $1);
next;
}
if (/^fast(\d*)$/i) {
$mt->Options(FastScan => (length $1 ? $1 : 1));
next;
}
if (/^fileorder(\d*)$/i) {
push @fileOrder, shift if @ARGV;
my $num = $1 || 0;
$fileOrderFast = $num if not defined $fileOrderFast or $fileOrderFast > $num;
next;
}
$a eq 'globaltimeshift' and $mt->Options(GlobalTimeShift => shift), next;
if (/^(g)(roupHeadings|roupNames)?([\d:]*)$/i) {
$showGroup = $3 || 0;
$allGroup = ($2 ? lc($2) eq 'roupnames' : $1 eq 'G');
$mt->Options(SavePath => 1) if $showGroup =~ /\b5\b/;
$mt->Options(SaveFormat => 1) if $showGroup =~ /\b6\b/;
next;
}
if ($a eq 'geotag') {
my $trkfile = shift;
unless ($pass) {
# defer to next pass so the filename charset is available
push @nextPass, '-geotag', $trkfile;
next;
}
$trkfile or Error("Expecting file name for -geotag option\n"), $badCmd=1, next;
# allow wildcards in filename
if ($trkfile =~ /[*?]/) {
# CORE::glob() splits on white space, so use File::Glob if possible
my @trks;
if ($^O eq 'MSWin32' and eval { require Win32::FindFile }) {
# ("-charset filename=UTF8" must be set for this to work with Unicode file names)
@trks = FindFileWindows($mt, $trkfile);
} elsif (eval { require File::Glob }) {
@trks = File::Glob::bsd_glob($trkfile);
} else {
@trks = glob($trkfile);
}
@trks or Error("No matching file found for -geotag option\n"), $badCmd=1, next;
push @newValues, 'geotag='.shift(@trks) while @trks > 1;
$trkfile = pop(@trks);
}
$_ = "geotag=$trkfile";
# (fall through!)
}
if (/^h$/ or $a eq 'htmlformat') {
require Image::ExifTool::HTML;
$html = $escapeHTML = 1;
$json = $xml = 0;
next;
}
(/^H$/ or $a eq 'hex') and $showTagID = 'H', next;
if (/^htmldump([-+]?\d+)?$/i) {
$verbose = ($verbose || 0) + 1;
$html = 2;
$mt->Options(HtmlDumpBase => $1) if defined $1;
next;
}
if (/^i(gnore)?$/i) {
my $dir = shift;
defined $dir or Error("Expecting directory name for -i option\n"), $badCmd=1, next;
$ignore{$dir} = 1;
$dir eq 'HIDDEN' and $ignoreHidden = 1;
next;
}
if (/^if(\d*)$/i) {
my $cond = shift;
$fastCondition = $1 if length $1;
defined $cond or Error("Expecting expression for -if option\n"), $badCmd=1, next;
# prevent processing file unnecessarily for simple case of failed '$ok' or 'not $ok'
$cond =~ /^\s*(not\s*)\$ok\s*$/i and ($1 xor $rtnValPrev) and $failCondition=1;
# add to list of requested tags
push @requestTags, $cond =~ /\$\{?((?:[-\w]+:)*[-\w?*]+)/g;
push @condition, $cond;
next;
}
if (/^j(son)?(\+?=.*)?$/i) {
if ($2) {
# must process on 2nd pass because we need -f and -charset options
unless ($pass) {
push @nextPass, "-$_";
push @newValues, { SaveCount => ++$saveCount }; # marker to save new values now
$csvSaveCount = $saveCount;
next;
}
my $jsonFile = $2;
$jsonFile =~ s/^(\+?=)//;
$csvAdd = 2 if $1 eq '+=';
$vout = \*STDERR if $srcStdin;
$verbose and print $vout "Reading JSON file $jsonFile\n";
my $chset = $mt->Options('Charset');
my $msg;
if ($mt->Open(\*JSONFILE, $jsonFile)) {
binmode JSONFILE;
require Image::ExifTool::Import;
$msg = Image::ExifTool::Import::ReadJSON(\*JSONFILE, \%database, $forcePrint, $chset);
close(JSONFILE);
} else {
$msg = "Error opening JSON file '${jsonFile}'";
}
$msg and Warn("$msg\n");
$isWriting = 1;
$csv = 'JSON';
} else {
$json = 1;
$html = $xml = 0;
$mt->Options(Duplicates => 1);
require Image::ExifTool::XMP; # for FixUTF8()
}
next;
}
/^(k|pause)$/i and $pause = 1, next;
(/^l$/ or $a eq 'long') and --$outFormat, next;
(/^L$/ or $a eq 'latin') and $mt->Options(Charset => 'Latin'), next;
if ($a eq 'lang') {
$langOpt = (@ARGV and $ARGV[0] !~ /^(-|\xe2\x88\x92)/) ? shift : undef;
if ($langOpt) {
# make lower case and use underline as a separator (eg. 'en_ca')
$langOpt =~ tr/-A-Z/_a-z/;
$mt->Options(Lang => $langOpt);
next if $langOpt eq $mt->Options('Lang');
} else {
$pass or push(@nextPass, '-lang'), next;
}
my $langs = "Available languages:\n";
$langs .= " $_ - $Image::ExifTool::langName{$_}\n" foreach @Image::ExifTool::langs;
$langs =~ tr/_/-/; # display dashes instead of underlines in language codes
$langs = Image::ExifTool::HTML::EscapeHTML($langs) if $escapeHTML;
$langs = $mt->Decode($langs, 'UTF8');
$langOpt and Error("Invalid or unsupported language '${langOpt}'.\n$langs"), $badCmd=1, next;
print $langs;
$helped = 1;
next;
}
if ($a eq 'listitem') {
my $li = shift;
defined $li and Image::ExifTool::IsInt($li) or Warn("Expecting integer for -listItem option\n"), next;
$mt->Options(ListItem => $li);
$listItem = $li;
next;
}
/^(m|ignoreminorerrors)$/i and $mt->Options(IgnoreMinorErrors => 1), next;
/^(n|-printconv)$/i and $mt->Options(PrintConv => 0), next;
/^(-n|printconv)$/i and $mt->Options(PrintConv => 1), next;
$a eq 'nop' and $helped=1, next; # (undocumented) no operation, added in 11.25
if (/^o(ut)?$/i) {
$outOpt = shift;
defined $outOpt or Error("Expected output file or directory name for -o option\n"), $badCmd=1, next;
CleanFilename($outOpt);
# verbose messages go to STDERR of output is to console
$vout = \*STDERR if $vout =~ /^-(\.\w+)?$/;
next;
}
/^overwrite_original$/i and $overwriteOrig = 1, next;
/^overwrite_original_in_place$/i and $overwriteOrig = 2, next;
if (/^p$/ or $a eq 'printformat') {
my $fmt = shift;
if ($pass) {
LoadPrintFormat($fmt);
# load MWG module now if necessary
if (not $useMWG and grep /^mwg:/i, @requestTags) {
$useMWG = 1;
require Image::ExifTool::MWG;
Image::ExifTool::MWG::Load();
}
} else {
# defer to next pass so the filename charset is available
push @nextPass, '-p', $fmt;
}
next;
}
(/^P$/ or $a eq 'preserve') and $preserveTime = 1, next;
/^password$/i and $mt->Options(Password => shift), next;
if (/^progress(:.*)?$/i) {
if ($1) {
$windowTitle = substr $1, 1;
$windowTitle = 'ExifTool %p%%' unless length $windowTitle;
$windowTitle =~ /%\d*[bpr]/ and $progress = 0 unless defined $progress;
} else {
$progress = 1;
$verbose = 0 unless defined $verbose;
}
$progressCount = 0;
next;
}
/^q(uiet)?$/i and ++$quiet, next;
/^r(ecurse)?(\.?)$/i and $recurse = ($2 ? 2 : 1), next;
if ($a eq 'require') { # (undocumented) added in version 8.65
my $ver = shift;
unless (defined $ver and Image::ExifTool::IsFloat($ver)) {
Error("Expecting version number for -require option\n");
$badCmd = 1;
next;
}
unless ($Image::ExifTool::VERSION >= $ver) {
Error("Requires ExifTool version $ver or later\n");
$badCmd = 1;
}
next;
}
/^restore_original$/i and $deleteOrig = 0, next;
(/^S$/ or $a eq 'veryshort') and $outFormat+=2, next;
/^s(hort)?(\d*)$/i and $outFormat = $2 eq '' ? $outFormat + 1 : $2, next;
/^scanforxmp$/i and $mt->Options(ScanForXMP => 1), next;
if (/^sep(arator)?$/i) {
my $sep = $listSep = shift;
defined $listSep or Error("Expecting list item separator for -sep option\n"), $badCmd=1, next;
$sep =~ s/\\(.)/$unescapeChar{$1}||$1/sge; # translate escape sequences
(defined $binSep ? $binTerm : $binSep) = $sep;
$mt->Options(ListSep => $listSep);
$joinLists = 1;
# also split when writing values
my $listSplit = quotemeta $listSep;
# a space in the string matches zero or more whitespace characters
$listSplit =~ s/(\\ )+/\\s\*/g;
# but a single space alone matches one or more whitespace characters
$listSplit = '\\s+' if $listSplit eq '\\s*';
$mt->Options(ListSplit => $listSplit);
next;
}
/^(-)?sort$/i and $sortOpt = $1 ? 0 : 1, next;
if ($a eq 'srcfile') {
@ARGV or Warn("Expecting FMT for -srcfile option\n"), next;
push @srcFmt, shift;
next;
}
if ($a eq 'stay_open') {
my $arg = shift;
defined $arg or Warn("Expecting argument for -stay_open option\n"), next;
if ($arg =~ /^(1|true)$/i) {
if (not $stayOpen) {
$stayOpen = 1;
} elsif ($stayOpen == 2) {
$stayOpen = 3; # chained -stay_open options
} else {
Warn "-stay_open already active\n";
}
} elsif ($arg =~ /^(0|false)$/i) {
if ($stayOpen >= 2) {
# close -stay_open argfile and process arguments up to this point
close STAYOPEN;
push @ARGV, @moreArgs;
undef @moreArgs;
} elsif (not $stayOpen) {
Warn("-stay_open wasn't active\n");
}
$stayOpen = 0;
} else {
Warn "Invalid argument for -stay_open\n";
}
next;
}
if (/^(-)?struct$/i) {
$mt->Options(Struct => $1 ? 0 : 1);
next;
}
/^t(ab)?$/ and $tabFormat = 1, next;
if (/^T$/ or $a eq 'table') {
$tabFormat = $forcePrint = 1; $outFormat+=2; ++$quiet;
next;
}
if (/^(u)(nknown(2)?)?$/i) {
my $inc = ($3 or (not $2 and $1 eq 'U')) ? 2 : 1;
$mt->Options(Unknown => $mt->Options('Unknown') + $inc);
next;
}
if ($a eq 'use') {
my $module = shift;
$module or Error("Expecting module name for -use option\n"), $badCmd=1, next;
lc $module eq 'mwg' and $useMWG = 1, next;
$module =~ /[^\w:]/ and Error("Invalid module name: $module\n"), $badCmd=1, next;
local $SIG{'__WARN__'} = sub { $evalWarning = $_[0] };
unless (eval "require Image::ExifTool::$module" or
eval "require $module" or
eval "require '${module}'")
{
Error("Error using module $module\n");
$badCmd = 1;
}
next;
}
if ($a eq 'userparam') {
my $opt = shift;
defined $opt or Error("Expected parameter for -userParam option\n"), $badCmd=1, next;
$opt =~ /=/ or $opt .= '=1';
$mt->Options(UserParam => $opt);
next;
}
if (/^v(erbose)?(\d*)$/i) {
$verbose = ($2 eq '') ? ($verbose || 0) + 1 : $2;
next;
}
if (/^(w|textout|tagout)([!+]*)$/i) {
$textOut = shift || Warn("Expecting output extension for -$_ option\n");
my ($t1, $t2) = ($1, $2);
$textOverwrite = 0;
$textOverwrite += 1 if $t2 =~ /!/; # overwrite
$textOverwrite += 2 if $t2 =~ /\+/; # append
if ($t1 ne 'W' and lc($t1) ne 'tagout') {
undef $tagOut;
} elsif ($textOverwrite >= 2 and $textOut !~ /%[-+]?\d*[.:]?\d*[lu]?[tgso]/) {
$tagOut = 0; # append tags to one file
} else {
$tagOut = 1; # separate file for each tag
}
next;
}
if (/^(-?)(wext|tagoutext)$/i) {
my $ext = shift;
defined $ext or Error("Expecting extension for -wext option\n"), $badCmd=1, next;
my $flag = 1;
$1 and $wext{'*'} = 1, $flag = -1;
$ext =~ s/^\.//;
$wext{lc $ext} = $flag;
next;
}
if ($a eq 'wm' or $a eq 'writemode') {
my $wm = shift;
defined $wm or Error("Expecting argument for -$_ option\n"), $badCmd=1, next;
$wm =~ /^[wcg]*$/i or Error("Invalid argument for -$_ option\n"), $badCmd=1, next;
$mt->Options(WriteMode => $wm);
next;
}
if (/^x$/ or $a eq 'exclude') {
my $tag = shift;
defined $tag or Error("Expecting tag name for -x option\n"), $badCmd=1, next;
$tag =~ s/\ball\b/\*/ig; # replace 'all' with '*' in tag names
if ($setTagsFile) {
push @{$setTags{$setTagsFile}}, "-$tag";
} else {
push @exclude, $tag;
}
next;
}
(/^X$/ or $a eq 'xmlformat') and $xml = 1, $html = $json = 0, $mt->Options(Duplicates => 1), next;
if (/^php$/i) {
$json = 2;
$html = $xml = 0;
$mt->Options(Duplicates => 1);
next;
}
if (/^z(ip)?$/i) {
$doUnzip = 1;
$mt->Options(Compress => 1, XMPShorthand => 1);
$mt->Options(Compact => 1) unless $mt->Options('Compact');
next;
}
$_ eq '' and push(@files, '-'), $srcStdin = 1, next; # read STDIN
length $_ eq 1 and $_ ne '*' and Error("Unknown option -$_\n"), $badCmd=1, next;
if (/^[^<]+(<?)=(.*)/s) {
my $val = $2;
if ($1 and length($val) and ($val eq '@' or not defined FilenameSPrintf($val))) {
# save count of new values before a dynamic value
push @newValues, { SaveCount => ++$saveCount };
}
push @newValues, $_;
if (/^mwg:/i) {
$useMWG = 1;
} elsif (/^([-\w]+:)*(filename|directory|testname)\b/i) {
$doSetFileName = 1;
} elsif (/^([-\w]+:)*(geotag|geotime|geosync)\b/i) {
if (lc $2 eq 'geotime') {
$addGeotime = '';
} else {
# add geotag/geosync commands first
unshift @newValues, pop @newValues;
if (lc $2 eq 'geotag' and (not defined $addGeotime or $addGeotime) and length $val) {
$addGeotime = ($1 || '') . 'Geotime<DateTimeOriginal#';
}
}
}
} else {
# assume '-tagsFromFile @' if tags are being redirected
# and -tagsFromFile hasn't already been specified
AddSetTagsFile($setTagsFile = '@') if not $setTagsFile and /(<|>)/;
if ($setTagsFile) {
push @{$setTags{$setTagsFile}}, $_;
if (/>/) {
$useMWG = 1 if /^(.*>\s*)?mwg:/si;
if (/\b(filename|directory|testname)#?$/i) {
$doSetFileName = 1;
} elsif (/\bgeotime#?$/i) {
$addGeotime = '';
}
} else {
$useMWG = 1 if /^([^<]+<\s*(.*\$\{?)?)?mwg:/si;
if (/^([-\w]+:)*(filename|directory|testname)\b/i) {
$doSetFileName = 1;
} elsif (/^([-\w]+:)*geotime\b/i) {
$addGeotime = '';
}
}
} else {
my $lst = s/^-// ? \@exclude : \@tags;
unless (/^([-\w*]+:)*([-\w*?]+)#?$/) {
Warn(qq(Invalid TAG name: "$_"\n));
}
push @$lst, $_; # (push everything for backward compatibility)
}
}
} else {
unless ($pass) {
# defer to next pass so the filename charset is available
push @nextPass, $_;
next;
}
if ($doGlob and /[*?]/) {
if ($^O eq 'MSWin32' and eval { require Win32::FindFile }) {
push @files, FindFileWindows($mt, $_);
} else {
# glob each filespec if necessary - MK/20061010
push @files, File::Glob::bsd_glob($_);
}
$doGlob = 2;
} else {
push @files, $_;
$srcStdin = 1 if $_ eq '-';
}
}
}
# set "OK" UserParam based on result of last command
$mt->Options(UserParam => 'OK=' . (not $rtnValPrev));
# set verbose output to STDERR if output could be to console
$vout = \*STDERR if $srcStdin and ($isWriting or @newValues);
$mt->Options(TextOut => $vout) if $vout eq \*STDERR;
# change default EXIF string encoding if MWG used
if ($useMWG and not defined $mt->Options('CharsetEXIF')) {
$mt->Options(CharsetEXIF => 'UTF8');
}
# print help
unless ((@tags and not $outOpt) or @files or @newValues) {
if ($doGlob and $doGlob == 2) {
Warn "No matching files\n";
$rtnVal = 1;
next;
}
if ($outOpt) {
Warn "Nothing to write\n";
$rtnVal = 1;
next;
}
Help() unless $helped;
next;
}
# do sanity check on -delete_original and -restore_original
if (defined $deleteOrig and (@newValues or @tags)) {
if (not @newValues) {
my $verb = $deleteOrig ? 'deleting' : 'restoring from';
Warn "Can't specify tags when $verb originals\n";
} elsif ($deleteOrig) {
Warn "Can't use -delete_original when writing.\n";
Warn "Maybe you meant -overwrite_original ?\n";
} else {
Warn "It makes no sense to use -restore_original when writing\n";
}
$rtnVal = 1;
next;
}
if ($overwriteOrig > 1 and $outOpt) {
Warn "Can't overwrite in place when -o option is used\n";
$rtnVal = 1;
next;
}
if ($tagOut and ($csv or %printFmt or $tabFormat or $xml or ($verbose and $html))) {
Warn "Sorry, -W may not be combined with -csv, -htmlDump, -j, -p, -t or -X\n";
$rtnVal = 1;
next;
}
if ($csv and $csv eq 'CSV' and not $isWriting) {
if ($textOut) {
Warn "Sorry, -w may not be combined with -csv\n";
$rtnVal = 1;
next;
}
if ($binaryOutput) {
$binaryOutput = 0;
$setCharset = 'default' unless defined $setCharset;
}
require Image::ExifTool::XMP if $setCharset;
}
if ($escapeHTML or $json) {
# must be UTF8 for HTML conversion and JSON output
$mt->Options(Charset => 'UTF8') if $json;
# use Escape option to do our HTML escaping unless XML output
$mt->Options(Escape => 'HTML') if $escapeHTML and not $xml;
} elsif ($escapeXML and not $xml) {
$mt->Options(Escape => 'XML');
}
# set sort option
if ($sortOpt) {
# (note that -csv sorts alphabetically by default anyway if more than 1 file)
my $sort = ($outFormat > 0 or $xml or $json or $csv) ? 'Tag' : 'Descr';
$mt->Options(Sort => $sort, Sort2 => $sort);
}
# set $structOpt in case set by API option
if ($mt->Options('Struct') and not $structOpt) {
$structOpt = $mt->Options('Struct');
require 'Image/ExifTool/XMPStruct.pl';
}
# set up for RDF/XML, JSON and PHP output formats
if ($xml) {
require Image::ExifTool::XMP; # for EscapeXML()
my $charset = $mt->Options('Charset');
# standard XML encoding names for supported Charset settings
# (ref http://www.iana.org/assignments/character-sets)
my %encoding = (
UTF8 => 'UTF-8',
Latin => 'windows-1252',
Latin2 => 'windows-1250',
Cyrillic => 'windows-1251',
Greek => 'windows-1253',
Turkish => 'windows-1254',
Hebrew => 'windows-1255',
Arabic => 'windows-1256',
Baltic => 'windows-1257',
Vietnam => 'windows-1258',
MacRoman => 'macintosh',
);
# switch to UTF-8 if we don't have a standard encoding name
unless ($encoding{$charset}) {
$charset = 'UTF8';
$mt->Options(Charset => $charset);
}
# set file header/trailer for XML output
$fileHeader = "<?xml version='1.0' encoding='$encoding{$charset}'?>\n" .
"<rdf:RDF xmlns:rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#'>\n";
$fileTrailer = "</rdf:RDF>\n";
# extract as a list unless short output format
$joinLists = 1 if $outFormat > 0;
$mt->Options(List => 1) unless $joinLists;
$showGroup = $allGroup = 1; # always show group 1
# set binaryOutput flag to 0 or undef (0 = output encoded binary in XML)
$binaryOutput = ($outFormat > 0 ? undef : 0) if $binaryOutput;
$showTagID = 'D' if $tabFormat and not $showTagID;
} elsif ($json) {
if ($json == 1) { # JSON
$fileHeader = '[';
$fileTrailer = "]\n";
} else { # PHP
$fileHeader = 'Array(';
$fileTrailer = ");\n";
}
# allow binary output in a text-mode file when -php/-json and -b used together
# (this works because PHP strings are simple arrays of bytes, and CR/LF
# won't be messed up in the text mode output because they are converted
# to escape sequences in the strings)
if ($binaryOutput) {
$binaryOutput = 0;
require Image::ExifTool::XMP if $json == 1; # (for EncodeBase64)
}
$mt->Options(List => 1) unless $joinLists;
$showTagID = 'D' if $tabFormat and not $showTagID;
} elsif ($structOpt) {
$mt->Options(List => 1);
} else {
$joinLists = 1; # join lists for all other unstructured output formats
}
if ($argFormat) {
$outFormat = 3;
$allGroup = 1 if defined $showGroup;
}
# change to forward slashes if necessary in all filenames (like CleanFilename)
if ($hasBackslash{$^O}) {
tr/\\/\// foreach @files;
}
# can't do anything if no file specified
unless (@files) {
unless ($outOpt) {
if ($doGlob and $doGlob == 2) {
Warn "No matching files\n";
} else {
Warn "No file specified\n";
}
$rtnVal = 1;
next;
}
push @files, ''; # create file from nothing
}
# set Verbose and HtmlDump options
if ($verbose) {
$disableOutput = 1 unless @tags or @exclude or $tagOut;
undef $binaryOutput unless $tagOut; # disable conflicting option
if ($html) {
$html = 2; # flag for html dump
$mt->Options(HtmlDump => $verbose);
} else {
$mt->Options(Verbose => $verbose) unless $tagOut;
}
} elsif (defined $verbose) {
# auto-flush output when -v0 is used
require FileHandle;
STDOUT->autoflush(1);
STDERR->autoflush(1);
}
# validate all tags we're writing
my $needSave = 1;
if (@newValues) {
# assume -geotime value if -geotag specified without -geotime
if ($addGeotime) {
AddSetTagsFile($setTagsFile = '@') unless $setTagsFile and $setTagsFile eq '@';
push @{$setTags{$setTagsFile}}, $addGeotime;
$verbose and print $vout qq{Argument "-$addGeotime" is assumed\n};
}
my %setTagsIndex;
# add/delete option lookup
my %addDelOpt = ( '+' => 'AddValue', '-' => 'DelValue', "\xe2\x88\x92" => 'DelValue' );
$saveCount = 0;
foreach (@newValues) {
if (ref $_ eq 'HASH') {
# save new values now if we stored a "SaveCount" marker
if ($$_{SaveCount}) {
$saveCount = $mt->SaveNewValues();
$needSave = 0;
# insert marker to load values from CSV file now if this was the CSV file
push @dynamicFiles, \$csv if $$_{SaveCount} == $csvSaveCount;
}
next;
}
/(.*?)=(.*)/s or next;
my ($tag, $newVal) = ($1, $2);
$tag =~ s/\ball\b/\*/ig; # replace 'all' with '*' in tag names
$newVal eq '' and undef $newVal unless $tag =~ s/\^([-+]*)$/$1/; # undefined to delete tag
if ($tag =~ /^(All)?TagsFromFile$/i) {
defined $newVal or Error("Need file name for -tagsFromFile\n"), next Command;
++$isWriting;
if ($newVal eq '@' or not defined FilenameSPrintf($newVal)) {
push @dynamicFiles, $newVal;
next; # set tags from dynamic file later
}
unless ($mt->Exists($newVal) or $newVal eq '-') {
Warn "File '${newVal}' does not exist for -tagsFromFile option\n";
$rtnVal = 1;
next Command;
}
my $setTags = $setTags{$newVal};
# do we have multiple -tagsFromFile options with this file?
if ($setTagsList{$newVal}) {
# use the tags set in the i-th occurrence
my $i = $setTagsIndex{$newVal} || 0;
$setTagsIndex{$newVal} = $i + 1;
$setTags = $setTagsList{$newVal}[$i] if $setTagsList{$newVal}[$i];
}
# set specified tags from this file
unless (DoSetFromFile($mt, $newVal, $setTags)) {
$rtnVal = 1;
next Command;
}
$needSave = 1;
next;
}
my %opts = ( Shift => 0 ); # shift values if possible instead of adding/deleting
# allow writing of 'Unsafe' tags unless specified by wildcard
$opts{Protected} = 1 unless $tag =~ /[?*]/;
if ($tag =~ s/<// and defined $newVal) {
if (defined FilenameSPrintf($newVal)) {
SlurpFile($newVal, \$newVal) or next; # read file data into $newVal
} else {
$tag =~ s/([-+]|\xe2\x88\x92)$// and $opts{$addDelOpt{$1}} = 1;
# verify that this tag can be written
my $result = Image::ExifTool::IsWritable($tag);
if ($result) {
$opts{ProtectSaved} = $saveCount; # protect new values set after this
# add to list of dynamic tag values
push @dynamicFiles, [ $tag, $newVal, \%opts ];
++$isWriting;
} elsif (defined $result) {
Warn "Tag '${tag}' is not writable\n";
} else {
Warn "Tag '${tag}' does not exist\n";
}
next;
}
}
if ($tag =~ s/([-+]|\xe2\x88\x92)$//) {
$opts{$addDelOpt{$1}} = 1; # set AddValue or DelValue option
# set $newVal to '' if deleting nothing
$newVal = '' if $1 eq '-' and not defined $newVal;
}
if ($escapeC and defined $newVal) {
$newVal =~ s/\\(x([0-9a-fA-F]{2})|.)/$2 ? chr(hex($2)) : $unescC{$1} || $1/seg;
}
my ($rtn, $wrn) = $mt->SetNewValue($tag, $newVal, %opts);
$needSave = 1;
++$isWriting if $rtn;
$wrn and Warn "Warning: $wrn\n";
}
# exclude specified tags
foreach (@exclude) {
$mt->SetNewValue($_, undef, Replace => 2);
$needSave = 1;
}
unless ($isWriting or $outOpt or @tags) {
Warn "Nothing to do.\n";
$rtnVal = 1;
next;
}
} elsif (grep /^(\*:)?\*$/, @exclude) {
Warn "All tags excluded -- nothing to do.\n";
$rtnVal = 1;
next;
}
if ($isWriting and @tags and not $outOpt) {
my ($tg, $s) = @tags > 1 ? ("$tags[0] ...", 's') : ($tags[0], '');
Warn "Ignored superfluous tag name$s or invalid option$s: -$tg\n";
}
# save current state of new values if setting values from target file
# or if we may be translating to a different format
$mt->SaveNewValues() if $outOpt or (@dynamicFiles and $needSave);
$multiFile = 1 if @files > 1;
@exclude and $mt->Options(Exclude => \@exclude);
undef $binaryOutput if $html;
if ($binaryOutput) {
$outFormat = 99; # shortest possible output format
$mt->Options(PrintConv => 0);
unless ($textOut or $binaryStdout) {
binmode(STDOUT);
$binaryStdout = 1;
$mt->Options(TextOut => ($vout = \*STDERR));
}
# disable conflicting options
undef $showGroup;
}
# sort by groups to look nicer depending on options
if (defined $showGroup and not (@tags and $allGroup) and ($sortOpt or not defined $sortOpt)) {
$mt->Options(Sort => "Group$showGroup");
}
if (defined $textOut) {
CleanFilename($textOut); # make all forward slashes
# add '.' before output extension if necessary
$textOut = ".$textOut" unless $textOut =~ /[.%]/ or defined $tagOut;
}
# determine if we should scan for only writable files
if ($outOpt) {
my $type = GetFileType($outOpt);
if ($type) {
unless (CanWrite($type)) {
Warn "Can't write $type files\n";
$rtnVal = 1;
next;
}
$scanWritable = $type unless CanCreate($type);
} else {
$scanWritable = 1;
}
$isWriting = 1; # set writing flag
} elsif ($isWriting or defined $deleteOrig) {
$scanWritable = 1;
}
# initialize alternate encoding flag
$altEnc = $mt->Options('Charset');
undef $altEnc if $altEnc eq 'UTF8';
# set flag to fix description lengths if necessary
if (not $altEnc and $mt->Options('Lang') ne 'en' and eval { require Encode }) {
# (note that Unicode::GCString is part of the Unicode::LineBreak package)
$fixLen = eval { require Unicode::GCString } ? 2 : 1;
}
# sort input files if specified
if (@fileOrder) {
my @allFiles;
ProcessFiles($mt, \@allFiles);
my $sortTool = new Image::ExifTool;
$sortTool->Options(FastScan => $fileOrderFast) if $fileOrderFast;
$sortTool->Options(PrintConv => $mt->Options('PrintConv'));
$sortTool->Options(Duplicates => 0);
my (%sortBy, %isFloat, @rev, $file);
# save reverse sort flags
push @rev, (s/^-// ? 1 : 0) foreach @fileOrder;
foreach $file (@allFiles) {
my @tags;
my $info = $sortTool->ImageInfo(Infile($file,1), @fileOrder, \@tags);
# get values of all tags (or '~' to sort last if not defined)
foreach (@tags) {
$_ = $$info{$_}; # put tag value into @tag list
defined $_ or $_ = '~', next;
$isFloat{$_} = Image::ExifTool::IsFloat($_);
# pad numbers to 12 digits to keep them sequential
s/(\d+)/(length($1) < 12 ? '0'x(12-length($1)) : '') . $1/eg unless $isFloat{$_};
}
$sortBy{$file} = \@tags; # save tag values for each file
}
# sort in specified order
@files = sort {
my ($i, $cmp);
for ($i=0; $i<@rev; ++$i) {
my $u = $sortBy{$a}[$i];
my $v = $sortBy{$b}[$i];
if (not $isFloat{$u} and not $isFloat{$v}) {
$cmp = $u cmp $v; # alphabetically
} elsif ($isFloat{$u} and $isFloat{$v}) {
$cmp = $u <=> $v; # numerically
} else {
$cmp = $isFloat{$u} ? -1 : 1; # numbers first
}
return $rev[$i] ? -$cmp : $cmp if $cmp;
}
return $a cmp $b; # default to sort by name
} @allFiles;
} elsif (defined $progress) {
# expand FILE argument to count the number of files to process
my @allFiles;
ProcessFiles($mt, \@allFiles);
@files = @allFiles;
}
# set file count for progress message
$progressMax = scalar @files if defined $progress;
# store duplicate database information under absolute path
my @dbKeys = keys %database;
if (@dbKeys) {
if (eval { require Cwd }) {
undef $evalWarning;
local $SIG{'__WARN__'} = sub { $evalWarning = $_[0] };
foreach (@dbKeys) {
my $db = $database{$_};
tr/\\/\// and $database{$_} = $db; # allow for backslashes in SourceFile
# (punt on using ConvertFileName here, so $absPath may be a mix of encodings)
my $absPath = AbsPath($_);
if (defined $absPath) {
$database{$absPath} = $db unless $database{$absPath};
if ($verbose and $verbose > 1) {
print $vout "Imported entry for '${_}' (full path: '${absPath}')\n";
}
} elsif ($verbose and $verbose > 1) {
print $vout "Imported entry for '${_}' (non-existent file)\n";
}
}
}
}
# process all specified files
ProcessFiles($mt);
if ($filtered and not $validFile) {
Warn "No file with specified extension\n";
$rtnVal = 1;
}
# print CSV information if necessary
PrintCSV() if $csv and not $isWriting;
# print folder/file trailer if necessary
if ($textOut) {
foreach (keys %outTrailer) {
next unless $outTrailer{$_};
if ($mt->Open(\*OUTTRAIL, $_, '>>')) {
my $fp = \*OUTTRAIL;
print $fp $outTrailer{$_};
close $fp;
} else {
Error("Error appending to $_\n");
}
}
} else {
print $sectTrailer if $sectTrailer;
print $fileTrailer if $fileTrailer and not $fileHeader;
}
my $totWr = $countGoodWr + $countBadWr + $countSameWr + $countCopyWr +
$countGoodCr + $countBadCr;
if (defined $deleteOrig) {
# print summary and delete requested files
unless ($quiet) {
printf "%5d directories scanned\n", $countDir if $countDir;
printf "%5d directories created\n", $countNewDir if $countNewDir;
printf "%5d files failed condition\n", $countFailed if $countFailed;
printf "%5d image files found\n", $count;
}
if (@delFiles) {
# verify deletion unless "-delete_original!" was specified
if ($deleteOrig == 1) {
printf '%5d originals will be deleted! Are you sure [y/n]? ', scalar(@delFiles);
my $response = <STDIN>;
unless ($response =~ /^(y|yes)\s*$/i) {
Warn "Originals not deleted.\n";
next;
}
}
$countGoodWr = $mt->Unlink(@delFiles);
$countBad = scalar(@delFiles) - $countGoodWr;
}
if ($quiet) {
# no more messages
} elsif ($count and not $countGoodWr and not $countBad) {
printf "%5d original files found\n", $countGoodWr; # (this will be 0)
} elsif ($deleteOrig) {
printf "%5d original files deleted\n", $countGoodWr if $count;
printf "%5d originals not deleted due to errors\n", $countBad if $countBad;
} else {
printf "%5d image files restored from original\n", $countGoodWr if $count;
printf "%5d files not restored due to errors\n", $countBad if $countBad;
}
} elsif ((not $binaryStdout or $verbose) and not $quiet) {
# print summary
my $tot = $count + $countBad;
if ($countDir or $totWr or $countFailed or $tot > 1 or $textOut or %countLink) {
my $o = (($html or $json or $xml or %printFmt or $csv) and not $textOut) ? \*STDERR : $vout;
printf($o "%5d directories scanned\n", $countDir) if $countDir;
printf($o "%5d directories created\n", $countNewDir) if $countNewDir;
printf($o "%5d files failed condition\n", $countFailed) if $countFailed;
printf($o "%5d image files created\n", $countGoodCr) if $countGoodCr;
printf($o "%5d image files updated\n", $countGoodWr) if $totWr - $countGoodCr - $countBadCr - $countCopyWr;
printf($o "%5d image files unchanged\n", $countSameWr) if $countSameWr;
printf($o "%5d image files %s\n", $countCopyWr, $overwriteOrig ? 'moved' : 'copied') if $countCopyWr;
printf($o "%5d files weren't updated due to errors\n", $countBadWr) if $countBadWr;
printf($o "%5d files weren't created due to errors\n", $countBadCr) if $countBadCr;
printf($o "%5d image files read\n", $count) if ($tot+$countFailed)>1 or ($countDir and not $totWr);
printf($o "%5d files could not be read\n", $countBad) if $countBad;
printf($o "%5d output files created\n", scalar(keys %created)) if $textOut;
printf($o "%5d output files appended\n", scalar(keys %appended)) if %appended;
printf($o "%5d hard links created\n", $countLink{Hard} || 0) if $countLink{Hard} or $countLink{BadHard};
printf($o "%5d hard links could not be created\n", $countLink{BadHard}) if $countLink{BadHard};
printf($o "%5d symbolic links created\n", $countLink{Sym} || 0) if $countLink{Sym} or $countLink{BadSym};
printf($o "%5d symbolic links could not be created\n", $countLink{BadSym}) if $countLink{BadSym};
}
}
# set error status if we had any errors or if all files failed the "-if" condition
if ($countBadWr or $countBadCr or $countBad) {
$rtnVal = 1;
} elsif ($countFailed and not ($count or $totWr) and not $rtnVal) {
$rtnVal = 2;
}
# clean up after each command
Cleanup();
} # end "Command" loop ........................................................
close STAYOPEN if $stayOpen >= 2;
Exit $rtnValApp; # all done
#------------------------------------------------------------------------------
# Get image information from EXIF data in file (or write file if writing)
# Inputs: 0) ExifTool object reference, 1) file name
sub GetImageInfo($$)
{
my ($et, $orig) = @_;
my (@foundTags, $info, $file, $ind);
# set window title for this file if necessary
if (defined $windowTitle) {
my $prog = $progressMax ? "$progressCount/$progressMax" : '0/0';
my $title = $windowTitle;
my ($num, $denom) = split '/', $prog;
my $frac = $num / ($denom || 1);
my $n = $title =~ s/%(\d+)b/%b/ ? $1 : 20; # length of bar
my $bar = int($frac * $n + 0.5);
my %lkup = (
b => ('I' x $bar) . ('.' x ($n - $bar)), # (undocumented)
f => $orig,
p => int(100 * $frac + 0.5),
r => $prog,
'%'=> '%',
);
$title =~ s/%([%bfpr])/$lkup{$1}/eg;
SetWindowTitle($title);
}
unless (length $orig or $outOpt) {
Warn qq(Error: Zero-length file name - ""\n);
++$countBad;
return;
}
# determine the name of the source file based on the original input file name
if (@srcFmt) {
my ($fmt, $first);
foreach $fmt (@srcFmt) {
$file = $fmt eq '@' ? $orig : FilenameSPrintf($fmt, $orig);
# use this file if it exists
$et->Exists($file) and undef($first), last;
$verbose and print $vout "Source file $file does not exist\n";
$first = $file unless defined $first;
}
$file = $first if defined $first;
my ($d, $f) = Image::ExifTool::SplitFileName($orig);
$et->Options(UserParam => "OriginalDirectory#=$d");
$et->Options(UserParam => "OriginalFileName#=$f");
} else {
$file = $orig;
}
my $pipe = $file;
if ($doUnzip) {
# pipe through gzip or bzip2 if necessary
if ($file =~ /\.(gz|bz2)$/i) {
my $type = lc $1;
if ($file =~ /[^-_.'A-Za-z0-9\/\\]/) {
Warn "Error: Insecure zip file name. Skipped\n";
EFile($file);
++$countBad;
return;
}
if ($type eq 'gz') {
$pipe = qq{gzip -dc "$file" |};
} else {
$pipe = qq{bzip2 -dc "$file" |};
}
$$et{TRUST_PIPE} = 1;
}
}
# evaluate -if expression for conditional processing
if (@condition) {
unless ($file eq '-' or $et->Exists($file)) {
Warn "Error: File not found - $file\n";
EFile($file);
FileNotFound($file);
++$countBad;
return;
}
my $result;
unless ($failCondition) {
# catch run time errors as well as compile errors
undef $evalWarning;
local $SIG{'__WARN__'} = sub { $evalWarning = $_[0] };
my (%info, $condition);
# extract information and build expression for evaluation
my $opts = { Duplicates => 1, RequestTags => \@requestTags, Verbose => 0, HtmlDump => 0 };
$$opts{FastScan} = $fastCondition if defined $fastCondition;
# return all tags but explicitly mention tags on command line so
# requested images will generate the appropriate warnings
@foundTags = ('*', @tags) if @tags;
$info = $et->ImageInfo(Infile($pipe,$isWriting), \@foundTags, $opts);
foreach $condition (@condition) {
my $cond = $et->InsertTagValues(\@foundTags, $condition, \%info);
{
# set package so eval'd functions are in Image::ExifTool namespace
package Image::ExifTool;
my $self = $et;
#### eval "-if" condition (%info, $self)
$result = eval $cond;
$@ and $evalWarning = $@;
}
if ($evalWarning) {
# fail condition if warning is issued
undef $result;
if ($verbose) {
chomp $evalWarning;
$evalWarning =~ s/ at \(eval .*//s;
Warn "Condition: $evalWarning - $file\n";
}
}
last unless $result;
}
undef @foundTags if $fastCondition; # ignore if we didn't get all tags
}
unless ($result) {
$verbose and print $vout "-------- $file (failed condition)$progStr\n";
EFile($file, 2);
++$countFailed;
return;
}
# can't make use of $info if verbose because we must reprocess
# the file anyway to generate the verbose output
undef $info if $verbose or defined $fastCondition;
}
if (defined $deleteOrig) {
print $vout "======== $file$progStr\n" if defined $verbose;
++$count;
my $original = "${file}_original";
$et->Exists($original) or return;
if ($deleteOrig) {
$verbose and print $vout "Scheduled for deletion: $original\n";
push @delFiles, $original;
} elsif ($et->Rename($original, $file)) {
$verbose and print $vout "Restored from $original\n";
++$countGoodWr;
} else {
Warn "Error renaming $original\n";
EFile($file);
++$countBad;
}
return;
}
++$seqFileNum; # increment our file counter
my $lineCount = 0;
my ($fp, $outfile, $append);
if ($textOut and $verbose and not $tagOut) {
($fp, $outfile, $append) = OpenOutputFile($orig);
$fp or EFile($file), ++$countBad, return;
# delete file if we exit prematurely (unless appending)
$tmpText = $outfile unless $append;
$et->Options(TextOut => $fp);
}
if ($isWriting) {
print $vout "======== $file$progStr\n" if defined $verbose;
SetImageInfo($et, $file, $orig);
$info = $et->GetInfo('Warning', 'Error');
PrintErrors($et, $info, $file);
# close output text file if necessary
if ($outfile) {
undef $tmpText;
close($fp);
$et->Options(TextOut => $vout);
if ($info->{Error}) {
$et->Unlink($outfile); # erase bad file
} elsif ($append) {
$appended{$outfile} = 1 unless $created{$outfile};
} else {
$created{$outfile} = 1;
}
}
return;
}
# extract information from this file
unless ($file eq '-' or $et->Exists($file)) {
Warn "Error: File not found - $file\n";
FileNotFound($file);
$outfile and close($fp), undef($tmpText), $et->Unlink($outfile);
EFile($file);
++$countBad;
return;
}
# print file/progress message
my $o;
unless ($binaryOutput or $textOut or %printFmt or $html > 1 or $csv) {
if ($html) {
require Image::ExifTool::HTML;
my $f = Image::ExifTool::HTML::EscapeHTML($file);
print "<!-- $f -->\n";
} elsif (not ($json or $xml)) {
$o = \*STDOUT if ($multiFile and not $quiet) or $progress;
}
}
$o = \*STDERR if $progress and not $o;
$o and print $o "======== $file$progStr\n";
if ($info) {
# get the information we wanted
if (@tags and not %printFmt) {
@foundTags = @tags;
$info = $et->GetInfo(\@foundTags);
}
} else {
# request specified tags unless using print format option
my $oldDups = $et->Options('Duplicates');
if (%printFmt) {
$et->Options(Duplicates => 1);
$et->Options(RequestTags => \@requestTags);
} else {
@foundTags = @tags;
}
# extract the information
$info = $et->ImageInfo(Infile($pipe), \@foundTags);
$et->Options(Duplicates => $oldDups);
}
# all done now if we already wrote output text file (eg. verbose option)
if ($fp) {
if ($outfile) {
$et->Options(TextOut => \*STDOUT);
undef $tmpText;
if ($info->{Error}) {
close($fp);
$et->Unlink($outfile); # erase bad file
} else {
++$lineCount; # output text file (likely) is not empty
}
}
if ($info->{Error}) {
Warn "Error: $info->{Error} - $file\n";
EFile($file);
++$countBad;
return;