Becky! の振り分けルールと振り分け先フォルダを自動作成する

新規に業務用 PC をセットアップするにして、なによりもメンドいのがメールの振り分けルールの作成です。
PC が壊れている 4 日間の間メール受信できず、久しぶりに受信するとメールが 2 万通ほどやってきた。人力でなんとかできるレベルじゃない。

そういうわけなので、メールソフト Becky! のメール振り分けルールと振り分け先フォルダを生成する書き捨てスクリプトを即興で作った。Becky! は IFilter.def というファイルでフィルタルールを設定するので、そこにガンガンルールを追記する。

#!/usr/bin/perl
# -*- cperl -*-
use strict;
use warnings;
use File::Find::Rule;
use List::MoreUtils 'uniq';
use File::Copy 'copy';
use File::Basename 'basename';

# Becky の受信ディレクトリ
my $BECKY_DIR = '/cygdrive/c/Becky!/y-kiri/4bc550ea.mb';
# 振り分けルールを記述したファイル
my $IFILTER = '/cygdrive/c/Becky!/y-kiri/4bc550ea.mb/IFilter.def';
my $PROFILE = basename $BECKY_DIR;

die "incorrect path for inbox directory" if not (-e $BECKY_DIR and -d _);
die "incorrect path for ifilter.def" if not (-e $IFILTER and -f _);

backup( $IFILTER );
my @rules = rules( "$BECKY_DIR/!!!!Inbox" );
append_rule( $IFILTER => @rules );


sub rules {
    my $inbox = shift;
    my @files = File::Find::Rule->file()
                                ->maxdepth( 1 )
                                ->name( '*.bmf' )
                                ->in( $inbox );
    my @rules = grep { /SUPPORT/ } uniq map {
        my @subjects;
        open my $fh, '<', $_;
        while( <$fh> ) {
            next unless /^Subject: (\[[^\d]+)/;
            push @subjects, $1;
        }
        @subjects;
    } @files;

    return @rules;
}

sub backup {
    my $filter = shift;
    copy( $filter, $filter . ".orig" )
        or die "cannot backup $filter: $!\n";
}

sub append_rule {
    my ($filter, @rules) = @_;

    open my $fh, '>>', $filter
        or die "cannot open $filter: $!\n";

    for my $rule (@rules) {
        my ($proj) = $rule =~ /([-\w]+)-SUPPORT/;
        my $projdir = "$BECKY_DIR/!!!!inbox/Project/$proj";
        unless ( -e $projdir ) {
            mkdir $projdir or die "mkdir $projdir: $!\n";
        }
        
       print {$fh} <<RULE;
:Begin ""
!M:$PROFILE\\!!!!Inbox\\Project\\$proj\\
\@0:Subject:$rule O IT
\$O:Sort=1
:End ""
RULE
    }
}