Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl -w # # 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 - unlink all but $arg_keepnum newest $filespec in $arg_dir =head1 SYNOPSIS -d ~/temp -f "foo*.???" -d c:\drtemp\deleteme -k 2 -f ?delme.txt -v >> c:\winatlogs\ +prune.log && df -hT c: d: --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 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" %*; 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\ -d c:\foo - +f bar?*.??? -r user@host.dom -v pl2bat =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

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

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?

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

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2022-01-27 08:42 GMT
Find Nodes?
    Voting Booth?
    In 2022, my preferred method to securely store passwords is:

    Results (70 votes). Check out past polls.