#!/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__ #### =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 required 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 than this age, the program will stop, and that month will not be archived. If this 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/214 -e 214 -k 60 =head1 Author Howard Parks