#! /usr/bin/env perl

# script to create a "version" of the existing backup tree by
# performing a cp -al $source $target/YYYY-MM-DD
# this will create the directory structure and a hard linke
# from every file in the source (backupTree) to the target (versionDir)
# It will also, optionally (with the $cleanup flag) remove old version
# trees by calling sub canDelete for every directory under $target

# sub canDelete is designed to be modified for each individual installation

use warnings;
use strict;

use Getopt::Long;
use Date::Parse;
        
my $SECONDS_IN_DAY = 86400; # just defining it so you don't have to look it up

my $TESTING=0;
my $source;
my $target;
my $cleanup = 0;

# this subroutine MUST be modified to suit your specific needs
# The parameter passed is the directory name which is searched
# for a date in the form YYYY-MM-DD (using a regex 
# /.*(\d{4}-\d{2}-\d{2}).*/
# the date is then compared against various criteria to determine
# whether the directory should be deleted or not
# a "true" return will delete the directory tree, and a "false"
# will not. I suggest returning 0 and non-zero, though any
# return value that equates to false will work.

sub canDelete {
   my $date = shift;
   # first, parse the date in the directory name
   $date =~ m/.*(\d{4}-\d{2}-\d{2}).*/;
   #print "$date\t";
   # now, use str2time to parse it into a date
   $date = str2time($1);
   # and, turn it back into its individual parts. This lets us use yday, wday and mday. Note that we don't care
   # about the time portion in this one
   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime( $date );
   my $now = time;
   # get the same information for the current date
   my ($now_sec,$now_min,$now_hour,$now_mday,$now_mon,$now_year,$now_wday,$now_yday,$now_isdst) = localtime( $now );
   
   ######################## USER MODIFIED CODE BELOW #################################
   # Insert your code below. The following sample code removes everything older than one year
   # and everything older than 7 days UNLESS it is the first of the month
   # this gives us monthly backups for a year, and daily backups for a week.
   
   # print "$mday\n";


   return 1 if $year * 12 + $mon < $now_year * 12 - $now_mon; # true if older than one year
   return 0 if $mday == 1; # Don't remove backups from the 1st of a month
   return 1 if $now - ($SECONDS_IN_DAY * 7) > $date; # remove anything older than 7 days.
   return 0; # everything else is not deleted.
}


GetOptions(
            'source:s' => \$source,
            'target:s' => \$target,
            'debug!' => \$TESTING,
            'cleanup!' => \$cleanup
           );

unless ( -d $source && $target ) {
   print "Usage: makeVersion -s souceDirectory -t targetDirectory --[no]debug --[no]cleanup\n";
   exit 0;
}

$source =~ s!/\z!!; # remove trailing backslashes if they exist
$target =~ s!/\z!!;

`mkdir -p $target` unless -d $target; # create the target directory if it doesn't exist

print "TEST MODE\n" if $TESTING;

my $targetFileName = "$target/" . `date +'%Y-%m-%d'`; # build the file name out of the date only
chomp $targetFileName; # remove the trailing newline.

if ( -e $targetFileName ) {
   print "Refusing to overwrite existing directory $targetFileName";
   exit 4 unless $TESTING;
}

print "Creating version in $targetFileName from $source\n";
print "Started " . `date`;
if ( $TESTING ) {
   print "cp -al $source $targetFileName\n";
} else {
   print "Creating version in $targetFileName from $source\n";
   `cp -al $source $targetFileName`;
}

if ( $cleanup ) { # now, look through all subdirectories in $target and build a list of those to delete
   opendir ( my $dh, $target ) || die "Can't open $target: $!";
   # get all directories which do not begin with a period.
   my @subdirs = grep { /^[^.]/ && -d "$target\/$_" } readdir( $dh );
   closedir $dh;
   # check each one of them to see if we can delete it
   for ( $i = 0; $i < scalar(@subdirs); $i++ ) {
      $subdirs[$i] = '' unless &canDelete( $subdirs[$i] ) ;
   }
   @subdirs = grep ( !/^$/, @subdirs);
   # build a delete string by 1) removing blank members (grep), 2) adding the directory (map)
   # then 3) joining the resulting array with spaces and 4) then putting the rm command in front
   if ( @subdirs ) {
      my $deleteString = "rm -fR " . join( ' ', map ( "$target\/$_", @subdirs ) );
      if ( $TESTING ) {
         print "$deleteString\n";
      } else {
         print "Removing old versions\n$deleteString\n\n";
         `$deleteString`;
      }         
   }
}
print "Ended " .  `date`;

1;