Re: Mails mit mutt nach Alter wegspeichern

[Johannes Kolb <johannes.kolb@web.de>]

Hallo zusammen,

On Wed, Mar 13, 2002 at 05:49:09PM +0100, Eduard Bloch wrote:
> #include <hallo.h>
> Udo Mueller wrote on Wed Mar 13, 2002 um 05:00:56PM:
> 
> > alzu gut mit binaries zurechtkommt, die an den Mails hängen? Hab
> > eine MB mit ner 6 MB MP3 und da ackert mail-expire schon seit ner
> > 1/4 Stunde dran rum.
> 
> Möglich, ich lasse es nur auf Mailing-Listen los, und da tut es seit
> Monaten tadellos. Ich hoffe, du kannst mit Perl debuggen ;)

IMHO liegt das Problem darin, dass zunächst die gesamte Mailbox in das Array
$data eingelesen wird und danach erst die Ausgabedateien erzeugt werden.

Ich hab das Skript mal umgeschrieben, so dass es die Dateien
gleich schreibt - und ein Test mit einer 2 MB-Mail ergab Laufzeiten in
der Größenordnung eines cp-Befehls.

Um das Ganze noch ein bißchen schneller zu machen, habe ich auch die
Funktionen aus Date::Manip duch Funktionen von Date::Calc ersetzt; die
sind angeblich besser.

cu,

Johannes

#!/usr/bin/perl
# mail-expire, Version 0.0.3, Mon Apr 16 14:40:40 CEST 2001
# Copyright: Eduard Bloch <blade@debian.org>
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details. The full text of GPL can be
# found on http://www.gnu.org or in /usr/share/common-licenses/GPL on
# modern Debian systems.
#
# -----------------------------------------------------------------------
# If you make changes to this script, please feel free to forward the new 
# version to <blade@debian.org> or <eduard@bloch.com>
# -----------------------------------------------------------------------
#
# Changes by Johannes Kolb:
#  * use Date::Calc instead of Date::Manip to increase performance
#  * no buffering of whole mailbox-files in memory

die "Usage: $0 DAYS FILES\nwhere\nDAYS is an integer specifying the maximum age of a mail in days and\nFILES one or more mbox file(s).\n" if ($#ARGV < 1 | $ARGV[0]=~/[:^digit:]/);
use Date::Calc qw(Parse_Date Today Delta_Days);
$c=-1;
@today = Today();
$olddate = localtime(time - $ARGV[0] * 86400);
$olddate =~ s/\ /_/g;

JOB: foreach $file (1..$#ARGV) {
   close(neu);
   close(alt);
   undef @st;
   undef @time;
   undef $c;
   
   $oldsize = (stat("$ARGV[$file]"))[7];
   if ($oldsize == 0) {
      syswrite(STDOUT,"Empty file $ARGV[$file], skipping");
      next JOB;
   };

   if(!open(fh,"<$ARGV[$file]")) {
      syswrite(STDOUT,"$ARGV[$file] could not be opened, skipping");
      next JOB;
   };
   if(flock(fh,2|4)){
      # lock when not locked allready by another process
      flock(fh,2);
   } else {
      # skip file
      close(fh);
      syswrite(STDOUT,"$ARGV[$file] is locked by an other prozess, skipping.");
      next JOB;
   };

   open(neu,">$ARGV[$file]".".tmp");
   open(alt,">$ARGV[$file]".".$olddate");

   syswrite (STDOUT,"Reading ans splitting $ARGV[$file] ($oldsize bytes)...\n");
   while(<fh>) {
      if(/^From \S/) {
	  $c++;
	  @maildate = Parse_Date($_);
	  $diff = Delta_Days(@maildate,@today);
          syswrite(STDOUT, "Age: $diff day".(($diff > 1) ? "s" :"")." -> ");

	  if ($diff > $ARGV[0]) {
	     $isold = 1;
	     $alte++;
	     syswrite(STDOUT, "old.\n");
	  }
	  else {
	     $isold = 0;
	     $neue++;
	     syswrite(STDOUT, "new.\n");
	  }
      }
      if ($isold) {
	  print alt $_;
      } else {
	  print neu $_;
      }
   }
   close(fh);

   # MUST BE CLOSED BEFORE STAT'ING THEM
   close(neu);
   close(alt);

   (undef,undef,undef,undef,undef,undef,undef,$newsize)=stat("$ARGV[$file]".".tmp");
   @st = stat("$ARGV[$file]".".$olddate");
   $newsize += $st[7];
   
   syswrite (STDOUT,"Wrote $neue new entries to $ARGV[$file]".".tmp\n");
   syswrite (STDOUT,"Wrote $alte old entries to $ARGV[$file]".".$olddate\n");
   
   if($oldsize == $newsize) {
   syswrite (STDOUT,"Deleting $ARGV[$file]... ");
   unlink("$ARGV[$file]") || die "failed";
   syswrite (STDOUT,"replacing with the new mailbox... ");
   rename("$ARGV[$file]".".tmp", "$ARGV[$file]") || die "failed";
   syswrite (STDOUT,"done.\n");
   } else {
      syswrite(STDOUT,"hm, $oldsize = $newsize?");
   }
}