Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

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] 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__

POD:

=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
1 Peter 4:10

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (1)
As of 2021-10-27 06:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (91 votes). Check out past polls.

    Notices?