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