#!/usr/bin/perl
#
#  This script was developed by John Harrison (japh@in-ta.net),
#  using 'rename' as an example.
#
#  This script is free software; you can redistribute it and/or modify it
#  under the same terms as Perl itself.
#
# $Log: backup,v $
# Revision 1.5  2006/01/26  02:45:48 jgh
# Set atime and mtime of target file to be the same as source file.
#
# Revision 1.4  2005/02/13  18:12:53  jgh
# Catch filename already with timestamp, added getopt & podified.
#
# Revision 1.3  2004/09/23  14:55:14  jgh
# First perl version (ported from shell script)
#
# Revision 1.2  2002/04/10  00:00:00  jgh
# Standardise to strings (use variables instead of $(...) in action)
#
# Revision 1.1  2002/01/05  19:50:20  jgh
# Thu Feb 21 19:50:20 GMT 2002
# Add -mv option (@a-z)
#
# Revision 1.0  2001/04/11  17:24:18  jgh
# Original shell script version for revisioning kickstart work
# (@fnc apt Brentford)

use warnings;
use strict;

use Time::localtime;
use File::Copy;

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

my ($do_mv, $copy, $verbose, $no_act, $force, $usage, $file);

die "Usage: backup [-cfmnuv] [filenames]\n"
    unless GetOptions(
    'c|cp|copy'    => \$copy,
    'f|force'      => \$force,
    'm|mv|move'    => \$do_mv,
    'n|no-act'     => \$no_act,
    'u|help|usage' => \$usage,
    'v|verbose'    => \$verbose,
    );

die <<EOT if ($usage);
Usage: backup [-cfmnuv] [filenames]
 -c --cp --copy (default - for safety)
 -f --force (overwrite existing files)
 -m --mv --move (most useful) :o)
 -n --no-act
 -u --usage (--help) (print this message)
 -v --verbose
EOT

$verbose++ if $no_act;

if (!@ARGV) {
    print "reading filenames from STDIN\n" if $verbose;
    @ARGV = <STDIN>;
    chop(@ARGV);
}

for (@ARGV) {

    my $file = $_;

    die "File `$file' does not exist.\n" unless(-e "$file");

    # C's tm structure from time.h;
    # namely with sec, min, hour, mday, mon, year, wday, yday, and isdst..
    #
    # my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    #     $atime,$mtime,$ctime,$blksize,$blocks) = stat($file);

    my $mtime=(stat($file))[9];
    my $tm = localtime($mtime);
    my $time = sprintf "%4i%02i%02i%02i%02i%02i",
        1900 + $tm->year, 1 + $tm->mon, $tm->mday,
        $tm->hour, $tm->min, $tm->sec;

    my ($new_name, $new_ext);

    die $@ if $@;

    if ($file =~ /$time/) {

        print "`$file' matches [$time]\n";
        next;

    }
    elsif ( $file =~ /\.tar\.gz$/ ) {

        ($new_name = $file) =~ s/\.tar\.gz$//g;
        $new_ext = ".tar.gz";

    }
    elsif ( $file =~ /.*\.([^\.]+)$/ ) {

        $new_ext = ".$1";
        ($new_name = $file) =~ s/$new_ext$//g;

    }
    else {

        $new_ext = "";
        $new_name = $file;

    }

    my $target = "$new_name.$time$new_ext";

    if (-e $target and !$force) {

        warn  "`$file' not renamed: `$target' already exists\n";

    }
    elsif ( $no_act ) {
            
        if ( $do_mv ) {

            print "`$file' -> `$target'\n" if $verbose;

        }
	else {

            print "`$file' -> `$file' + `$target'\n" if $verbose;

        }

    }
    else {

        if ( $do_mv and move("$file", "$target") ) {

            print "`$file' -> `$target'\n" if $verbose;

        }
	elsif ( copy("$file", "$target") ) {

            my $atime=(stat($file))[8];

	    if ( utime($atime,$mtime,$target) ) {

                print "`$file' -> `$file' + `$target'\n" if $verbose;

            }
	    else {

	        die "Can't set atime & mtime of '$target': $!\n";

            }


        }
	else {

            warn  "Can't backup `$file' to `$target': $!\n";

        }

    }

}

__END__

=head1 NAME

backup - renames multiple files to have their timestamp in the filename

=head1 SYNOPSIS

B<backup> S<[ B<-c> ]> S<[ B<-f> ]> S<[ B<-m> ]> S<[ B<-n> ]> S<[ B<-u> ]> S<[ B<-v> ]> S<[ I<files> ]>

=head1 DESCRIPTION

C<backup>
backs up the filenames supplied to copies which include the
original file's timestamp in their name.

e.g.

    backup FILE

would create FILE.<timestamp>

If no filenames are given on the command line, filenames
will be read via standard input (as 'rename' command does).

If the argument --move (or one of its forms) is given the
file will be renamed (the default is to create a copy).

    backup --mv FILE

=head1 OPTIONS

=over 8

=item B<-m>, B<--mv>, B<--move>

Move: move the file instead of copying it.

=item B<-c>, B<--cp>, B<--copy>

Copy: (default action so ignored)
This is the default because it may be safer to copy a file than go renaming
it if it is in use (e.g. a log file) but it will use more disk space!

=item B<-v>, B<--verbose>

Verbose: print names of files successfully backed up.

=item B<-n>, B<--no-act>

No Action: show what files would have been backed up.

=item B<-f>, B<--force>

Force: overwrite existing files.

=item B<-u>, B<--usage>, B<--help>

Usage: show usage

=back

=head1 ENVIRONMENT

No environment variables are used.

=head1 AUTHOR

John G. Harrison L<http://www.aotea.org/john/>

=head1 COPYRIGHT

Copyright (C) 2005, John G. Harrison, all rights reserved.

This is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.

=head1 SEE ALSO

mv(1), perl(1), localtime(3), rename(1)

=head1 DIAGNOSTICS

If the new filename already exists or the file already has the timestamp in
its name you'll get an error.

=head1 TODO

Perhaps timestamp formatting could be specified on the command line (ala date).

The shell script version has two options, --mvtn and --cptn 

=head1 BUGS

The --copy option doesn't work on directories, it creates a file then fails.

The --move option works on a directory if the target doesn't already exist.
(move would overwrite an empty target dir or fail on a non-empty target dir)

If you find any bugs or have suggestions, please let the me know...
(the best contact method is via my website, because this email address gets
much too much spam)

=cut