Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/bin/perl -w # prune.pl # pod at tail # allays stuff use strict; # avoid D'oh! bugs use Getopt::Long; # options & arguments use Pod::Usage; # eliminate redundant Usage() use File::Spec; # strip path from $0 use Sys::Hostname; # determine hostname of localhost my $VERSION = '0.3.18'; $|++; # program-specific stuff use Net::SMTP; # email notification # preliminaries my $time = localtime(time); my $host = hostname; # localhost my $arg_keepnum = 3; # default value my $arg_smtp = $host; # default value my ($feh, $eep, $program) = File::Spec->splitpath( $0 ); push my @message, '#' x 40, "\n"; push @message, "$time\n"; # options and arguments my ($arg_dir, $arg_filespec, @arg_recipients); my ($opt_help, $opt_man, $opt_versions); GetOptions( 'dir=s' => \$arg_dir, 'filespec=s' => \$arg_filespec, 'keepnum=i' => \$arg_keepnum, 'recipients=s' => \@arg_recipients, 'smtp=s' => \$arg_smtp, 'versions!' => \$opt_versions, 'help!' => \$opt_help, 'man!' => \$opt_man, ) or pod2usage(-verbose => 1) && exit; pod2usage(-verbose => 1) && exit if $opt_help; pod2usage(-verbose => 2) && exit if $opt_man; pod2usage(-verbose => 1) && exit unless $arg_dir && $arg_filespec; # read specified directory for specified filespec chdir $arg_dir or die "Error chdir to $arg_dir: $!"; my @files = grep -f $_, glob($arg_filespec); # nominal validation of input my $filenum = scalar(@files); $arg_keepnum = $filenum if $arg_keepnum > $filenum; unless($filenum){ push @message," No files found matching regex $arg_filespec\n\n"; exit; } # sort by timestamp, oldest first my %file; $file{$_} = (stat($_))[9] for(@files); my @filesOldFirst = sort { $file{$a} <=> $file{$b} } keys %file; # delete all but newest n specified files my @allButNewestN = @filesOldFirst[0 .. $filenum-$arg_keepnum-1]; unlink or warn "Error unlinking $_ : $!" for @allButNewestN; # report on specified files retained and purged my @newestN = @filesOldFirst[$filenum-$arg_keepnum..$filenum-1]; my $allButNewestN = scalar(@allButNewestN); push @message, " Specified Files Retained:\n"; push @message, " $_\n" for @newestN; push @message, " Specified Files Pruned:\n"; push @message, " $_\n" for @allButNewestN; END{ # report on versions n'such if(defined $opt_versions){ my @versions = ( " Modules, Perl, OS, Program info:\n", " Net::SMTP $Net::SMTP::VERSION\n", " Sys::Hostname $Sys::Hostname::VERSION\n", " Getopt::Long $Getopt::Long::VERSION\n", " Pod::Usage $Pod::Usage::VERSION\n", " strict $strict::VERSION\n", " Perl $]\n", " OS $^O\n", " $program $VERSION\n", " localhost $host\n", ); push @message, @versions; } # merge messages my $message = join('', @message); print $message unless $opt_help or $opt_man; # email notification o'results if(@arg_recipients){ my $autoMsg = "Message automatically generated by $program program and sent to +:"; my $recipListMsg = join("\n ", @arg_recipients); for my $recipient(@arg_recipients){ print "Sending message to $recipient... "; if(my $smtp = new Net::SMTP($arg_smtp)){ $smtp->mail("$program\@$host"); $smtp->to($recipient); $smtp->data(); $smtp->datasend("To: $recipient\n"); $smtp->datasend("Subject: $program - $host \n"); $smtp->datasend("\n"); $smtp->datasend("\n$autoMsg\n $recipListMsg\n\n$message\n"); $smtp->dataend(); $smtp->quit(); print "successful"; } } } } =head1 NAME prune.pl - unlink all but $arg_keepnum newest $filespec in $arg_dir =head1 SYNOPSIS prune.pl -d ~/temp -f "foo*.???" prune.pl -d c:\drtemp\deleteme -k 2 -f ?delme.txt -v >> c:\winatlogs\ +prune.log && df -hT c: d: prune.pl --dir = ~/temp --filespec = "foo*.???" --keepnum = 7 --recipients = FOO --smtp = host.domain --version --help --man =head1 OPTIONS AND ARGUMENTS =head2 MANDATORY ARGUMENTS dir directory to prune old files from absolute or relative filespec filename sans path - wildcards like * and ? are valid doublequotes needed for *nix bash if wildcard(s) doublequotes optional for win32 command.com and cmd.exe =head2 OPTIONAL ARGUMENTS keepnum number of newest files to retain (default 3) recipients email address to send results to smtp nearest mailserver (default localhost) =head2 OPTIONAL OPTIONS versions print Perl, module, and program versions to screen help print brief usage message to screen man print full contents of program pod to screen =head1 DESCRIPTION Prune old files of specified name/extension from a given directory. Intended to run periodically from *nix cron or win32 at. Entirely possible this could be done in fewer LOC using File::Find. Nonetheless, a good refresher for /me on stat, sort, cmp, regexen, an +d glob The line of code that actually unlinks files is commented out. Uncomment after you're comfortable with how options and arguments wor +k. =head1 WIN32 NOTES assoc .pl=Perl ftype Perl=c:\perl\bin\perl.exe "%1" %* pathext=.pl; path=c:\perl\bin\; Login as administrator control panel, scheduler, runas specific_user at 06:00 /every:Th c:\perl\bin\perl.exe c:\perls\prune.pl -d c:\foo - +f bar?*.??? -r user@host.dom -v pl2bat prune.pl =head1 SMTP NOTES telnet mailserver.dom.tld 25 220 mailserver.dom.tld ESMTP helo client.dom.tld 250 OK mail from: user1@dom.tld 250 Sender OK rcpt to: user2@dom.tld 250 Recipient OK testing, testing, 1... 2... 3 . 250 Message accepted for deliver quit 221 mailserver.dom.tld closing connection =head1 SEE ALSO Perl(1) Pod::Usage(3perl) Sys::Hostname(3perl) File::Spec(3perl) Getopt::Long(3) Net::SMTP(3) =head1 TESTED Net::SMTP 2.19 2.24 2.16, 2.24 Sys::Hostname 1.1 1.1 1.1 Getopt::Long 2.32 2.25 2.25 Pod::Usage 1.14 1.14 1.14 strict 1.01 1.01 1.01, 1.02 Perl 5.006001 5.006001 5.006001, 5.008 OS Debian 3.0 Win(2k|NT4) Cygwin =head1 UPDATES 2003-02-21 19:20 CST chdir to target directory (fixes substantial bug) tweak output for legability error handling to chdir 2002-11-27 12:25 CST Add Win32, SMTP notes to pod Test with Perl 5.8.0 Cygwin on Win2kPro Post to PerlMonks Code Catacombs Utility Scripts glob() for filesystem wildcards (foo*.???) instead of perl regex Summarize PCRE for --man Sanity check for $numKeep =< $filenum Test with ActivePerl on WinNT, Win2kPro Email results - id://181972 Ponder globbing, to allow non-regex user input of filespec Sys::Hostname for localhost name Email notification of results Getopt::Long; Pod::Usage; 2002-11-24 22:25 CST Initial working code =head1 TODO Debug no '--help' output on Cygwin Test err on unlink if insufficient perms Taint-check user-supplied params Eliminate all but newest(?) of duplicate files before pruning use File::Same; my @fileDups = File::Same::scan_dir($_, $arg_dir); AppConfig instead of Getopt::Long(?) config file support in addition to commandline args/options =head1 CREDITS Thanks to: Petruchio, jkahn, Undermine for allButLastN direction, Zaxo, theorbtwo, fever, BrowserUk for precedence tips, tye, bel4mit, PodMaster for glob direction, Mr. Muskrat for shell escape diffs cmd.exe to bash, And to some guy named vroom. =head1 AUTHOR ybiC =cut

In reply to (code) Cross-platform unlink all but $n newest $filespec in $dir by ybiC

Title:
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!
  • 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
  • Outside of code tags, you may need to use entities for some characters:
            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?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (7)
    As of 2014-12-27 05:59 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (176 votes), past polls