[Debian] Mailbox ausmisten

[Eduard Bloch]

Hallo Debian-User,

hier ist meine Lösung für das alte Problem. Braucht das Paket
libdate-manip-perl. Das Skript gehört z.B. nach /usr/local/bin, mit
"chmod +x" ausführbar machen.

MfG,
Eduard.
-- 
====================================================================
Eduard Bloch <[EMAIL PROTECTED]>; HP: http://eduard.bloch.com/edecosi
0xEDF008C5(GnuPG): E6EB 98E2 B885 8FF0 6C04 5C1D E106 481E EDF0 08C5
**
"Computer sind nicht logisch, Windows98 auch nicht und beides zusammen,
NaJaaa"                                       Mirko @ NBCGIGA 13.7.1999

#!/usr/bin/perl
# License: GP
# Copyright: Eduard Bloch <[EMAIL PROTECTED]>
die "Usage: $0 DAYS FILE\nwhere\nDAYS is an integer specifying the maximum age 
of a mail and\nFILE a pathname of the mbox file.\n" if $#ARGV < 0;
use Date::Manip;
$c=-1;
$today = ParseDate("today");

#print $ARGV[0];exit;
@st = stat("$ARGV[1]");
$oldsize = $st[7];

syswrite (STDOUT,"Reading $ARGV[1] ($oldsize bytes) ");
open(fh,"<$ARGV[1]");
while(<fh>) {
  if(/[EMAIL PROTECTED](\S\S\S\s\S\S\S\s\d\d\s\d\d:\d\d:\d\d\s\d\d\d\d)/) {
    $c++;
    $time[$c]=$1;
    syswrite (STDOUT,".");
  }
  $data[$c] = $data[$c] . $_;
}
syswrite (STDOUT,"\n");

$olddate = localtime(time - $ARGV[0] * 86400);
$olddate =~ s/\ /_/g;
#print $olddate;exit;
open(neu,">$ARGV[1]".".tmp");
open(alt,">$ARGV[1]".".$olddate");


for(0..$c) {
  @calc = split(/:/, &DateCalc(&ParseDate($time[$_]),$today));
  $diff = ($calc[2] * 7) + $calc[3];
  print  $time[$_]." -> Age: $diff day".(($diff > 1) ? "s" :"")." -> ";
#  print @calc;
#  print $time[$_]."\n";
#    print ."\n";
  if ($diff > $ARGV[0]) {
    print alt $data[$_];
    print "old.\n";
  }
  else {
    print neu $data[$_];
    print "new.\n";
  }
}

close(neu);
close(alt);
close(fh);

@st = stat("$ARGV[1]".".tmp");
$newsize = $st[7];
syswrite (STDOUT,"Wrote $st[7] to $ARGV[1]".".tmp\n");
@st = stat("$ARGV[1]".".$olddate");
syswrite (STDOUT,"Wrote $st[7] to $ARGV[1]".".$olddate\n");
$newsize += $st[7];

if($oldsize == $newsize) {
  syswrite (STDOUT,"Deleting $ARGV[1]... ");
  unlink("$ARGV[1]") || die "failed";
  syswrite (STDOUT,"replacing with the new mailbox... ");
  rename("$ARGV[1]".".tmp", "$ARGV[1]") || die "failed";
  syswrite (STDOUT,"done.\n");
}