2010年8月29日

全力で

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

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

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

単に遊んでいるだけ。

mutt のコンパイル手順

  1. もし hg コマンドが使えないならば mercurial をインストール
  2. $ hg clone hg clone http://dev.mutt.org/hg/mutt workdir
  3. $ cd workdir ; ./prepare configureOptions
  4. $ 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; }

0 コメント:

コメントを投稿