#!/usr/bin/perl


# Change this to wherever you want to your backups to go
my $base = '/rsync';
# And whatever you wnat to exclude, if anything
my @rsync_exclude =
qw(
 '/rsync'
 '/cb'
 '/dell'
 '/lat'
 '/proc'
 '/cdrom'
 '/dev'
 '/mnt'
 '/cdrecorder'
 '/dvd'
 '/media'
 '/floppy'
 'audio/'
 '*~'
);

########################################################################
# No user seviceable parts below this line
########################################################################


my @days = qw(sunday monday tuesday wednesday thursday friday saturday);
my $dtoday = (localtime(time))[6];

my $today = $days[$dtoday];
my $yesterday = $days[ $dtoday == 0 ? 6 : $dtoday - 1 ];

sub run($) {
  my $command = shift;
  print "$command\n";
  system($command) == 0 or die $!;
}

########################################################################
# Remove todays directory, since it is now a week old
run "rm -rf $base/$today" if -e "$base/$today";
########################################################################

########################################################################
# Then copy yesterday's directory to today, using hard links
run "cp -al $base/$yesterday $base/$today" if -e "$base/$yesterday";
########################################################################

########################################################################
# And finally update today's directory using rsync
my $rsync_command = "rsync -a --delete ";
foreach (@rsync_exclude) {
  $rsync_command .= " --exclude=$_ \\\n";
}
$rsync_command .= " / $base/$today";
run $rsync_command;
########################################################################


__END__

=head1 NAME

backup.pl -  use rsync with Mike Rubel's idea to make rotating backups

=head1 SYNOPSIS
 
 In a cron job put:
  0 4 * * * perl backup.pl

Be sure you have sufficient permissions!


=head1 DESCRIPTION

Make a set of rotating backups using rsync and subdirectories named
for the days of the week.

=head1 AUTHOR

Henry Laxen nadine.and.henry@pobox.com

=head1 SEE ALSO

perl(1).

=cut