TSperl 発言

極悪です。

藤岡和夫 さんの [TSperl:103] Re: MLの内容を個人のホームページに から
>　見せていただきましたが、私は特に問題ないと思いますけど。

ありがとうございます。



以下はおまけで、今回データの切り出しのために書いたスクリプト。
ヘッダ部分と本文部分の間を行き来するステートマシンになってます。
\x2E がメール一件一件の境界になっていて、分解して一件一ファイル
に保存します。

--^hoge.pl
use Jcode;
use MIME::Words qw(:all);
use strict;

my(%id,%tree,%title);
my($date,$from,$re_id,$id,$mailer,$subject,$body,$no);
my $statemach   = q(header);
my $quot        = qq(\n----\nこのページはメーリングリスト TSnet/TSperl の内容を極悪が転載したものです。);

while(<>){
    if($statemach eq q(header)){
        $_  = decode_mimewords($_);

        if(m/^Date: (.+)$/){            $date   = $1;   next    }
        if(m/^From: (.+)$/){            $from   = $1;   next    }
        if(m/^In-Reply-To: <(.+)>$/){   $re_id  = $1;   next    }
        if(m/^X-Mailer: (.+)$/){        $mailer = $1;   next    }
        if(m/^Message-Id: <(.+)>$/){    $id     = $1;   next    }
        if(m/^From: (.+)$/){            $from   = $1;   next;   }
        
        if(m/^Subject: (\[TSperl:\d+\]) (.+)$/){
            $no         = $1;
            $subject    = $2;
            next;
        }

        if(m/^$/){
            $statemach  = q(body);
            undef $body;
            next;
        }

    }elsif($statemach eq q(body)){

        if(m/^\x2E$/){
            $statemach  = q(header);

            $id{$id}    = $no;
            $title{$id} = qq($no $subject / $from);
            $body       =~ s/^\n+//;
            $body       =~ s/\n+$//;
            1 while($body =~ s/^(>+) >/$1>/mg);

            my $output  = q(http://homepage1.nifty.com/dune/img/tslogo.png)."\x20";
            $output     .= "http://rakunet.org/TSNET/\n";
            $output     .= "subject :$subject\n";
            $output     .= "date    :$date\n";
            $output     .= "from    :$from\n";
            $output     .= "mailer  :$mailer\n";
            if(exists $id{$re_id}){
                $output     .= "reply-to:$id{$re_id}\n";
            }else{
                $output     .= "top-menu:<[TSperl]>\n";
            }
            $output     .= "\n";
            $output     .= "----\n";
            $output     .= "\n";
            $output     .= "$body\n";
            $output     .= "\n\n\n";
            Jcode::convert(\$output,'sjis','jis',"z");
            $output =~ s/([\w\.\-]+)@([\w\.\-]+\.[\w\.\-]+)/$1@... /g;
            
            $no =~ m/\[(.+):(.+)\]/;
            my $file = "TSperl/%5B$1%3A$2%5D.hdb";
            open(FILE,">$file") or die;
            print FILE $output;
            print FILE $quot;
            close FILE;
            
            if($re_id){
                if(exists $tree{$re_id}){
                    $tree{$re_id}   = [@{$tree{$re_id}},$id];
                }else{
                    $tree{$re_id}   = [$id];
                }
            }else{
                if(exists $tree{root}){
                    $tree{root}     = [@{$tree{root}},$id];
                }else{
                    $tree{root}     = [$id];
                }
            }
            
            ($date,$from,$re_id,$id,$mailer,$subject,$body,$no) = ();
            next;
        }

        $body   .= $_;
    }
}

my $output  = q(http://homepage1.nifty.com/dune/img/tslogo.png)."\x20";
$output     .= "http://rakunet.org/TSNET/\n";
sub tree{
    my @list    = @{$_[0]};
    my $level   = " " x $_[1];
    $level      .= " " if 1 < $_[1];
    foreach(@list){
        $output .= "$level$title{$_}\n";
        tree($tree{$_},$_[1]+1) if exists $tree{$_};
    }
}
tree([reverse @{$tree{root}}],1);
Jcode::convert(\$output,'sjis','jis',"z");
$output =~ s/([\w\.\-]+)@([\w\.\-]+\.[\w\.\-]+)/$1@... /g;
my $file = "TSperl/%5BTSperl%5D.hdb";
open(FILE,">$file") or die;
print FILE $output;
print FILE $quot;
close FILE;
--$
-- 
FZH01112@..., http://homepage1.nifty.com/dune/