#!/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, and glob

 The line of code that actually unlinks files is commented out.
 Uncomment after you're comfortable with how options and arguments work.

=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