datefn

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # datefn
   5 # File ID: 4bec96e4-cc13-11de-a8a7-93dd800a3f5e
   6 #
   7 # Insert timestamp into file names
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2009– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17 use Getopt::Long;
  18 use File::Basename;
  19 use Time::Local;
  20
  21 local $| = 1;
  22
  23 my $std_exif_tag = "DateTimeOriginal";
  24
  25 our %Opt = (
  26
  27     'bwf' => 0,
  28     'delete' => 0,
  29     'dry-run' => 0,
  30     'exif' => 0,
  31     'exif-tag' => $std_exif_tag,
  32     'force' => 0,
  33     'git' => 0,
  34     'help' => 0,
  35     'local' => 0,
  36     'quiet' => 0,
  37     'replace' => 0,
  38     'skew' => 0,
  39     'verbose' => 0,
  40     'version' => 0,
  41
  42 );
  43
  44 our $progname = $0;
  45 $progname =~ s/^.*\/(.*?)$/$1/;
  46 our $VERSION = '0.3.0';
  47
  48 Getopt::Long::Configure('bundling');
  49 GetOptions(
  50
  51     'bwf' => \$Opt{'bwf'},
  52     'delete|d' => \$Opt{'delete'},
  53     'dry-run|n' => \$Opt{'dry-run'},
  54     'exif-tag|E=s' => \$Opt{'exif-tag'},
  55     'exif|e' => \$Opt{'exif'},
  56     'force|f' => \$Opt{'force'},
  57     'git|g' => \$Opt{'git'},
  58     'help|h' => \$Opt{'help'},
  59     'local|l' => \$Opt{'local'},
  60     'quiet|q+' => \$Opt{'quiet'},
  61     'replace|r' => \$Opt{'replace'},
  62     'skew|s=i' => \$Opt{'skew'},
  63     'verbose|v+' => \$Opt{'verbose'},
  64     'version' => \$Opt{'version'},
  65
  66 ) || die("$progname: Option error. Use -h for help.\n");
  67
  68 $Opt{'verbose'} -= $Opt{'quiet'};
  69 if ($Opt{'delete'} && $Opt{'replace'}) {
  70     warn("$progname: Cannot mix -d/--delete and -r/--replace options\n");
  71     exit(1);
  72 }
  73 $Opt{'help'} && usage(0);
  74 if ($Opt{'version'}) {
  75     print_version();
  76     exit(0);
  77 }
  78
  79 my $d = '[\dX]'; # Legal regexp digits, 0-9 or X (unknown)
  80 my $r_date = "[12]$d$d$d" . # year
  81             "$d$d" .        # month
  82             "$d$d" .        # day
  83             "T" .
  84             "$d$d" .        # hours
  85             "$d$d" .        # minutes
  86             "$d$d" .        # seconds
  87             "Z";
  88
  89 exit(main());
  90
  91 sub main {
  92     # {{{
  93     my $Retval = 0;
  94
  95     defined($ARGV[0]) ||
  96         die("$progname: Missing filenames. Use -h for help.\n");
  97
  98     if ($Opt{'exif'}) {
  99         my $exiftool_version = `exiftool -ver 2>/dev/null`;
 100         if (!defined($exiftool_version) || $exiftool_version !~ /^\d+\.\d+/) {
 101             printf(STDERR "$progname: exiftool(1) not found, " .
 102                           "required by -e/--exif\n");
 103             return 1;
 104         }
 105     }
 106
 107     for my $Curr (@ARGV) {
 108         msg(2, "Curr = '$Curr'");
 109         process_file($Curr);
 110     }
 111
 112     return $Retval;
 113     # }}}
 114 } # main()
 115
 116 sub process_file {
 117     # {{{
 118     my $File = shift;
 119     unless (-f $File) {
 120         warn("$progname: $File: Not a regular file\n");
 121         return;
 122     }
 123     if (!$Opt{'delete'} && !$Opt{'replace'} && numdates($File) > 0) {
 124         warn("$progname: $File: Filename already has date\n");
 125         return;
 126     }
 127     msg(3, sprintf("mod_date(%s) = '%s'", $File, mod_date($File)));
 128     my $new_name = '';
 129     my $mod_date = $Opt{'exif'} ? exif_date($File) : mod_date($File);
 130     my $start_date = start_date($File);
 131     return if (!$mod_date);
 132     $mod_date += $Opt{'skew'};
 133     $start_date += $Opt{'skew'} if ($start_date);
 134     my $dates = sprintf("%s%s%s",
 135         $start_date ? sec_to_string($start_date) : "",
 136         $start_date ? "-" : "",
 137         sec_to_string($mod_date),
 138     );
 139     if (length($dates)) {
 140         my ($basename, $dirname) = fileparse($File);
 141         my $new_name = $basename;
 142         if ($Opt{'replace'}) {
 143             $new_name = strip_date_from_filename($new_name);
 144         }
 145         if ($Opt{'delete'}) {
 146             $new_name = strip_date_from_filename($new_name);
 147         } else {
 148             $new_name = "$dates.$new_name";
 149         }
 150         $dirname eq "./" && ($dirname = '');
 151         $new_name = "$dirname$new_name";
 152         if ($new_name eq "$File") {
 153             msg(1, "Filename for $File is unchanged");
 154             return;
 155         }
 156         if ($Opt{'dry-run'}) {
 157             print("$progname: '$File' would be renamed to '$new_name'\n");
 158         } else {
 159             if (-e $new_name && !$Opt{'force'}) {
 160                 warn("$progname: $new_name: File already exists, " .
 161                     "use --force to overwrite\n");
 162             } elsif (rename_file($File, $new_name)) {
 163                 print("$progname: '$File' renamed to '$new_name'\n");
 164             } else {
 165                 warn("$progname: $File: Cannot rename file to '$new_name': " .
 166                     "$!\n");
 167             }
 168         }
 169     }
 170     # }}}
 171 } # process_file()
 172
 173 sub rename_file {
 174     # {{{
 175     my ($oldname, $newname) = @_;
 176     my $retval;
 177
 178     if ($Opt{'git'}) {
 179         $retval = mysystem('git', 'mv', $oldname, $newname);
 180         $retval = !$retval;
 181     } else {
 182         $retval = rename($oldname, $newname);
 183     }
 184
 185     return($retval);
 186     # }}}
 187 } # rename_file()
 188
 189 sub mysystem {
 190     # {{{
 191     my @cmd = @_;
 192     my $retval;
 193
 194     msg(0, "Executing \"" . join(' ', @cmd) . "\"...");
 195     $retval = system(@cmd);
 196
 197     return($retval);
 198     # }}}
 199 } # mysystem()
 200
 201 sub mod_date {
 202     # Return file modification timestamp {{{
 203     my $File = shift;
 204     my $Retval = 0;
 205     my @stat_array = stat($File);
 206     if (scalar(@stat_array)) {
 207         $Retval = $stat_array[9];
 208         if ($Opt{'local'}) {
 209             my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
 210             = gmtime($Retval);
 211             $Retval = timelocal($sec, $min, $hour, $mday, $mon, $year);
 212         }
 213     } else {
 214         warn("$progname: $File: Cannot stat file: $!\n");
 215     }
 216     return($Retval);
 217     # }}}
 218 } # mod_date()
 219
 220 sub numdates {
 221     # {{{
 222     my $str = shift;
 223     my $retval;
 224
 225     if ($str =~ /^$r_date-$r_date/) {
 226         $retval = 2;
 227     } elsif ($str =~ /^$r_date/) {
 228         $retval = 1;
 229     } else {
 230         $retval = 0;
 231     }
 232     msg(3, "numdates('$str') returns '$retval'");
 233     return($retval);
 234     # }}}
 235 } # numdates()
 236
 237 sub strip_date_from_filename {
 238     # {{{
 239     my $file = shift;
 240     my $retval = $file;
 241     $retval =~ s/^20......T......*?Z\.(.*$)/$1/;
 242     msg(3, "strip_date_from_filename('$file') returns '$retval'");
 243     return($retval);
 244     # }}}
 245 } # strip_date_from_filename()
 246
 247 sub start_date {
 248     # Find start of recording {{{
 249     my $File = shift;
 250     my $Retval = 0;
 251     if ($Opt{'bwf'}) {
 252         my $bwf_date = bwf_date($File);
 253         if ($bwf_date) {
 254             $Retval = $bwf_date;
 255         }
 256     }
 257     msg(2, "start_date($File) returns '$Retval'");
 258     return($Retval);
 259     # }}}
 260 } # start_date()
 261
 262 sub bwf_date {
 263     # Find start of recording in Broadcast Wave Format files {{{
 264     # This is based on examining .wav files from the Zoom H4n, and it
 265     # seems to work there. The file format may vary on other devices.
 266     my $File = shift;
 267     my $Retval = 0;
 268     unless (open(InFP, "<", $File)) {
 269         warn("$progname: $File: Cannot open file to look for BWF data: $!\n");
 270         return 0;
 271     }
 272     my $buf;
 273     my $numread = read(InFP, $buf, 358);
 274     if ($numread != 358) {
 275         warn("$progname: $File: Could not read 358 bytes, but continuing: " .
 276             "$!\n");
 277     }
 278     if ($buf =~ /^.*(\d\d\d\d)-(\d\d)-(\d\d)(\d\d):(\d\d):(\d\d)$/s) {
 279         $Retval = $Opt{'local'} ? timelocal($6, $5, $4, $3, $2-1, $1)
 280                                 : timegm($6, $5, $4, $3, $2-1, $1);
 281     }
 282     close(InFP);
 283     msg(2, "bwf_date($File) returns '$Retval'");
 284     return($Retval);
 285     # }}}
 286 } # bwf_date()
 287
 288 sub exif_date {
 289     # {{{
 290     my $File = shift;
 291     my $retval = "";
 292
 293     $retval = get_exif_data($File, $Opt{'exif-tag'});
 294     msg(2, "exif_date(): \$retval before check = \"$retval\"");
 295     if ($retval =~ /^(\d\d\d\d).(\d\d).(\d\d).(\d\d).(\d\d).(\d\d)$/)  {
 296         $retval = $Opt{'local'} ? timelocal($6, $5, $4, $3, $2-1, $1)
 297                                 : timegm($6, $5, $4, $3, $2-1, $1);
 298     } else {
 299         $retval = 0;
 300     }
 301     if (!$retval) {
 302         msg(1, "$File: No EXIF data found in file");
 303     }
 304     msg(2, "exif_date() returns \"$retval\"");
 305     return $retval;
 306     # }}}
 307 }
 308
 309 sub get_exif_data {
 310     # {{{
 311     my ($file, $tag) = @_;
 312     my $retval = "";
 313     my $line;
 314
 315     if (!open(FromFP, "exiftool -j \"$file\" |")) {
 316         printf(STDERR "$progname: $file: Cannot open file for read\n");
 317         return 1;
 318     }
 319     while ($line = <FromFP>) {
 320         if ($line =~ /"$tag"/) {
 321             msg(2, "get_exif_data() found \"$line\"");
 322             $line =~ s/^.*?"$tag"\s*:\s*"(.*?)".*/$1/s;
 323             msg(2, "\$line after regexp: \"$line\"");
 324             return $line;
 325         }
 326     }
 327
 328     return "";
 329     # }}}
 330 }
 331
 332 sub sec_to_string {
 333     # Convert seconds since 1970 to "yyyymmddThhmmss[.frac]Z" {{{
 334     my ($Seconds, $Sep) = @_;
 335     length($Seconds) || return('');
 336     ($Seconds =~ /^-?(\d*)(\.\d+)?$/) || return(undef);
 337     my $Secfrac = ($Seconds =~ /^([\-\d]*)(\.\d+)$/) ? 1.0*$2 : "";
 338     $Secfrac =~ s/^0//;
 339
 340     defined($Sep) || ($Sep = " ");
 341     my @TA = gmtime($Seconds);
 342     my($DateString) = sprintf("%04u%02u%02uT%02u%02u%02u%sZ",
 343                               $TA[5]+1900, $TA[4]+1, $TA[3],
 344                               $TA[2], $TA[1], $TA[0], $Secfrac);
 345     return($DateString);
 346     # }}}
 347 } # sec_to_string()
 348
 349 sub print_version {
 350     # Print program version {{{
 351     print("$progname $VERSION\n");
 352     return;
 353     # }}}
 354 } # print_version()
 355
 356 sub usage {
 357     # Send the help message to stdout {{{
 358     my $Retval = shift;
 359
 360     if ($Opt{'verbose'}) {
 361         print("\n");
 362         print_version();
 363     }
 364     print(<<"END");
 365
 366 Insert filemod timestamp into filename, and start of recording if
 367 available. At the moment only BWF (Broadcast Wave Format, standard .wav
 368 with extra metadata) is supported.
 369
 370 Format:
 371
 372   No timestamp for start of recording:
 373     yyyymmddThhmmssZ.OLDFILENAME
 374   With timestamp for start of recording:
 375     yyyymmddThhmmssZ-yyyymmddThhmmssZ.OLDFILENAME
 376
 377 Usage: $progname [options] file [files [...]]
 378
 379 Options:
 380
 381   --bwf
 382     Find start of recording in Broadcast Wave Format files. This is
 383     based on examining .wav files from the Zoom H4n, and it seems to
 384     work there. The file format may vary on other devices.
 385   -d, --delete
 386     Delete timestamp from filename. Can not be used with -r/--replace.
 387   -e, --exif
 388     Use timestamp from EXIF data in the file.
 389   -E TAG, --exif-tag TAG
 390     Use TAG when creating timestamp from the EXIF data.
 391     Default: "$std_exif_tag".
 392   -f, --force
 393     If a file with the new name already exists, allow the program to
 394     overwrite the file.
 395   -g, --git
 396     Use git commands when dealing with files. For example, execute the
 397     command "git mv oldname newname" when renaming files.
 398   -l, --local
 399     Timestamps are stored in local time, convert to UTC before renaming
 400     the files. If this option is not specified, timestamps in EXIF or
 401     modtime are expected to be in UTC.
 402   -n, --dry-run
 403     Don’t rename files, but report what would happen.
 404   -h, --help
 405     Show this help.
 406   -q, --quiet
 407     Be more quiet. Can be repeated to increase silence.
 408   -r, --replace
 409     Replace date in filename with new value. Can not be used with
 410     -d/--delete.
 411   -s X, --skew X
 412     Adjust clock skew by adding X seconds to the timestamp. A negative
 413     integer can also be specified.
 414   -v, --verbose
 415     Increase level of verbosity. Can be repeated.
 416   --version
 417     Print version information.
 418
 419 END
 420     exit($Retval);
 421     # }}}
 422 } # usage()
 423
 424 sub msg {
 425     # Print a status message to stderr based on verbosity level {{{
 426     my ($verbose_level, $Txt) = @_;
 427
 428     if ($Opt{'verbose'} >= $verbose_level) {
 429         print(STDERR "$progname: $Txt\n");
 430     }
 431     return;
 432     # }}}
 433 } # msg()
 434
 435 __END__
 436
 437 # This program is free software; you can redistribute it and/or modify
 438 # it under the terms of the GNU General Public License as published by
 439 # the Free Software Foundation; either version 2 of the License, or (at
 440 # your option) any later version.
 441 #
 442 # This program is distributed in the hope that it will be useful, but
 443 # WITHOUT ANY WARRANTY; without even the implied warranty of
 444 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 445 # See the GNU General Public License for more details.
 446 #
 447 # You should have received a copy of the GNU General Public License
 448 # along with this program.
 449 # If not, see L<http://www.gnu.org/licenses/>.
 450
 451 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :