リハビリをかねて、mixi で送受信したメール (メッセージ) をローカルのMaildir に保存するスクリプトを書いてみました。
Web::Scraper おもしろい。私が Perl から離れ始めたころにできたモジュールなので知りませんでした。
一年近く前、同様のことをより低レベルのライブラリ HTML::TreeBuilder からスクラッチで書き起こしたら、オブジェクトがスコープを離れて解放されているのに、循環構造ゆえにメモリが開放されずに (いわゆる メモリリーク
) 難儀してほうったらかしなのできわめて興味深いです。解析する時間、取れるかな。
- ページ取得エラー時のリトライ
- ライブラリの名前と置くパスがええ加減
- メールアドレス・パスワードを設定ファイルから読み込む
#!/usr/bin/env perl # # $Id: fetchMixi,v 1.3 2010/07/07 10:08:11 yaemon Exp $ # use strict; use warnings; use FileHandle; use WWW::Mixi::Scraper;
use lib( "/home/yaemon/lib/perl" ); use MixiToRFC2822 qw(message uniqueName);
sub checkMaildir(); sub getMessage( $$ );
my $mixi = WWW::Mixi::Scraper->new( 'email' => 'MyAddress' , 'password' => 'MyPassword' , );
my $maildir = $ENV{ 'HOME' } . "/Maildir/mixi/"; checkMaildir(); getMessage( $mixi , "inbox"); getMessage( $mixi , "outbox" );
sub checkMaildir() { 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 $box = shift;
my $page = 1;
while ( 1 ) { my @mailInPage = $account->parse( "/list_message.pl?page=$page&box=$box" ); if ( @mailInPage < 1 ) { return; } printf STDERR "%s : $box: Page:%03d fetch\n" , my $datestr = localtime() , $page ; $page++; foreach my $mbox ( @mailInPage ) { foreach my $message ( $account->parse( $mbox->{ 'link' } ) ) { my $rfc2822 = MixiToRFC2822->new( $message , $box );
if ( -f "$maildir/new/" . $rfc2822->uniqueName() || glob( "$maildir/cur/" . $rfc2822->uniqueName() . ":*" ) ) { return; } my $out = new FileHandle( "> $maildir/new/" . $rfc2822->uniqueName() ); if ( ! defined( $out )) { die "Can't open messagefile:$!"; } $out->print( $rfc2822->message() ); } } } }
#!/usr/bin/env perl # # $Id: MixiToRFC2822.pm,v 1.3 2010/07/07 10:08:29 yaemon Exp $ # package MixiToRFC2822; 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 = "( MyName ) <MyIDNo.\@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'} ), '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 ); } 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.MixiToRFC822" );
return $self->{ '_uniqueName' }; }
sub messageFrom($) { my $self = shift; return $self->{ '_from' } if exists $self->{ '_from' }; my $tmp = $self->{ '_message' }->{ 'link' }->as_string(); $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;
