#!/usr/bin/perl -w
#
# qrm-ager      --crb3 16aug03/02apr07
#
# iterate across /qrm dirs, deleting files older than specified daycount.
# defaults: /home/*/Maildir/qrm, 14 days
# options:
# -b    basedir         /home, /var/vpopmail/users
# -a    agedays         14
# -m    maildir         qrm
# -v verbose
# -D debug
# -u    user            *, cr
# -x    xfr             move to this dir rather than delete
#
# this goes in /usr/local/sbin.
#
# --crb3 02Apr07: update getopts section, add -? help
#
$chatty=0;
$safety=0;

$logger="/usr/bin/logger";              # this works in linux
($myname=$0) =~ s/^.+\///;
$loglvl="alert";        # log in /var/log/maillog at qmail's verbosity

$args="_none_";
if(defined($ARGV[0])){          # pack all the args together for reporting
  $args=join(' ',(@ARGV));
  $args =~ s/\-//g;
}
loggit("run with args $args");

$xfrdir="*";
$basedir="/home";
$maildir="qrm";
$age=14;

while(defined($ARGV[0]) and index($ARGV[0],'-') >-1){
  $arg=shift(@ARGV);
  $key=substr($arg,1,1);
  substr($arg,0,2)="";
  if($key eq 'v'){
    $chatty ^= 1; next;
  }elsif($key eq 'D'){
    $safety ^= 1; next;
  }elsif($key eq '?'){
    print <<EOT;
 qrm_ager old-spam deleter for qrm-modified Maildirs --crb3 12Aug03/02Apr07
     qrm_ager [options]
   Options:
        -a days         threshold, age in days (default: 14)
        -b /path        basedir for iteration (default: /home)
        -m dir          which Maildir (default: qrm)
        -u user         do one user's Maildir (* == all)
        -x /path        xfr mail to this dir rather than delete
        -v              toggle: script gets chatty
        -D              toggle: turn on ad-hoc debug tracers, safety mode
        -?              show helps, then leave
EOT
    exit(0);
  }
  $arg =~ s/^\=//;                      # handles switch=arg
  $arg=shift(@ARGV) if($arg eq "" and ($ARGV[0] !~ /^\-\w/) );
#                     # handles space-separated switch/arg
# all of these take args
#
  if($key eq 'b'){
    $basedir = $arg;
  }elsif($key eq 'u'){
    $user = $arg;
  }elsif($key eq 'a'){
    $age = $arg;
  }elsif($key eq 'm'){
    $maildir = $arg;
  }elsif($key eq 'x'){
    $xfrdir = $arg;
  }else{
    warn "$myname: unrecognized option -$key $arg\n";
    next;
  }
}
if($xfrdir eq '*'){
  $action="deleting";
}else{
  $action="mv to $xfrdir";
}

chdir $basedir;
(@users)=(<*>);
foreach $user (@users){
  next unless -d $user;
  $hdir = $user;           # iterate through all the usernames shown
  unless($user eq '*'){
    ($duser = $user) =~ s/^.+\///;
    next unless $duser eq $user;
  }
  next unless -d "$basedir/$hdir/Maildir/$maildir";
  print "$0: aging $basedir/$hdir/Maildir/$maildir...\n" if $chatty;
  chdir "$basedir/$hdir/Maildir/$maildir";
  for(<*>){
    next unless -f;
    $fl = $_;
    print "--$fl\n" if $safety;
    if( ($fla = int(-M $fl)) >= $age){
      $msg = "/$basedir/$hdir/Maildir/$maildir/$fl age is $fla days: $action.\n";
      print $msg if $chatty;
      loggit($msg);
        if($xfrdir eq '*'){
          unlink($fl) unless $safety;
        }else{
          `mv $fl $xfrdir` unless $safety;
        }
    }
  }
}continue{
  chdir $basedir;
}

sub loggit {
  my $logmsg = shift(@_);

  my $cms = "$logger -p mail.$loglvl -t $myname \"$logmsg\"";
  CORE::system($cms);
}

 Grab a
gzipped
copy
here
 
Syntax highlighting using Syntax::Highlight::Engine::Kate