#!/home/edi/perl/perl
use strict; 
use warnings;
use Archive::Tar;
use Date::Format;
use Getopt::Std;
getopts('l:d:e:k:hs');
our ($opt_l, $opt_d, $opt_e, $opt_k, $opt_h, $opt_s);
my $oldmonth  = 'Never';
my $label     = $opt_l unless ($opt_h);
my $directory = $opt_d unless ($opt_h);
die "Usage: [perl] archive.pl -l LABEL -d DIRECTORY -e [EXTENSION|.*] [-k [KEEP|60]] [-hs] \n" 
	unless ($label && $directory);
my $ext       = $opt_e || '.*';
my $keep      = $opt_k || 60;
print "Building master list ... ";
chdir $directory or die "Can't cd to $directory\n";
$directory .= '/' unless (substr($directory,-1) eq '/');
my $extreg = qr/$ext$/;
my $extension = $opt_e || 'all';
$extension =~ s/[^A-Za-z]//g;
opendir DIR, $directory;
my @allfiles = map  { [ $_->[0], time2str('%b%y',$_->[1]), $_->[2] ] }
               sort { $a->[1] <=> $b->[1] } 
               map  { [ $_, (stat($directory . $_))[9], -M $directory . $_ ] }
		       grep { /$extreg/ }
		       grep { ! /(?:.tar|.gz)$/ }
		       grep { -f }
		       readdir DIR;
closedir DIR;

my @filelist = ();
printf "%d files found.\n", $#allfiles+1;
foreach my $faref (@allfiles) {
	my ($filename, $arcmonth, $age) = @{$faref};
	die "Stopped due to files less than $keep days old\n" if ($age < $keep);
	chomp $filename;
	if ($arcmonth ne $oldmonth) {
		if (@filelist) {
			arclist();
		}
		$oldmonth = $arcmonth;
	}	
	push @filelist, $filename;
}
if (@filelist) {
	arclist();
}

sub arclist {
	my $archive_name = sprintf('%s_%s_%s.tar.gz', $label, $extension, $oldmonth);
	if ($opt_s) {
		printf "Files that would have been included in %s:\n", $archive_name;
		printf "%s\n", $_ for @filelist;
		@filelist = ();
	} else {
		my $success = arczipzap($archive_name, \@filelist);
	}
}

sub arczipzap {
	my ($archive_status);
	my ($name, $listref) = @_;
	if (! -e $name) {
		printf "Creating archive %s with %d files ... ", $name, $#{$listref}+1;
		$archive_status = Archive::Tar->create_archive($name,6,@{$listref});
	} else {
		printf "Archive %s already exists. Adding %d files ...\n", $name, $#{$listref}+1;
		my $tar= Archive::Tar->new($name);
		$archive_status = $tar->add_files(@{$listref});
		$archive_status = $tar->write($name,6);
	}
	if ($archive_status) {
		print "successfully.\nCleaning up archived files ... ";
		unlink @{$listref};
		printf "%d files deleted.\n",$#filelist+1;
	} else {
		print "Archive failed.\n";
	}	
	@{$listref} = ();
}

__END__