#!/usr/bin/perl use strict; use warnings; use Image::ExifTool; use Getopt::Std; use Getopt::Long; use POSIX; use Time::Local; use File::Copy; use File::Basename; use Term::ReadLine; # # working storage # my %ParmDates; # hash of dates (used with -f or --parm-file option) my $mod_time = POSIX::strftime("%Y:%m:%d %H:%M:%S",localtime); my $version = "2.0"; # current version my @ifile; # array of image files my $rename_pfx; # prefix for rename skeleton (-r opt) my $rename_seq; # seq for rename skeleton (-r opt) my $rename_max; # end seq for rename skeleton (-r opt) my $rename_fmt; # format string for rename (-r opt) my $rename_prv; # last rename string my $commit_flag = 0; # changes committed to file list? my $term; # handle for Term::Readline # hash of displayed EXIF tags my %extr_tag = ( DateTimeOriginal => 1, CreateDate => 2, ModifyDate => 3, FileModifyDate => 4 ); # declare the options my ($opt_a, $opt_b, $opt_c, $opt_C, $opt_d, $opt_h, $opt_i, $opt_I, $opt_f, $opt_l, $opt_m, $opt_O, $opt_p, $opt_r, $opt_R, $opt_t, $opt_T, $opt_u, $opt_v, $opt_V); # Because long options were an after-thought, we still use the short option # naming convention # Defaults: $opt_p = 1; # always preserve modification dates (use --nopreserve to clear) # getopt ('acdfluT'); # get the long options Getopt::Long::Configure ("bundling"); GetOptions( 'a=s' => \$opt_a, 'adjt-amt=s' => \$opt_a, 'b=s' => \$opt_b, 'backup=s' => \$opt_b, 'd=s' => \$opt_d, 'adjt-direction=s' => \$opt_d, 'c=s' => \$opt_c, 'digitised-date=s' => \$opt_c, 'C' => \$opt_C, 'calculator-mode' => \$opt_C, 'h' => \$opt_h, 'help' => \$opt_h, 'i' => \$opt_i, 'info' => \$opt_i, 'I' => \$opt_I, 'interactive' => \$opt_I, 'f=s' => \$opt_f, 'parm-file=s' => \$opt_f, 'l=s' => \$opt_l, 'lwr-bound=s' => \$opt_l, 'u=s' => \$opt_u, 'upr-bound=s' => \$opt_u, 'm' => \$opt_m, 'mod-time' => \$opt_m, 'O' => \$opt_O, 'overwrite' => \$opt_O, 'p' => \$opt_p, 'preserve!' => \$opt_p, 'r=s' => \$opt_r, 'rename=s' => \$opt_r, 'R' => \$opt_R, 'reverse' => \$opt_R, 't' => \$opt_t, 'test' => \$opt_t, 'T=s' => \$opt_T, 'done=s' => \$opt_T, 'v' => \$opt_v, 'verbose' => \$opt_v, 'V' => \$opt_V, 'version' => \$opt_V ); # ------------------------------------------------------------------------ sub usage { printf STDOUT "Error: %s\n",$_[0] if ($_[0]); printf STDOUT "\nusage: $0 options _filespec_\n options: --adjt-amt=\"y:mm:dd HH:MM:SS\" -a \"y:mm:dd HH:MM:SS\" Specify the adjustment amount. This may also be specified as \"d HH:MM:SS\" or \"HH:MM:SS\". Can also use '_' instead of a space e.g. y:mm:dd_HH:MM:SS (does not require quotes). If the environment variable ADJT_ADJUSTMENT is set it will be used. --adjt-direction di_str -d di_str Where di_str must be either \"-1\" or \"+1\". The -d option must be specified with the -a option. If the environment variable ADJT_DIRECTION is set it will be used. --help -h Print this screen. --info -i Print date information for the files that match the filespec Tags: %s Other options will be ignored if the -i option is used. --interactive -I Enter an interactive screen. Each file specified on the command line, will be listed along with the existing date tags. You will then be prompted for the Original date. This mode uses the perl interface to the readline library. --parm-file=pfile -f pfile Where pfile contains a list of filenames and timestamps --lwr-bound=lfile -l lfile Where lfile is the lower bound of an alpha file list. --upr-bound=ufile -u ufile Where ufile is the upper bound of an alpha file list. --mod-time -m Use the file modification date for the Original Date. Note: This will alter the file modification date. --reverse -R Reverse the argument list. This option is for use with the interactive mode. --digitised-date=timestamp -c timestamp Use the specified timestamp (\"yyyy:mm:dd HH:MM:SS\") for the digitised date (EXIF CreateDate). -C \"yyyy:mm:dd HH:MM:SS\" \"yyyy:mm:dd HH:MM:SS\" Calculate the difference between the two dates --test -t Test, do not write changes. Just print to STDOUT. --backup=backup_folder -b backup_folder Move the original image to backup_folder If the environment variable ADJT_BACKUP is set it will be used. --done=target_folder -T target_folder Do not over-write original, copy to target_folder If the environment variable ADJT_TARGET is set it will be used. --overwrite -O Overwrite target if it is exists (implies -T).\n\n", join(' ',sort {$extr_tag{$a} <=> $extr_tag{$b} } (keys %extr_tag) ); exit 1; } # ------------------------------------------------------------------------ # # check that the date is valid # sub validate { use Time::Local 'timelocal_nocheck'; my $date_str = $_[0]; # reformat it (be kind) $date_str =~ s/\s+$//; $date_str =~ s/^\s+//; $date_str =~ s/-/:/g; $date_str =~ s#/#:#g; return "" unless ($date_str =~ /^(\d+):(\d+):(\d+) (\d+):(\d+):(\d+)$/); my @date = ($6,$5,$4,$3,$2,$1); $date_str = sprintf "%d:%02d:%02d %02d:%02d:%02d", reverse @date; $date[4]--; my $t = timelocal_nocheck(@date); return "" unless ($date_str eq POSIX::strftime("%Y:%m:%d %H:%M:%S", localtime($t))); # return the formatted string return $date_str; } # ------------------------------------------------------------------------ sub validate_amt { my $a = $_[0]; $a =~ s/\s+$//; $a =~ s/^\s+//; $a =~ s/_/ /g; $a =~ s/s$//; return (sprintf ("%d 00:00:00",$1) ) if ($a =~ /(\d+)\s+day*$/); return (sprintf ("%d:00:00 00:00:00",$1) ) if ($a =~ /(\d+)\s+year$/); if ($a =~ /^(\d+):(\d+):(\d+)$/) { my ($h,$m,$s) = ($1,$2,$3); return "" if ($m > 60 || $s > 60); return (sprintf ("%02d:%02d:%02d",$h,$m,$s) ) if ($h < 24); return (sprintf ("%d %02d:%02d:%02d",$h/24,$h%24,$m,$s) ) } if ($a =~ /^(\d+)\s+(\d+):(\d+):(\d+)$/) { my ($d,$h,$m,$s) = ($1,$2,$3,$4); return "" if ($h > 24 || $m > 60 || $s > 60); return (sprintf ("%d %02d:%02d:%02d",$d,$h,$m,$s) ) } return ""; } # ------------------------------------------------------------------------ # # Convert an EXIF style date (yyyy:mm:dd hh:mi:ss) to Unix -- fatal if invalid # sub exif2unix { my $date_str = $_[0]; die "Bad date: $date_str" unless ($date_str =~ /^(\d+):(\d+):(\d+) (\d+):(\d+):(\d+)$/); my @date = ($6,$5,$4,$3,$2 - 1,$1); my $timestamp = timelocal(@date); return $timestamp; } # ------------------------------------------------------------------------ =head2 add_date_offset( date_str, ofs_str, direction) add an offset to a date yyyy:mm:dd hh:mi:ss in direction +1 or -1 return the result as an exif date. =cut sub add_date_offset { my ($date_str, $ofs_str, $di) = @_; use Time::Local 'timelocal_nocheck'; die "Bad adjustment direction: $di" unless ($di == 1 || $di == -1); if ( $ofs_str =~ (/^\d+$/) ) { return ( POSIX::strftime("%Y:%m:%d %H:%M:%S", localtime(exif2unix($date_str) + ($ofs_str * $di) ) ) ); } elsif ( $ofs_str =~ (/^(\d+):(\d+)$/) ) { return ( POSIX::strftime("%Y:%m:%d %H:%M:%S", localtime(exif2unix($date_str) + (($1 * 60) + $2) * $di) ) ); } elsif ( $ofs_str =~ (/^(\d+):(\d+):(\d+)$/) ) { return ( POSIX::strftime("%Y:%m:%d %H:%M:%S", localtime(exif2unix($date_str) + (($1 * 3600) + ($2 * 60) + $3) * $di) ) ); } elsif ( $ofs_str =~ (/^(\d+) (\d+):(\d+):(\d+)$/) ) { return ( POSIX::strftime("%Y:%m:%d %H:%M:%S", localtime(exif2unix($date_str) + (($1 * 86400) + ($2 * 3600) + ($3 * 60) + $4) * $di) ) ); } elsif ( $ofs_str =~ (/^(\d+):00:00 00:00:00$/) ) { my $y = $1; my @date = localtime(exif2unix($date_str)); return ( POSIX::strftime("%Y:%m:%d %H:%M:%S", localtime( timelocal_nocheck(@date[0 .. 4], $date[5] + ($y * $di) ) ) ) ); } else { die "Bad adjustment offset: $ofs_str"; } } # ------------------------------------------------------------------------ sub calc_diff { my ($d1,$d2) = @_; # save for error message my ($s1,$s2) = ($d1,$d2); # sanity check the date return cmd_err( "Bad date: '$s1'") unless ($d1 = validate($d1)); return cmd_err( "Bad date: '$s2'") unless ($d2 = validate($d2)); my $direction = "+1"; my $diff = exif2unix($d2) - exif2unix($d1); if ($diff < 0 ) { $diff *= -1; $direction = "-1"; } my $d = int($diff/86400); my $h = int ( ($diff - ($d * 86400) ) / 3600 ); my $m = int ( ($diff - ($d * 86400) - ($h * 3600) ) / 60); my $s = $diff - ($d * 86400) - ($h * 3600) - ($m * 60); # print the commands that would set the environment variables return ( sprintf ("%d %02d:%02d:%02d",$d,$h,$m,$s), $direction); } # ------------------------------------------------------------------------ sub chk_rename { # rename skeleton my $spec = $_[0]; return () unless ($spec =~ /(\d+)$/); my ($pfx,$seq) = ($`,$1); my $len = length($seq); my $max = 9 x $len; return () unless ($max > 9); # create a format string for renaming the files my $fmt = '%s%0' . $len . 'd.jpg'; return ($pfx, $seq, $max, $fmt); } # ------------------------------------------------------------------------ # # pre-process and sanity check command line options # sub preprocess_opts { if ($opt_V) { print "Version: $version\n"; exit; } usage() if ($opt_h); # use the environment variables, if these aren't set already $opt_a = $ENV{ADJT_ADJUSTMENT} if (!$opt_a && $ENV{ADJT_ADJUSTMENT}); $opt_d = $ENV{ADJT_DIRECTION} if (!$opt_d && $ENV{ADJT_DIRECTION}); $opt_T = $ENV{ADJT_TARGET} if (!$opt_T && $ENV{ADJT_TARGET}); $opt_b = $ENV{ADJT_BACKUP} if (!$opt_b && $ENV{ADJT_BACKUP}); if ($opt_C) { die("-C should be specified with only two arguments\n") unless (@ARGV == 2); my ($adj,$direction) = calc_diff(@ARGV); exit 1 unless ($adj && $direction); printf "export ADJT_ADJUSTMENT=\"%s\"\n",$adj; printf "export ADJT_DIRECTION=\"%s\"\n",$direction; exit; } elsif ($opt_f) { die("Do not expect arguments with parm file\n") if (@ARGV); die("No such file: $opt_f\n") unless (-f $opt_f); open PARM,$opt_f || die("Cannot open $opt_f"); while (<PARM>) { my @dates; my ($file,$str) = split( "\t",$_); next unless ($file && $str); die "Bad or missing file: $file\n" unless (-s $file); $str =~ s/\s+$//; while ( $str =~ /^(\d{4}:\d{2}:\d{2} \d{2}:\d{2}:\d{2})/) { push (@dates,$1); $str = $'; $str =~ s/^\s+//; } die "Malformed parm file." if ($str); die "Insufficient number of dates in parm file line" unless (@dates > 0); $ParmDates{$file} = \@dates; push @ARGV,$file; } } elsif ($opt_I) { $opt_v = ""; } elsif ($opt_i) { # ignore other options if -i is specified $opt_T = $opt_b = $opt_m = $opt_c = $opt_a = $opt_d = ""; # print a heading if the -v option is specified if ($opt_v) { printf "FILENAME\t%-19.19s %-19.19s %-19.19s %-19.19s\n", sort {$extr_tag{$a} <=> $extr_tag{$b} } (keys %extr_tag); printf "--------\t%s %s %s %s\n", "-" x 19, "-" x 19, "-" x 19, "-" x 19; } } elsif ($opt_m) { # use file modification time die("-m cannot be specified with -c\n") if ($opt_c); die("-m cannot be specified with -a or -d\n") if ($opt_a || $opt_d); } elsif ($opt_c) { # constant specified on command line die("-c cannot be specified with -a or -d\n") if ($opt_a || $opt_d); my $t = validate($opt_c); die ("'$opt_c' is not a valid date\n") unless ($t); $opt_c = $t; } else { die("-d must be '-1' or '+1'\n") if ($opt_d && $opt_d ne "-1" && $opt_d ne "+1"); # allow alternative specifications of "days" and "years" if ( $opt_a) { my $amt = validate_amt($opt_a); die "Invalid adjustment string '$amt'\n" unless ($amt); $opt_a = $amt; } } if ($opt_r) { # rename skeleton my @r = chk_rename($opt_r); die "Bad rename skeleton: $opt_r\n" unless (@r == 4); ($rename_pfx, $rename_seq, $rename_max, $rename_fmt) = @r; } if ( $opt_b) { die("$opt_b is not a valid folder") unless (-d $opt_b); } if ( $opt_T) { die("$opt_T is not a valid folder") unless (-d $opt_T); } if ( $opt_O) { die("-o should only be used with -T") unless ($opt_T); } } # ------------------------------------------------------------------------ # # process timestamps of a given file using the specified options # or use arguments (if they are passed with the filename) # sub process_file { my ($file,@date) = @_; my $exifTool = new Image::ExifTool; my %DateInfo; foreach (keys %extr_tag) {$DateInfo{$_} = ""} $exifTool->Options(Unknown => 1); my $info = $exifTool->ImageInfo($file); my $group = ''; # my $tag; my $atime; my $mtime; my $newname = $file; foreach my $tag (keys %extr_tag) { $DateInfo{$tag} = $info->{$tag} if ($info->{$tag}); } # print info if -i or -I and no arguments if ( $opt_i || $opt_I && !@date) { printf STDOUT $file . "\t"; foreach (sort {$extr_tag{$a} <=> $extr_tag{$b}} (keys %extr_tag)) {printf STDOUT "%-20.20s",$DateInfo{$_}} print STDOUT "\n"; return; } # construct the new name if we are renaming the file if ($opt_r) { my $dirname = dirname($file); $newname = sprintf $rename_fmt,$rename_pfx,$rename_seq++; $newname = "$dirname/$newname" unless ($dirname eq '.'); # save it for STDOUT (if in interactive mode) $rename_prv = $newname; } # use arguments if passed (optional) if ( @date) { $exifTool->SetNewValue(Keywords => "DateTimeOriginal", AddValue => 1) unless (defined $info->{DateTimeOriginal}); $exifTool->SetNewValue(DateTimeOriginal => $date[0]); # write the digitised date if $opt_c is set $date[1] = $opt_c if ($opt_c && !$date[1]); if ($date[1]) { $exifTool->SetNewValue(Keywords => "CreateDate", AddValue => 1) unless (defined $info->{CreateDate}); $exifTool->SetNewValue(CreateDate => $date[1]); } if ($date[2]) { $exifTool->SetNewValue(Keywords => "ModifyDate", AddValue => 1) unless (defined $info->{ModifyDate}); $exifTool->SetNewValue(ModifyDate => $date[2]); } if ($date[3]) { $atime = $mtime = exif2unix($date[3]); } } elsif ( $opt_m) { # use the file modification time die "Cannot find FileModifyDate in $file" unless ($DateInfo{FileModifyDate}); $exifTool->SetNewValue(Keywords => "DateTimeOriginal", AddValue => 1) unless (defined $info->{DateTimeOriginal}); $exifTool->SetNewValue(DateTimeOriginal => $DateInfo{FileModifyDate}); $exifTool->SetNewValue(Keywords => "CreateDate", AddValue => 1) unless (defined $info->{CreateDate}); $exifTool->SetNewValue(CreateDate => $DateInfo{FileModifyDate}); } elsif ( $opt_c) { # if called with -c option only, update both original and digitised dates $exifTool->SetNewValue(Keywords => "DateTimeOriginal", AddValue => 1) unless (defined $info->{DateTimeOriginal}); $exifTool->SetNewValue(DateTimeOriginal => $opt_c); $exifTool->SetNewValue(Keywords => "CreateDate", AddValue => 1) unless (defined $info->{CreateDate}); $exifTool->SetNewValue(CreateDate => $opt_c); } else { # shift the original and digitised dates by the ADJUSTMENT amount die "No DateTimeOriginal tag in $file" unless (defined $info->{DateTimeOriginal}); $exifTool->SetNewValue(DateTimeOriginal => $opt_a,Shift => $opt_d); die "No CreateDate tag in $file" unless (defined $info->{CreateDate}); $exifTool->SetNewValue(CreateDate => $opt_a,Shift => $opt_d); } if ($opt_p) { ($atime,$mtime) = (stat($file))[8,9]; } else { # update the ModifyDate with the time this script began $exifTool->SetNewValue(ModifyDate => $mod_time) if (defined $info->{ModifyDate}); } if ( $opt_t || $opt_v) { my $file_details = $file; if ($opt_v) { $file_details .= " -> $opt_T/" if ($opt_t); $file_details .= " BACKUP -> $opt_b/" if ($opt_b); } my $new_date = $exifTool->GetNewValues("DateTimeOriginal"); # shifted values show the shift (not the original) -- make them more readable if ( $new_date =~ /^([\+\-])/) { my ($di,$d) = ($1, $'); $di .= "1"; # do the shift arithmetic for display (use add_date_offset()) printf "%s %s\n", ($file_details,add_date_offset($info->{DateTimeOriginal},$d,$di)); } else { printf "%s %s\n", $file_details,$new_date; } # test mode? -- don't write the changes return if ($opt_t); } if ( $opt_T) { # check the over-write flag, write the file to a target folder. unlink "$opt_T/$newname" if ( -e "$opt_T/$newname" && $opt_O); die "Cannot write: $opt_T/$newname" unless $exifTool->WriteInfo($file, "$opt_T/$newname"); if ($opt_b) { move($file,"$opt_b/$file") || die "Cannot copy $file to $opt_b - $!"; } utime $atime, $mtime, "$opt_T/$newname" if ($mtime); } else { if ($opt_b) { copy($file,"$opt_b/$file") || die "Cannot move $file to $opt_b - $!"; } # over-write the original file unlink "$file.new" if (-e "$file.new"); die "Cannot write: $file.new\n" unless $exifTool->WriteInfo($file, "$file.new"); rename ("$file.new",$newname) || die "Cannot rename $file.new to $newname - $!"; utime $atime, $mtime, $newname if ($mtime); unlink $file if ($opt_r); } } # ------------------------------------------------------------------------ sub display_bool { my ($name) = $_[0]; my $val = "UNDEFINED"; $val = $opt_O if ( $name eq "overwrite"); $val = $opt_p if ( $name eq "preserve"); $val = $opt_R if ( $name eq "reverse"); $val = $opt_t if ( $name eq "test"); $val = ($val) ? "ON":"OFF" unless ($val && $val eq "UNDEFINED"); return sprintf "%-15.15s %s\n",$name, $val; } # ------------------------------------------------------------------------ sub set_bool { my ($ref,@arg) = @_; shift @arg if ($arg[0] eq "set"); if (@arg == 2) { $arg[1] = uc $arg[1]; if ($arg[1] eq "ON") { $$ref = 1; } elsif ($arg[1] eq "OFF") { $$ref = ""; } else { printf STDERR "Cannot set %s to %s\n",@arg; return; } } else { if ($$ref) { $$ref = ""; } else { $$ref = 1; } } } # ------------------------------------------------------------------------ sub cmd_err { my $msg = $_[0]; $msg =~ s/\s+$//; print STDERR "$msg\n"; return (); } # ------------------------------------------------------------------------ my %HelpSet = ( 'adjt-amt' => 'set adjt-amt amt_str where amt_str can be "y years", "d days", "d hh:mi:ss" or "hh:mi:ss" The environment variable ADJT_ADJUSTMENT will be used at startup unless the -a (--adjt-amt) option is specified on the command line.', 'lwr-bound' => 'set lwr-bound lfile where lfile is a file name. Any file tht occurs alphabetically before lfile will be culled from the argument list when the list is "committed". If lfile does not exist a warning message will be issued.', 'upr-bound' => 'set upr-bound lfile where lfile is a file name. Any file tht occurs alphabetically after ufile will be culled from the argument list when the list is "committed". If ufile does not exist a warning message will be issued.' ); my %Help = ( all => 'help: quit roll run set show', quit => 'terminate immediately, return to shell.', roll => 'In setup mode, the "roll" command will auto-commit changes to the filelist and commence the batch run. If already in batch interactive mode the "roll" command must be accompanied by a number. The specified number of frames will be processed as if a null string had been entered. In batch interactive mode the "roll" command can be abreviated to "r"', run => 'The "run" command can only be entered in interactive setup mode. This command will exit from interactive mode and process all files as if they had been entered on the command line as "command batch"', set => 'set parm value set the value of parm where parm is one of: adjt-amt [string] adjt-direction [+1|-1] backup [on|off] digitised-date [date] done [folder] lwr-bound [string] mod-time [on|off] overwrite [on|off] preserve [on|off] rename [on|off] reverse [on|off] test [on|off] upr-bound [string] verbose [on|off]', show => 'show [parm|all] show the value of a parm (see set) or "all" for all parms' ); sub help_cmd { my ($line) = @_; my @arg = split (' ', $line); $arg[1] = "all" unless ($arg[1]); return cmd_err("Do not grok: $arg[0]") unless ($arg[0] eq '?' || $arg[0] =~ /^help$/i); if ($Help{$arg[1]}) { if ($arg[1] eq "set" && @arg == 3 && $HelpSet{$arg[2]} ) { print STDOUT "\n$HelpSet{$arg[2]}\n"; } else { print STDOUT "\n$Help{$arg[1]}\n\n"; } } else { print STDOUT "\nNo help for $arg[1]\n"; } } # ------------------------------------------------------------------------ sub display_val { my ($name,$val) = @_; $val = '""' unless ($val); if ($name eq "files") { return( sprintf ("%-15.15s %s\n", "files", ($commit_flag) ? scalar @ifile . ", committed" : scalar @ARGV . ", not committed") ); } elsif ( $name eq "overwrite" || $name eq "preserve" || $name eq "reverse" || $name eq "test" ) { return display_bool($name); } return sprintf "%-15.15s %s\n",$name, $val; } # ------------------------------------------------------------------------ my $all_heading = "Option Value\n--------------- ---------------\n"; sub show_cmd { my ($line) = @_; my @arg = split (' ', $line); my $sval = $arg[1]; my $ret = ""; return "Do not grok: $_[0]\nEnter 'help' for a list of commands" if ($arg[0] ne "show"); return "" unless ($sval); if ($sval eq "filelist") { if ($commit_flag) { foreach (@ifile) {$ret .= "\t$_\n"} } else { foreach (@ARGV) {$ret .= "\t$_\n"} } return "$ret\n"; } $ret = $all_heading if ($sval eq "all"); foreach my $x( qw ( adjt-amt adjt-direction backup digitised-date done files overwrite preserve rename reverse test ) ) { next if ($sval ne "all" && $sval ne $x); $ret .= display_val($x,$opt_a) if ($x =~ /adjt-amt/); $ret .= display_val($x,$opt_d) if ($x =~ /adjt-direction/); $ret .= display_val($x,$opt_b) if ($x =~ /backup/); $ret .= display_val($x,$opt_c) if ($x =~ /digitised-date/); $ret .= display_val($x,$opt_T) if ($x =~ /done/); $ret .= display_val($x,$x) if ($x =~ /files/); $ret .= display_val($x,$x) if ($x =~ /overwrite/); $ret .= display_val($x,$x) if ($x =~ /preserve/); $ret .= display_val($x,$opt_r) if ($x =~ /rename/); $ret .= display_val($x,$x) if ($x =~ /reverse/); $ret .= display_val($x,$x) if ($x =~ /test/); } $ret = "\n$ret" unless ($sval eq "all"); return "$ret\n"; } # ------------------------------------------------------------------------ # # process a "set" command # sub set_cmd { my ($line) = @_; my @arg = split (' ', $line); return cmd_err("Do not grok: $_[0] -- Enter 'help' for a list of commands") if ($arg[0] ne "set"); $arg[2] =~ s/\"//g if ($arg[3]); if ( @arg == 1) { show_cmd("all"); } elsif ($arg[1] eq "adjt-amt") { return cmd_err('adjt-amt must be an amt string or empty string ("")') if (@arg < 3); if ($arg[2]) { my $amt = join( ' ',splice(@arg,2) ); my $valid_amt = validate_amt($amt); return cmd_err("Invalid amt str: '$amt'") unless ($valid_amt); $opt_a = $valid_amt; } else { $opt_a = ""; } # set_cmd("set adjt-direction +1") unless ($opt_d); } elsif ($arg[1] eq "adjt-direction") { return cmd_err('adjt-direction must be an direction string or empty string ("")') if (@arg != 3); if ($arg[2]) { return cmd_err("Direction can only be +1 or -1") if ($arg[2] ne '+1' && $arg[2] ne '-1'); } $opt_d = $arg[2]; } elsif ($arg[1] eq "backup") { return cmd_err('backup must be a folder or empty string ("")') if (@arg != 3); if ($arg[2]) { return cmd_err("$arg[2] is not a folder") unless (-d $arg[1]); } $opt_b = $arg[2]; } elsif ($arg[1] eq "rename") { # rename skeleton return cmd_err('must be a valid rename template or an empty string ("")') if (@arg != 3); if ($arg[2]) { my @r = chk_rename($arg[2]); die "Bad rename skeleton: $opt_r\n" unless (@r == 4); ($rename_pfx, $rename_seq, $rename_max, $rename_fmt) = @r; } $opt_r = $arg[2]; } elsif ($arg[1] eq "digitised-date") { return cmd_err('digitised-date must be a date or empty string ("")') if (@arg < 3); my $date; if ($arg[2]) { return cmd_err("invalid date: $arg[2]") unless ($date = validate( (@arg > 3) ? join (' ',@arg[2 .. $#arg]) : $arg[2])); } else { $opt_c = ""; } $opt_c = $date; } elsif ($arg[1] eq "done") { return cmd_err('done must be a folder or empty string ("")') if (@arg != 3); if ($arg[2]) { return cmd_err("$arg[2] is not a folder") unless (-d $arg[2]); } $opt_T = $arg[2]; } elsif ($arg[1] eq "lwr-bound") { $opt_l = $arg[2]; print STDOUT "\n WARNING: file $arg[2] does not exist\n" unless (-e $arg[2]); $opt_l = $arg[2]; } elsif ($arg[1] eq "upr-bound") { $opt_u = $arg[2]; print STDOUT "\n WARNING: file $arg[2] does not exist\n" unless (-e $arg[2]); $opt_u = $arg[2]; } elsif ($arg[1] eq "overwrite") { set_bool (\$opt_O,@arg) } elsif ($arg[1] eq "preserve") { set_bool (\$opt_p,@arg) } elsif ($arg[1] eq "reverse") { set_bool (\$opt_R,@arg) } elsif ($arg[1] eq "test") { set_bool (\$opt_t,@arg) } else { return cmd_err("\nCannot set $arg[1]\n"); } print STDOUT show_cmd("show $arg[1]"); } # ------------------------------------------------------------------------ # # process batch interactively # sub interactive_batch { my $roll_flag = 0; my $prompt; my $prev_date = ""; $opt_a = "00:01:00" unless ($opt_a); $opt_d = "+1" unless ($opt_d); while (@ifile) { my $file = shift @ifile; $prompt = "$file: "; if ( $roll_flag > 0 ) { $prev_date = add_date_offset ($prev_date, $opt_a, $opt_d) if ($prev_date); if ($prev_date) { $roll_flag--; $term->addhistory($prev_date); process_file($file,$prev_date); print STDOUT "$file ** $prev_date"; print STDOUT " $opt_c" if ($opt_c); print STDOUT " => $rename_prv" if ($opt_r); print STDOUT "\n"; next; } else { print STDERR "INTERNAL ERROR - No previous date - roll_flag reset!\n"; $roll_flag = 0; } } # print the existing information, call process_file without dates process_file($file); while (1) { # collect the new date from the command line if ( defined ($_ = $term->readline($prompt))) { my $date; s/\s+$//; s/^\s+//; # interpret commands last if (/^skip\s/); if (/^help$/) { } elsif (/^r\s*(\d+)/ || /^roll\s+(\d+)/) { $roll_flag = $1 - 1; if ($prev_date) { $date = $prev_date; $_ = ""; } else { print STDERR "Cannot roll until a date is entered\n"; $roll_flag = 0; next; } } elsif (/^quit$/) { exit; } if ($_) { $date = validate($_); unless ($date) { print STDERR "Invalid Date: $_\n"; next; } } else { next unless ($prev_date); $date = $prev_date; } $date = add_date_offset ($date, $opt_a, $opt_d) if ($date eq $prev_date); # print STDOUT "$file: $date\n"; $term->addhistory($date); process_file($file,$date); $prev_date = $date; print STDOUT "$file ** $date"; print STDOUT " $opt_c" if ($opt_c); print STDOUT " => $rename_prv" if ($opt_r); print STDOUT "\n"; last; } } } } # ------------------------------------------------------------------------ sub commit { if ($commit_flag) { print "\nFile list is already committed\n"; return (0); } foreach my $file(sort @ARGV) { next if ($opt_l && $opt_l gt $file); next if ($opt_u && $opt_u lt $file); next unless (-e $file); push @ifile, $file; } @ifile = reverse @ifile if ($opt_R); # don't need these anymore undef @ARGV; $commit_flag = 1; if ($opt_r && @ifile > ($rename_max - $rename_seq) ) { die sprintf "$opt_r contains room for %d entries - cannot process %d files\n", scalar @ifile, $rename_max - $rename_seq } return (1); } # ------------------------------------------------------------------------ sub interactive_preprocess() { print "\nADJT Starting in Interactive mode\nEnter 'help or ?' for help.\n"; $term = new Term::ReadLine 'Adjt'; my $prompt = "adjt-> "; while (1) { if ( defined ($_ = $term->readline($prompt))) { s/\s+$//; s/^\s+//; if (/^set/) { # process "set" commands set_cmd($_); next; } elsif (/^show/) { # process "show" commands print show_cmd($_); next; } elsif (/^calc\s+(\S.*)/) { my @arg = split(' ',$1); my ($d1,$d2) = ("",""); $d1 .= shift(@arg) . " " while (length($d1) < 18 && @arg); $d2 .= shift(@arg) . " " while (length($d2) < 18 && @arg); my ($amt,$direction) = calc_diff($d1,$d2); unless ($amt && $direction) { print STDERR "\nFailed to calculate difference\n"; } else { set_cmd ("set adjt-amt $amt"); set_cmd ("set adjt-direction $direction"); } } elsif (/^commit$/) { print STDOUT "\nFile list committed.\n" if (commit()); } elsif (/^roll$/) { print STDOUT "\nEntering interactive batch mode ...\n"; last; } elsif (/^help/ || /^\?/) { help_cmd($_); } elsif (/^run$/) { $opt_I = ""; last; } elsif (/^quit$/) { exit; } else { print STDOUT "Do not grok: $_\n"; } } $term->addhistory($_); } } # ------------------------------------------------------------------------ # # main section # preprocess_opts(); interactive_preprocess() if ($opt_I); commit() unless ($commit_flag); usage() unless (@ifile); # Enter interactive mode if -I specified on command line if ($opt_I) { # make the first line pretty line up my $l = length($ifile[0]); # printf "FILENAME\t%-19.19s %-19.19s %-19.19s %-19.19s\n", printf "%-$l.${l}s\t%-19.19s %-19.19s %-19.19s %-19.19s\n", "FILENAME", sort {$extr_tag{$a} <=> $extr_tag{$b} } (keys %extr_tag); printf "%-$l.${l}s\t%s %s %s %s\n", "-" x 12, "-" x 19, "-" x 19, "-" x 19, "-" x 19; interactive_batch(); # finished interactive session -- exit immediately } else { # process each file using the rules supplied on the command line foreach my $file (@ifile) { next unless (-f $file); if ($opt_f) { process_file($file,@{$ParmDates{$file}}); } else { process_file($file); } } } exit 0;