datefn

#!/usr/bin/env perl

#=======================================================================
# datefn
# File ID: 4bec96e4-cc13-11de-a8a7-93dd800a3f5e
#
# Insert timestamp into file names
#
# Character set: UTF-8
# ©opyleft 2009– Øyvind A. Holm <sunny@sunbase.org>
# License: GNU General Public License version 2 or later, see end of 
# file for legal stuff.
#=======================================================================

use strict;
use warnings;
use Getopt::Long;
use File::Basename;
use Time::Local;

local $| = 1;

our %Opt = (

    'bwf' => 0,
    'delete' => 0,
    'dry-run' => 0,
    'force' => 0,
    'git' => 0,
    'help' => 0,
    'quiet' => 0,
    'replace' => 0,
    'skew' => 0,
    'verbose' => 0,
    'version' => 0,

);

our $progname = $0;
$progname =~ s/^.*\/(.*?)$/$1/;
our $VERSION = '0.1.1';

Getopt::Long::Configure('bundling');
GetOptions(

    'bwf' => \$Opt{'bwf'},
    'delete|d' => \$Opt{'delete'},
    'dry-run|n' => \$Opt{'dry-run'},
    'force|f' => \$Opt{'force'},
    'git|g' => \$Opt{'git'},
    'help|h' => \$Opt{'help'},
    'quiet|q+' => \$Opt{'quiet'},
    'replace|r' => \$Opt{'replace'},
    'skew|s=i' => \$Opt{'skew'},
    'verbose|v+' => \$Opt{'verbose'},
    'version' => \$Opt{'version'},

) || die("$progname: Option error. Use -h for help.\n");

$Opt{'verbose'} -= $Opt{'quiet'};
if ($Opt{'delete'} && $Opt{'replace'}) {
    warn("$progname: Cannot mix -d/--delete and -r/--replace options\n");
    exit(1);
}
$Opt{'help'} && usage(0);
if ($Opt{'version'}) {
    print_version();
    exit(0);
}

my $d = '[\dX]'; # Legal regexp digits, 0-9 or X (unknown)
my $r_date = "[12]$d$d$d" . # year
            "$d$d" .        # month
            "$d$d" .        # day
            "T" .
            "$d$d" .        # hours
            "$d$d" .        # minutes
            "$d$d" .        # seconds
            "Z";

exit(main());

sub main {
    # {{{
    my $Retval = 0;

    defined($ARGV[0]) ||
        die("$progname: Missing filenames. Use -h for help.\n");

    for my $Curr (@ARGV) {
        msg(2, "Curr = '$Curr'\n");
        process_file($Curr);
    }

    return $Retval;
    # }}}
} # main()

sub process_file {
    # {{{
    my $File = shift;
    unless (-f $File) {
        warn("$progname: $File: Not a regular file\n");
        return;
    }
    if (!$Opt{'delete'} && !$Opt{'replace'} && numdates($File) > 0) {
        warn("$progname: $File: Filename already has date\n");
        return;
    }
    msg(2, sprintf("mod_date(%s) = '%s'\n", $File, mod_date($File)));
    my $new_name = '';
    my $mod_date = mod_date($File);
    my $start_date = start_date($File);
    my $dates = sprintf("%s%s%s",
        sec_to_string($start_date),
        length($start_date) ? "-" : "",
        sec_to_string($mod_date),
    );
    if (length($dates)) {
        my ($basename, $dirname) = fileparse($File);
        my $new_name = $basename;
        if ($Opt{'replace'}) {
            $new_name = strip_date_from_filename($new_name);
        }
        if ($Opt{'delete'}) {
            $new_name = strip_date_from_filename($new_name);
        } else {
            $new_name = "$dates.$new_name";
        }
        $dirname eq "./" && ($dirname = '');
        $new_name = "$dirname$new_name";
        if ($new_name eq "$File") {
            msg(1, "Filename for $File is unchanged");
            return;
        }
        if ($Opt{'dry-run'}) {
            print("$progname: '$File' would be renamed to '$new_name'\n");
        } else {
            if (-e $new_name && !$Opt{'force'}) {
                warn("$progname: $new_name: File already exists, " .
                    "use --force to overwrite\n");
            } elsif (rename_file($File, $new_name)) {
                print("$progname: '$File' renamed to '$new_name'\n");
            } else {
                warn("$progname: $File: Cannot rename file to '$new_name': " .
                    "$!\n");
            }
        }
    }
    # }}}
} # process_file()

sub rename_file {
    # {{{
    my ($oldname, $newname) = @_;
    my $retval;

    if ($Opt{'git'}) {
        $retval = mysystem('git', 'mv', $oldname, $newname);
        $retval = !$retval;
    } else {
        $retval = rename($oldname, $newname);
    }

    return($retval);
    # }}}
} # rename_file()

sub mysystem {
    # {{{
    my @cmd = @_;
    my $retval;

    msg(0, "Executing \"" . join(' ', @cmd) . "\"...");
    $retval = system(@cmd);

    return($retval);
    # }}}
} # mysystem()

sub mod_date {
    # Return file modification timestamp {{{
    my $File = shift;
    my $Retval = "";
    my @stat_array = stat($File);
    if (scalar(@stat_array)) {
        $Retval = $stat_array[9] + $Opt{'skew'};
    } else {
        warn("$progname: $File: Cannot stat file: $!\n");
    }
    return($Retval);
    # }}}
} # mod_date()

sub numdates {
    # {{{
    my $str = shift;
    my $retval;

    if ($str =~ /^$r_date-$r_date/) {
        $retval = 2;
    } elsif ($str =~ /^$r_date/) {
        $retval = 1;
    } else {
        $retval = 0;
    }
    msg(3, "numdates('$str') returns '$retval'");
    return($retval);
    # }}}
} # numdates()

sub strip_date_from_filename {
    # {{{
    my $file = shift;
    my $retval = $file;
    $retval =~ s/^20......T......*?Z\.(.*$)/$1/;
    msg(3, "strip_date_from_filename('$file') returns '$retval'");
    return($retval);
    # }}}
} # strip_date_from_filename()

sub start_date {
    # Find start of recording {{{
    my $File = shift;
    my $Retval = "";
    if ($Opt{'bwf'}) {
        my $bwf_date = bwf_date($File);
        if (length($bwf_date)) {
            $Retval = $bwf_date;
        }
    }
    msg(2, "start_date($File) returns '$Retval'");
    return($Retval);
    # }}}
} # start_date()

sub bwf_date {
    # Find start of recording in Broadcast Wave Format files {{{
    # This is based on examining .wav files from the Zoom H4n, and it 
    # seems to work there. The file format may vary on other devices.
    my $File = shift;
    my $Retval = "";
    unless (open(InFP, "<", $File)) {
        warn("$progname: $File: Cannot open file to look for BWF data: $!\n");
        return("");
    }
    my $buf;
    my $numread = read(InFP, $buf, 358);
    if ($numread != 358) {
        warn("$progname: $File: Could not read 358 bytes, but continuing: " .
            "$!\n");
    }
    if ($buf =~ /^.*(\d\d\d\d)-(\d\d)-(\d\d)(\d\d):(\d\d):(\d\d)$/s) {
        $Retval = timegm($6, $5, $4, $3, $2-1, $1);
    }
    close(InFP);
    msg(2, "bwf_date($File) returns '$Retval'\n");
    return($Retval);
    # }}}
} # bwf_date()

sub sec_to_string {
    # Convert seconds since 1970 to "yyyymmddThhmmss[.frac]Z" {{{
    my ($Seconds, $Sep) = @_;
    length($Seconds) || return('');
    ($Seconds =~ /^-?(\d*)(\.\d+)?$/) || return(undef);
    my $Secfrac = ($Seconds =~ /^([\-\d]*)(\.\d+)$/) ? 1.0*$2 : "";
    $Secfrac =~ s/^0//;

    defined($Sep) || ($Sep = " ");
    my @TA = gmtime($Seconds);
    my($DateString) = sprintf("%04u%02u%02uT%02u%02u%02u%sZ",
                              $TA[5]+1900, $TA[4]+1, $TA[3],
                              $TA[2], $TA[1], $TA[0], $Secfrac);
    return($DateString);
    # }}}
} # sec_to_string()

sub print_version {
    # Print program version {{{
    print("$progname $VERSION\n");
    return;
    # }}}
} # print_version()

sub usage {
    # Send the help message to stdout {{{
    my $Retval = shift;

    if ($Opt{'verbose'}) {
        print("\n");
        print_version();
    }
    print(<<"END");

Insert filemod timestamp into filename, and start of recording if 
available. At the moment only BWF (Broadcast Wave Format, standard .wav 
with extra metadata) is supported.

Format:

  No timestamp for start of recording:
    yyyymmddThhmmssZ.OLDFILENAME
  With timestamp for start of recording:
    yyyymmddThhmmssZ-yyyymmddThhmmssZ.OLDFILENAME

Usage: $progname [options] file [files [...]]

Options:

  --bwf
    Find start of recording in Broadcast Wave Format files. This is 
    based on examining .wav files from the Zoom H4n, and it seems to 
    work there. The file format may vary on other devices.
  -d, --delete
    Delete timestamp from filename. Can not be used with -r/--replace.
  -f, --force
    If a file with the new name already exists, allow the program to 
    overwrite the file.
  -g, --git
    Use git commands when dealing with files. For example, execute the 
    command "git mv oldname newname" when renaming files.
  -n, --dry-run
    Don’t rename files, but report what would happen.
  -h, --help
    Show this help.
  -q, --quiet
    Be more quiet. Can be repeated to increase silence.
  -r, --replace
    Replace date in filename with new value. Can not be used with 
    -d/--delete.
  -s X, --skew X
    Adjust clock skew by adding X seconds to the timestamp. A negative 
    integer can also be specified.
  -v, --verbose
    Increase level of verbosity. Can be repeated.
  --version
    Print version information.

END
    exit($Retval);
    # }}}
} # usage()

sub msg {
    # Print a status message to stderr based on verbosity level {{{
    my ($verbose_level, $Txt) = @_;

    if ($Opt{'verbose'} >= $verbose_level) {
        print(STDERR "$progname: $Txt\n");
    }
    return;
    # }}}
} # msg()

__END__

# This program is free software; you can redistribute it and/or modify 
# it under the terms of the GNU General Public License as published by 
# the Free Software Foundation; either version 2 of the License, or (at 
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but 
# WITHOUT ANY WARRANTY; without even the implied warranty of 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License 
# along with this program.
# If not, see L<http://www.gnu.org/licenses/>.

# vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :