ftstamp

#!/usr/bin/env perl
use strict;
use warnings;

use File::Spec;
use Pod::Usage;
use Getopt::Long qw(GetOptionsFromArray);

my $basetime = time;

my @files;

my $ret = GetOptionsFromArray(
    \@ARGV,
    't|time=i' => \$basetime,
    'h|help'   => sub { pod2usage(1) },
    'force'    => sub { die "--force is not implemented yet" },
    '<>'       => sub { push @files, $_[0] }
);

my $timestamp = gen_timestamp($basetime);

unless (@files) {
    print $timestamp, "\n";
    exit;
}

apply_timestamp($_, $timestamp, 0) for @files;
apply_timestamp($_, $timestamp, 1) for @files;

exit;

sub apply_timestamp {
    my ($filename, $timestamp, $apply_timestamp) = @_;

    unless (-e $filename) {
        die "File '$filename' does not exist\n";
    }

    my ($dev, $dirs, $name) = File::Spec->splitpath($filename);

    $name =~ s/(\.[^.]*|)$/-$timestamp$1/;

    my $dest = File::Spec->catpath($dev, $dirs, $name);

    if (-e $dest) {
        die "Destination '$dest' already exists\n";
    }

    return unless $apply_timestamp;

    rename($filename, $dest);
}

sub gen_timestamp {
    my $basetime = shift;

    my %parts;
    @parts{qw/sec min hour mday mon year wday yday isdst/} =
      localtime($basetime);

    $parts{year} += 1900;
    $parts{month}++;

    my $timestamp = sprintf('%04d-%02d-%02d_%02d-%02d-%02d',
        @parts{qw/year mon mday hour min sec/});

    return $timestamp;
}

__END__

=head1 NAME

ftstamp - filename-friendly timestamper


=head1 SYNOPSIS

ftstamp [options] [file] [file] ...

    Options:
    --help            brief help message
    -h

    --time            UNIX timestamp to use,
    -t                system time by default


=head1 DESCRIPTION

appends timestamp to the end of filename(s)

=head1 LICENCE AND COPYRIGHT

Copyright (C) 2013, Yaroslav Korshak.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.