日常を進める気力が沸かずに眠ってばかりいたので、全力で現実逃避してみた。
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;
}
