IMAP での expire

ML 等でメールがたまってくると IMAP で読むのに遅くて大変である。 Wanderlust には expire 設定があるのだが、いまいち IMAP で使うと嬉しくなさげである。仕方が無いので perl のプログラムでやることにした。下記の expire.pl をメールサーバ上で実行すると、 ~/Maildir/ 以下のメールをスキャンし最新の 500 を残して ~/Mail/に移動する。移動先は MH 形式で番号は X-Mail-Count の値と同期する。

#!/usr/bin/perl
$N = 500;
$srcdir=$ARGV[0]||"$ENV{'HOME'}/Maildir";
open(FL,"find  $srcdir -type f|xargs grep -H ^X-Mail-Count:|");
while(<FL>){
        s/[\r\n\s]//g;
	unless(s/:[^:]+:([^:]+)$//){
		next;
	}
	$value=int($1);
	if($_ eq $file){
		next;
	}
	$file=$_;
        unless(/\/\.([^\/]+)\/cur\/[^\/]+$/){
                next;
        }
        $folder=$1;
        $ML{$folder}{$value}=$file;
}
close(FL);
foreach $folder(keys %ML){
        @mls=sort {$b<=>$a} keys %{$ML{$folder}};
	$num = @mls;
	print "$folder($num)\n";
	if($num <= $N){
		next;
	}
        splice(@mls,0,$N);
        $dstdir="$ENV{'HOME'}/Mail/$folder";
        system("mkdir -p $dstdir");
        foreach $no(@mls){
                $file=$ML{$folder}{$no};
                $ret=rename("$file","$dstdir/$no");
		unless($ret){
			print "rename($file,$dstdir/$no): $!\n";
		}
        }
}
exit(0);