IMAP フォルダ振り分け

Maildir な IMAP フォルダを From を基準に振り分けるプログラムを書いてみた。

#!/usr/bin/perl
open(FL,"find ~/Maildir -type f|");
foreach $fn (<FL>){
        $fn=~s/[\r\n]//g;
        if($fn=~/Maildir\/{cur,tmp,new}/){
                next;
        }
        open(RL,$fn);
        undef($from);
        foreach $ln (<RL>){
                $ln=~s/[\r\n]//g;
                if($ln=~/^From:/){
                        $from=$ln;
                        break;
                }
        }
        foreach $ln (<RL>){
                $ln=~s/[\r\n]//g;
                unless(/^\s/){
                        break;
                }
                $from.=' ';
                $from.=$ln;
        }
        close(RL);
        if($from=~/<([^\s]+)>/){
                $name=$1;
        } elsif ($from=~/^From:\s+([^\s]+)/){
                $name=$1;
        } else {
                # Error
                next;
        }
        if($name=~/^[^@]+@([^\.]+)/){
                $folder=lc($1);
        } else {
                # Error
                next;
        }
        if($fn=~/[^\/]+\/([^\/]+)$/){
                $filename=$1;
        } else {
                # Error
                next;
        }
        system("mkdir -p ~/Maildir/.$folder/{cur,new,tmp}");
        system("mv $fn ~/Maildir/.$folder/cur/$filename");
}
close(FL);