=head1 NAME

backup.pl - Yet Another Script for making rotating backups

=head1 SYNOPSIS

backup.pl --bakdir=??? [--netdir=??? --keep=???
--verbose|noverbose]

Options:

    --bakdir	- required -	where to look for and store
				backup files, uses environment
				variable BAKDIR if it exists

    --netdir	- optional -	where to make a redundant copy of
				the new backup file, can be a
				directory or file name, uses
				environment variable BAKDIR_LAN if
				it exists

    --keep	- optional -	how many backup files to keep before
				recycling the oldest, defaults to 10

    --noverbose	- optional -	will suppress messsages to STDOUT
    | OR
    --verbose	- optional -	(default) will encourage messsages
				to STDOUT

NOTE: The items to be backed up are listed in __DATA__

=head1 DESCRIPTION

Yet another personal backup script.  

This script was written for my current work setup - WinXP with three
hard disk partitions and access to limited space on a network share.

It creates a zip-compressed backup file in $bakdir that contains a
set of files and directories as listed in __DATA__.  Keeping the
list in __DATA__ means that it can't be separated from the backup
script.

It creates a new file each time it is run and it removes the oldest
backup file(s) when the total number of backup files exceeds $keep.  

Backup filenames have the form yyyy-mm-dd-hh-nn-ss-xxx.zip. The
'xxx' part is to avoid a naming conflict when multiple backups are
created in the same second.  The first filename will use '000', the
next '001' etc.  

As an additional precaution it copies the newly created backup file
to $netdir.  Yes this is redundant, but as the saying goes: "Who is
General Failure, and why is he reading my hard disk?"

Features have been minimised in the hope of avoiding the endless
complications of an industrial strength backup application.  If you
want more features then you might want to consider
http://BackupPC.sourceforge.net. 

The usual disclaimers apply.  Please don't rely on this script
unless you have tested it to your own satisfaction.

=head1 BUGS

If you try to make more than 1000 backups in the same second the
script will probably start an infinite loop.  Try to avoid this.

=head1 AUTHOR

EdwardG (perlmonks@edwardguiness.com)

Loosely based on File::Backup by Ken Williams and backfiles.pl by
Jeffa.  

=head1 COPYRIGHT

Copyright 2003 Edward Guiness.  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

File::Backup (CPAN)

http://BackupPC.sourceforge.net

http://perlmonks.com/index.pl?node_id=177830 (backfiles.pl)

=cut
use 5.6.1;
use strict;
use warnings;
use Getopt::Long;
use Env qw (BAKDIR BAKDIR_LAN);
use File::Path;
use Archive::Zip;
use File::Find::Rule;
use File::Copy;
use File::Spec;
use Pod::Usage;

my $verbose = 1;
my $keep = 10;
my $bakdir = '';
my $netdir = ''; 

GetOptions(
    'verbose!'	=> \$verbose
,   'keep=i'	=> \$keep
,   'bakdir=s'	=> \$bakdir
,   'netdir=s'	=> \$netdir
);

$bakdir ||= $ENV{BAKDIR};
$netdir ||= $ENV{BAKDIR_LAN};

pod2usage(-verbose=>0) unless ($bakdir);

die "Cowardly refusing to keep less than 1 backup file\n" if ($keep < 1);

sub yak {
    print @_ if ($verbose);
}

sub newname {
    my @t = reverse((localtime)[0..5]); $t[0]+=1900; $t[1]++;     
    my $newbackup = $bakdir.'\\'.sprintf("%4u-%02u-%02u-%02u-%02u-%02u_000",@t).'.zip';
    $newbackup =~ s/(\d\d\d)\.zip$/substr('00'.($1+1),-3).'.zip'/e while (-e $newbackup);
    return $newbackup;
}

# Ensure that the backup directory exists
eval {mkpath($bakdir)};
die "Unable to find or create directory $bakdir\n$@\n" if ($@);

yak "Attempting a backup of -\n";

# Tell Archive::Zip about the files and directories we want to backup
my $zip = Archive::Zip->new();
$zip->addTree($_,$_) for grep {
    chomp;
    yak "$_\n";
    (($_) and (-e)) or not warn "'".$_."' NOT FOUND";
} <DATA>;

# Choose a name for this backup
my $newbackup=newname();

# Create the backup and confirm its existence
$zip->writeToFileNamed( $newbackup );
die "\$zip->writeToFileNamed() failed to create $newbackup\n" unless (-e $newbackup);

yak "New backup created: $newbackup (" . (-s $newbackup) . " bytes)\n";

# Get a list of existing backup filenames sorted by modification time
my @backupfiles = sort {(stat $a)[9] <=> (stat $b)[9]} 
    File::Find::Rule
	->file()
	->name(qr/^\d\d\d\d(?:-\d\d){5}_\d\d\d\.zip$/)
	->in($bakdir); 

yak "Found a total of " . scalar(@backupfiles) . " backup files in $bakdir\n";

# Recycle the oldest backup(s) if necessary
while ( scalar(@backupfiles) > $keep ) {
    yak("Unlinking oldest backup file: ". File::Spec->canonpath($backupfiles[0]) ."\n");
    unlink($backupfiles[0]) or warn "Unable to unlink $backupfiles[0]\n";
    shift @backupfiles;
}

if ($netdir) {
    yak "Copying $newbackup to $netdir\n"; 
    copy($newbackup, $netdir) or warn "Copy failed: $!"; 
}

yak "Finished\n"; 

__DATA__
c:\perl\usr\lib
c:\utils
c:\batch
e:\iis
c:\vim
e:\my documents