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;

うらないの教室、麻雀の教室 (Calture Scool , Skill , Professional )

麻雀

麻雀のカルチャースクールに行ったことはない。

楽しそうだからやってみたいという人が集まる。何人かの真摯なプロ (レッスンプロと競技プロの両方 ) を別にすれば、先生、私賭けてやってみたいんですと問われたらこう答えるだろうえー、仕方ないですねぇ。やりましょうか (ウッシッシ)

世の中には、麻雀教室・麻雀大会で楽しくみんなでやりましょうと謳って、その実賭け麻雀いっしょにしようよ。でもいくら負けそうか見当はつくけれど教えないよという主催者が多い。

いっとき信頼できる仲間と抗議活動に燃えたり、対抗して本当に賭けごとはしないという大会を企画したりしていた。

いや、賞金は出しました。スタッフの人件費がないので、場所代を引いた残りで廉価でも充分に楽しめる賞金の額になります

うらない

うらないのカルチャースクールに、茶話会のつもりで顔を出したことがある。

なぜ占い師になりたいという人が多いのかと思っていた。麻雀のプロと違い妙に敷居が低い。

あれはいっしょに麻雀打とうと同じでコミュニケーションとして知らない人と占いで出会いたいということか。

はっきりいって、そんな気持ちで占い師になった相手に相談するほうが災難だ。

うらない -その2-

なぜ、麻雀のカルチャースクールはあなたも麻雀のプロになれますと謳わないのに、うらないのカルチャースクールはあなたもうらないのプロになれますと謳うのか。

そんなうらないの講師に限って、うらないは人助け、カウンセリングです。カウンセリングから技法を学びましょうという。

カウンセリングの学校は、カウンセリングの技法をあなたの日頃の生活・人間関係に役立てます、と謳う。プロへの道は上級コースであり、厳しい道なのをきちんと区別している。

カウンセリングが資格として認定されたのは、つい最近だ。それ以前からのハナシ。

技能と職業

別件だが。

プログラムが書けるようになりたいからSEになりたい、自分の運勢を知りたいから占い師になりたい、という人も多い。

野球がうまくなりたいからプロ野球選手になりたい、という人はいない。

女にモテたいからホストになる…… いる。

麻雀が強くなりたいからプロになりたい、人付き合いが下手だから水商売をしたい…… それ若かりし日の私。

おかげで、水商売が長いと人付き合いがうまくなるのではなく、人付き合いがうまい人だけが淘汰され残るのだと思い知らされた。

また、本人たちは当然の技能と思っているから 長くやっていれば、誰でもできるようになるよ という。本心からの言葉なので、騙される人はあとを断たない。