Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister

Archive by month and extension

by GotToBTru (Prior)
on Nov 24, 2014 at 21:01 UTC ( #1108285=CUFP: print w/replies, xml ) Need Help??

Created the following to archive data from our applications. We archive by month, and by file extension, so those are built in assumptions in this program.

Source Code:

#!/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] -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__


=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 -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 -l FisherNuts -d /home/edi/wlsedi/data_backup/fishernuts/21 +4 -e 214 -k 60 =head1 Author Howard Parks
1 Peter 4:10

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://1108285]
Approved by ww
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (7)
As of 2021-01-18 10:50 GMT
Find Nodes?
    Voting Booth?