Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

comment on

( #3333=superdoc: 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

In reply to Archive by month and extension by GotToBTru

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (5)
    As of 2021-05-07 04:36 GMT
    Find Nodes?
      Voting Booth?
      Perl 7 will be out ...

      Results (86 votes). Check out past polls.