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