#!/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", $archiv
+e_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, $#{$li
+stref}+1;
        $archive_status = Archive::Tar->create_archive($name,6,@{$list
+ref});
    } else {
        printf "Archive %s already exists. Adding %d files ...\n", $na
+me, $#{$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__
[download]

=pod
=head1 archive

A program to move files into gzipped archives organized and labeled by
+ month 
and year. Archive name will be label_ext_MmmYY.tar.gz. ext will be the
+ 
alphabetic characters in the supplied extension. 

=head1 USAGE

archive.pl -l LABEL -d DIRECTORY [-e EXTENSION|*] [-k KEEP|60] [-s] [-
+h] 

=over

=item -l

LABEL - a string to begin the archive file name, set off from the rest
+ by an 
underscore. This is a required parameter.

=item -d

DIRECTORY - the directory of files to be archived.  This is also a req
+uired 
parameter.

=item -e

EXTENSION - the extension of files to be archived. Do not include the 
+period. 
If this value is left blank, * will be used (and the extension in the 
+archive 
name will be "all").

=item -k

KEEP - how many days to keep unarchived. Once files are found less tha
+n this 
age, the program will stop, and that month will not be archived.  If t
+his 
value is not provided, files under 60 days in age will not be included
+ in the 
archive.

=item -s

runs without actually archiving anything; it reports to standard input
+ the 
names of archives it would have created and the files that would have 
+been 
in each.

=item -h

displays simple usage line

=back

=head1 Examples

=over

=item 

archive.pl -l FisherNuts -d /home/edi/wlsedi/data_backup/fishernuts/21
+4 
  -e 214 -k 60

=head1 Author

Howard Parks
[download]