fetchMixi (Message)

リハビリをかねて、mixi で送受信したメール (メッセージ) をローカルのMaildir に保存するスクリプトを書いてみました。

Web::Scraper おもしろい。私が Perl から離れ始めたころにできたモジュールなので知りませんでした。

一年近く前、同様のことをより低レベルのライブラリ HTML::TreeBuilder からスクラッチで書き起こしたら、オブジェクトがスコープを離れて解放されているのに、循環構造ゆえにメモリが開放されずに (いわゆる メモリリーク ) 難儀してほうったらかしなのできわめて興味深いです。解析する時間、取れるかな。

1. ページ取得エラー時のリトライ
2. ライブラリの名前と置くパスがええ加減
3. メールアドレス・パスワードを設定ファイルから読み込む

#!/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;