une autre: 全力で

日常を進める気力が沸かずに眠ってばかりいたので、全力で現実逃避してみた。

mutt のソースの最新を取ってきて自力コンパイルしたり、MakeWorld してみたり、ふた月ほど離れていた mixi のコミュニティの話題に追いつくため、トピックの記事一括ダウンロードのスクリプト書いたり。

見るトピックがわかっていれば、スクリプト書かなくてもブラウザから全記事を見れば良い、正しい。単に頭の体操としてスクリプト書いて遊んでいただけだ。

単に遊んでいるだけ。

mutt のコンパイル手順

もし hg コマンドが使えないならば mercurial をインストール
$ hg clone hg clone http://dev.mutt.org/hg/mutt workdir
$ cd workdir ; ./prepare configureOptions
$ make && sudo make install

私が configure オプションスを与えるのに使ったスクリプト

./prepare \
--prefix=/usr/develop \
--enable-pgp \
--disable-pop \
--enable-imap \
--enable-smtp \
--enable-debug \
--enable-inodesort \
--disable-nfs-fix \
--disable-mailtool \
--enable-locales-fix \
--enable-exact-address \
--enable-hcache --with-gdbm --without-bdb --with-tokyocabinet \
--enable-iconv \
--with-regex \
--with-ssl=/usr \
--with-gnutls=/usr/local \
--with-sasl=/usr/local \
--with-idn=/usr/local \

インストール先が /usr/develop てのは相当苦しいが、/usr/local に入れた ports からの安定 version と別にしたかった

ports の版と違い、データベースファイルに tokyocabinet は使えないので、じつはこれを動かすと警告が出る。

GNU make でなく、BSD に元からある make が使えたのはうれしかった。気分の問題でしかないが。

いまはこんな設定を加えた。

yaemon@bouon-an$ alias muttd
alias muttd='/usr/develop/bin/mutt -F /home/yaemon/dotfiles/.muttrc-develop  -d 1'
yaemon@bouon-an$ diff ~/dotfiles/.muttrc{,-develop}
21,21
< set smtp_pass=Secret
---
> # 送信パスワードは、本家の版では保存されない。コメントアウトしておいて毎回入力
25a25,28
>
> set header_cache=/home/yaemon/var/mutt/CachesGDB/header
> set message_cachedir=/home/yaemon/var/mutt/CachesGDB/body
> set pager=

fetchMixiBBS

車輪の再発明とかいわない。運動をしたら汗をかくようなもので、全力で現実逃避したら成果ができる。それだけ。

Objective でない考え方でスクリプトが設計できないってだけのバカです。

$ cat ~/bin/fetchMixiBBS
#!/usr/bin/env perl
#
#       $Id: fetchMixiBBS,v 1.1 2010/08/29 00:16:11 yaemon Exp $
#
use strict;
use warnings;
use FileHandle;
use WWW::Mixi::Scraper;

use lib( "/home/yaemon/lib/perl" );
use MixiToRFC2822::BBSWrapper qw( id subject pop );

sub checkMaildir($);
sub getMessage( $$ );

my $mixi = WWW::Mixi::Scraper->new(
    'email' => 'EmailAddressForLogin' ,
    'password' => 'PasswordForMixi' ,
);

my $storeDir = $ENV{ 'HOME' } . "/Maildir/mixi/";
checkMaildir( $storeDir );



my $list = new FileHandle( "< $ARGV[0]" );
if ( ! defined( $list ) )
{
    die "Can't open $ARGV[0]:$!";
}

while( my $line = $list->getline )
{
    chomp( $line);
    $line =~ s/#.*//;
    if ( $line !~ /^[0-9]+$/ )
    {
        next;
    }

    getMessage( $mixi , $line);
}

sub checkMaildir( $ )
{
    my $maildir = shift;
    if ( ! -d $maildir )
    {
        mkdir( $maildir ) or die "Can't mkdir $maildir:$!";
    }
    if ( ! -d "$maildir/new" )
    {
        mkdir( "$maildir/new" ) or die "Can't mkdir $maildir/new:$!";
        mkdir( "$maildir/cur" ) or die "Can't mkdir $maildir/cur:$!";
        mkdir( "$maildir/tmp" ) or die "Can't mkdir $maildir/tmp:$!";
    }
}

sub getMessage( $$ )
{
    my $account = shift;
    my $bbs     = shift;

    my $all = $account->parse( "/view_bbs.pl?id=$bbs&page=all" );
    if ( defined ( $all ) )
    {
        printf STDERR "%s: %s fetch success\n" , my $datestr = localtime() , $bbs ;
    }
    else
    {
        die( "Can't get $bbs. retry not implimented" );
    }
    my $board = MixiToRFC2822::BBSWrapper->new( $all );
    my $dir = $storeDir . "/" . 
        $board ->community->id() . '-' . $board->community()->name();

    checkMaildir( $dir );

    while( my $comment = $board->pop() )
    {
        if ( -f $dir . "/new/" . $comment->uniqueName() || 
             glob( $dir . "/cur/" . $comment->uniqueName() . '*' ) )
        {
            return;
        }

        my $out = new FileHandle( "> $dir/new/" . $comment->uniqueName() );
        if ( ! defined( $out ))
        {
            die "Can't open messagefile:$!";
        }
        $out->print(  $comment->message() );
    }
}

$ ls ~/lib/perl/MixiToRFC2822
BBSWrapper.pm
CVS/
Community.pm
Message.pm

$ cat ~/lib/perl/BBSWrapper.pm
#!/usr/bin/env perl
#
#   $Id: BBSWrapper.pm,v 1.1 2010/08/29 00:17:16 yaemon Exp $
#
package MixiToRFC2822::BBSWrapper;
use strict;
use warnings;

use Carp;
use Exporter;
use lib( "/home/yaemon/lib/perl");
use MixiToRFC2822::Community;
use MixiToRFC2822::Message;

use vars qw( $VERSION @ISA @EXPORT_OK );
sub id($);
sub subject($);
sub child($);
sub root($);



our $VERSION = "0.01";
@ISA = qw( Exporter);
@EXPORT_OK = qw( id subject commuity pop);



sub new($$)
{
    my $self = bless {} , shift;
    $self->{ '_data' } = shift;
    return $self;
}

sub id($)
{
    my $self = shift;
    return $self->{ '_id' } if exists $self->{ '_id' } ;
    my @tmp = grep( /^id=/ ,  split( /[\&\?]/ , $self->{'_data'}->{'link'}->opaque ));
    if ( @tmp != 1 ) { die "Can't parse " . $self->{'_data'}->{ '_link' } }
    $self->{'_id'} = $tmp[0];
    $self->{'_id'} =~ s/^id=//;
    return $self->{'_id'};
}

sub community($)
{
    my $self = shift;
    return $self->{'_community'} if exists $self->{ '_community'};

    $self->{'_community'} = MixiToRFC2822::Community->new( $self->{'_data'}->{'community'} );
}

sub subject($)
{
    my $self = shift;
    return $self->{'_data'}->{'subject'};
}

sub root($)
{
    my $self = shift;
    return $self->{ '_root' } if exists $self->{ '_root' } ;
    my $message;
    $message->{'subject'} = $self->subject();
    $message->{'name_link'} = $self->{'_data'}->{'name_link'};
    $message->{'name'} = $self->{'_data'}->{'name'};
    $message->{'time'} = $self->{'_data'}->{'time'};
    $message->{'description'} = $self->{'_data'}->{'description'};
    $message->{'to'} =  $self->community();
    $self->{'_root'} = MixiToRFC2822::Message->new( $message , 'bbs' );
}



sub pop($)
{
    my $self = shift;
    return undef if  exists $self->{'_end'} ;
    my $message = pop( @{ $self->{_data}->{comments}} );
    if ( ! defined( $message ) )
    {
        $self->{'_end'} = 1;
        return $self->root();
    }
    $message->{'reply_to'} = "<" . $self->root()->uniqueName() . ">";
    $message->{'subject'} = "Re: " . $self->subject();
    $message->{'to'} =  $self->community();

    return MixiToRFC2822::Message->new( $message , 'bbs' );
}
1;

$ cat ~/lib/perl/Community.pm

#!/usr/bin/env perl
#
#   $Id: Community.pm,v 1.1 2010/08/29 00:17:16 yaemon Exp $
#
package MixiToRFC2822::Community;
use strict;
use warnings;

use Carp;
use Exporter;
use vars qw( $VERSION @ISA @EXPORT_OK );

sub id($);
sub name($);

our $VERSION = "0.01";
@ISA = qw( Exporter);
@EXPORT_OK = qw( id name );


sub new($$)
{
    my $name = shift;
    my $data = shift;
    return bless $data , $name;

}

sub id($)
{
    my $self = shift;
    return $self->{ '_id' } if exists $self->{ '_id' } ;

    $self->{'_id'} = $self->{'link'}->opaque();
    $self->{'_id'} =~ s/.*id=//;

    return $self->{'_id'};
}


sub name($)
{
    return shift->{'name'};
}

1;

$ cat ~/lib/perl/Message.pm
#!/usr/bin/env perl
#
#   MixiToRFC2822.pm      2010-07-07 yaemon
#   $Id: Message.pm,v 1.1 2010/08/29 00:17:16 yaemon Exp $
#
package MixiToRFC2822::Message;
use strict;
use warnings;
use Carp;
use Exporter;
use Mail::Internet;
use Mail::Header;
use Encode qw/encode/;
use DateTime;
use vars qw( $VERSION @ISA @EXPORT_OK );

sub message($);
sub date( $ );
sub uniqueName($);
sub messageFrom($);

our $VERSION = "0.01";
@ISA = qw( Exporter);
@EXPORT_OK = qw( uniqueName message );


sub new($$$)
{
    my $self = bless {} , shift;
    $self->{ '_message' } = shift;
    $self->{ '_kind' } = shift;

    return $self;
}

sub message($)
{
    my $self = shift;
    return $self->{ '_mailFormat' }->as_string() if exists $self->{ '_mailFormat' };
    my $myAddr = "( T.Nakagawa )  <23211\@mixi.jp>";
    my $otherAddr = sprintf( "( %s )<%d\@mixi.jp> " , 
            encode( 'MIME-Header' , $self->{ '_message'}->{ 'name' } ) ,
        $self->messageFrom() );
    my $header = Mail::Header->new();
    $header->header_hashref(
        { 
        'Subject' => encode( 'MIME_Header' , $self->{ '_message'}->{'subject'} ),
        'MIME-version' => "1.0" ,
        "Message-Id" => sprintf( "<%s\@mixi.jp>" , $self->uniqueName() ),
        'Content-Type' => 'text/plain; charset=utf-8' ,
        'Date' =>  $self->date->strftime( "%a, %d %b %Y %H:%M:%S %z") ,
    } );

    if ( $self->{ '_kind'} eq "inbox" )
    {
        $header->add( 'From' , $otherAddr );
        $header->add( 'To' , $myAddr );
    }
    elsif ( $self->{ '_kind'} eq "outbox" )
    {
        $header->add( 'To' , $otherAddr );
        $header->add( 'From' , $myAddr );
    }
    elsif ( $self->{ '_kind' } eq "bbs" )
    {
        $header->add( 'From' , $otherAddr );
        $header->add( 'To' , sprintf( "( %s )<%s%%community\@mixi.jp>" ,
                encode( 'MIME-Header' , 
                    $self->{'_message'}->{'to'}->name() ) ,
                    $self->{'_message'}->{'to'}->id() ) );
        if ( exists( $self->{'_message'}->{'reply_to'} ) )
        {
            $header->add( 'In-Reply-To' , $self->{'_message'}->{'reply_to'} );
        }
    }
    else
    {
        die "Not implementd messagebox:$self->{'_kind'}";
    }


    my $body = encode( 'utf-8' , $self->{ '_message' }->{ 'description'} );
    $body =~ s/&#(\d+);/pack("W" , $1)/meg;

    $self->{ '_mailFormat' } = Mail::Internet->new(
        'Body' => [ map { "$_\r\n"; } split( "<br />" , $body ) ],
        'Header' => $header,
    );

    return $self->{ '_mailFormat' }->as_string();
}


sub uniqueName($)
{
    my $self = shift;
    return $self->{ '_uniqueName' } if exists $self->{ '_uniqueName' } ;
    $self->{ '_uniqueName' } = sprintf( "%d.%s.%s" ,
        $self->date()->epoch() ,
        $self->messageFrom() ,
        "mixi.MixiToRFC2822"
    );

    return $self->{ '_uniqueName' };
}


sub messageFrom($)
{
    my $self = shift;
    return $self->{ '_from' } if exists $self->{ '_from' };
    my $tmp;
    if ( $self->{'_kind'} =~ /box$/ )
    {
        $tmp = $self->{ '_message' }->{ 'link' }->opaque(),
    }
    else
    {
        $tmp = $self->{ '_message' }->{ 'name_link'}->opaque();
    }
    $tmp =~ /id=([0-9]+)/;
    $self->{ '_from' } = $1;
    return $self->{ '_from' };
}
sub date( $ )
{
    my $self = shift;

    return $self->{ '_date'} if exists $self->{ '_date' };


    my @date = split( /[\- :]/ , $self->{ '_message' }->{ 'time' } );

    $self->{ '_date' }  = DateTime->new( 
        "year"  => $date[0] ,
        "month" => $date[1] ,
        "day"   => $date[2] ,
        "hour"  => $date[3] ,
        "minute"    => $date[4] ,
        "second"    => 1 ,
        time_zone   => 'Asia/Tokyo' ,
    );


    $self->{ '_date' };
}


1;

yaemon@bouon-an$  /usr/local/lib/perl5/site_perl/5.12.1/WWW/Mixi/Scraper/Plugin/ViewBBS.pm{.orig,} 
*** /usr/local/lib/perl5/site_perl/5.12.1/WWW/Mixi/Scraper/Plugin/ViewBBS.pm.orig        Sun Aug 29 13:45:12 2010
--- /usr/local/lib/perl5/site_perl/5.12.1/WWW/Mixi/Scraper/Plugin/ViewBBS.pm    Sun Aug 29 06:22:10 2010
***************
*** 36,42 ****
        description => $self->html_or_text;
      process 'dd.bbsContent>dl>dd>div.communityPhoto>table>tr>td',
        'images[]' => $scraper{images};
!     result qw( time subject description name name_link images link );
 };

    # bbs topic is not an array
--- 36,46 ----
        description => $self->html_or_text;
      process 'dd.bbsContent>dl>dd>div.communityPhoto>table>tr>td',
        'images[]' => $scraper{images};
! 
!       process 'p.utilityLinks03>a',
!         _community_name => 'TEXT',
!         _community_link => '@href';
!         result qw( time subject description name name_link images link _community_name _community_link);
 };

    # bbs topic is not an array
***************
*** 84,89 ****
--- 88,103 ----
    }
 $stash->{comments} = \@comments;

+ 
+   $stash->{_community_name} =~ s/.*\[//;
+   $stash->{_community_name} =~ s/\].*//;
+ 
+   $stash->{community}->{name} = $stash->{_community_name};
+   $stash->{community}->{link} = $stash->{_community_link};
+ 
+   undef $stash->{_community_name};
+   undef $stash->{_community_link};
+
 return $stash;
  }

une autre

BookmarkThis

自己紹介

ブログアーカイブ

フォロワー

ページ

2010年8月29日

全力で

mutt のコンパイル手順

fetchMixiBBS

0 コメント:

コメントを投稿

une autre

BookmarkThis

自己紹介

ブログ アーカイブ

フォロワー

ページ

2010年8月29日

全力で

mutt のコンパイル手順

fetchMixiBBS

0 コメント:

コメントを投稿

ブログアーカイブ