Perl で iPod で RSS で news junkie

最近 PCサイトが読める携帯を買ったんだけど、どうもスクロールの機能がよろしくなくってニュースサイトを読む気になりません。パケット代も高いし。

というわけでニュースサイトを iPod で読みたくなったのですが、僕の持っている iPod photo の Notes ディレクトリは UTF-8 か ASCII のテキストしか読み出せないらしく(しかも UTF-8 には XMLタグが必要)、Windows 用の iPod 管理ソフトではうまくいきません。

と言うわけで自作しました。とりあえず asahi.com だけ。

% cat ./parse_asahi.pl
#!/cygdrive/c/Perl/bin/perl
#
#!/usr/bin/perl

use strict;
use warnings;
use Encode qw /decode/;
use Encode::Guess qw /euc-jp shiftjis 7bit-jis/;
use LWP::Simple;
use XML::RSS;
use HTML::TokeParser;
use iPod::Notes;

use constant URL_ASAHI => 'http://bulknews.net/rss/rdf.cgi?Asahi';

our $DOCPATH = 'Asahi';
our $INDEX   = decode("euc-jp", '■');

my $content = get(URL_ASAHI);
die "cannot get content\n" unless defined $content;

my $rss = XML::RSS->new;
$rss->parse($content);

my $i = 1;
my $index;
foreach my $item ( @{ $rss->{items} } ) {

        my $article_num    = sprintf "%03d", $i;
        my $link_content   = get($item->{link});
        my $parsed_content = parse_asahi($link_content);
        next unless $parsed_content;

        my $note = iPod::Notes->new(
                Title   => $article_num,
                Docpath => $DOCPATH,
                Content => $parsed_content,
        );
        $note->write;

        $index .= sprintf "<A HREF=\"%s/%03d\">%s</A>%s\n",
                $DOCPATH,
                $i++,
                $INDEX,
                $item->{title};
}

my $note = iPod::Notes->new(
        Title    => $rss->{channel}->{title},
        Linkpath => $DOCPATH,
        Content  => $index,
);
$note->write;

######################################################################
# Sub Routine
######################################################################

sub parse_asahi {
        my $content = shift;

        my $parser = HTML::TokeParser->new( \$content );

        # ignore JavaScript alert
        $parser->get_tag('p');

        my $text;
        while( $parser->get_tag('p') ) {
                $text .= $parser->get_trimmed_text or next;
        }

        my $decoder = Encode::Guess->guess($text);
        die $decoder unless ref($decoder);
        my $utf8 = $decoder->decode($text);

        return $utf8;
}

と module iPod::Notes

% cat ./Notes.pm
package iPod::Notes;

=pod

iPod::Notes - new and write !!

=cut

use strict;
use warnings;
use Config;
use Encode qw /decode/;
use Encode::Guess qw /euc-jp shiftjis 7bit-jis/;
use FileHandle;
use File::Spec;
use File::Path;
use File::Temp qw /tempfile/;

use constant {
        DIVIDE     => 4096,
        XML_HEADER => '<?xml encoding="UTF-8"?>',
        NEXT       => 'next',
};

our $IPOD_DRIVE = 'f';
our @NOTES_PATH;
if($Config{osname} eq 'MSWin32') {
        @NOTES_PATH = ('Notes');
}else{
#       @NOTES_PATH = ('home', 'someone', 'text');
        @NOTES_PATH = ('cygdrive', $IPOD_DRIVE, 'iPod', 'Notes');
}

sub new {
        my($class, %args) = @_;

        my $self = {
                title    => $args{Title}    || undef,
                docpath  => $args{Docpath}  || undef,
                content  => $args{Content}  || undef,
                count    => 1,
        };

        bless $self, $class;
}

sub write {
        my $self = shift;

        $self->_generate_tag($self->{title});
        my $fh = new FileHandle;
        $self->_open_write_header($fh);

        my $size;
        foreach my $letter (split //, $self->{content}) {
                $fh->print($letter);
                $size = ($fh->stat)[7];
                if($size >= $self->{dividesize} ) {
                        $fh->print($self->{utf8next});
                        $size = ($fh->stat)[7];
                        print STDERR "$self->{filepath} size = $size bytes\n";
                        $fh->close;

                        $self->_generate_tag($self->{title});
                        $self->_open_write_header($fh);
                }
        }
        print STDERR "$self->{filepath} size = $size bytes\n";
}

######################################################################
# Method
######################################################################
sub _open_write_header {
        my $self     = shift;
        my $fh       = shift;

        $fh->open("> $self->{filepath}") or
                die "cannot open file : $self->{filepath} : $!\n";
        binmode $fh, ':utf8';
        $fh->autoflush(1);
        $fh->print($self->{utf8header}, $self->{utf8title});
}

sub _generate_tag {
        my $self       = shift;
        my $file_title = shift;

        my $filename;
        my $title;
        if($self->{count} == 1) {
                $filename = $file_title;
                $title    =  "<TITLE>$file_title</TITLE>\n";
        }else{
                $filename = sprintf "%s.%04d",
                        $file_title, $self->{count};
                $title  = sprintf "<TITLE>%s.%04d</TITLE>\n",
                        $file_title, $self->{count};
        }

        $self->_get_filepath($filename);

        my $header = sprintf "%s\n", XML_HEADER;
        my $next   = sprintf "<A HREF=\"%s.%04d\">%s</A>\n",
                $file_title, ++$self->{count}, NEXT;

        unless(defined $self->{dividesize}) {
                $self->_get_dividesize($next);
        }

        $self->{utf8title}  = decode("Guess", $title);
        $self->{utf8header} = decode("Guess", $header);
        $self->{utf8next}   = decode("Guess", $next);
}

sub _get_filepath {
        my $self     = shift;
        my $filename = shift;

        my $rootdir;
        if($Config{osname} eq 'MSWin32') {
                chdir($IPOD_DRIVE . ':') or
                        die "cannot access iPod volume\n";
                $rootdir = File::Spec->rel2abs;
        }else{
                $rootdir = File::Spec->rootdir();
        }

        my $filepath;
        if(exists $self->{docpath}) {
                my $dirpath = $rootdir .
                        File::Spec->catfile(@NOTES_PATH, $self->{docpath});
                unless(-d $dirpath) {
                        eval { mkpath($dirpath) };
                        if($@) {
                                die "cannot mkdir $dirpath : $!\n";
                        }
                }

                $filepath = File::Spec->catfile(@NOTES_PATH,
                        $self->{docpath}, $filename);
        }else{
                $filepath = File::Spec->catfile(@NOTES_PATH, $filename);
        }
        $self->{filepath} = $rootdir . $filepath;
}

sub _get_dividesize {
        my $self = shift;
        my $next = shift;

        my $fh = tempfile;
        $fh->print($next);
        $fh->flush;
        my $nextsize = ($fh->stat)[7];
        $self->{dividesize} = DIVIDE - $nextsize - 3;
}

1;

実行するとこんな感じになります。4096 Bytes が Notes の上限なのでそれを超える記事は分割されます。

% ./parse_asahi.pl
F:\Notes\Asahi\001 size = 2200 bytes
F:\Notes\Asahi\002 size = 4095 bytes
F:\Notes\Asahi\002.0002 size = 756 bytes
F:\Notes\Asahi\003 size = 853 bytes
F:\Notes\Asahi\004 size = 2143 bytes
F:\Notes\Asahi\005 size = 415 bytes
F:\Notes\Asahi\006 size = 376 bytes
F:\Notes\Asahi\007 size = 4095 bytes
F:\Notes\Asahi\007.0002 size = 534 bytes
F:\Notes\Asahi\008 size = 382 bytes
F:\Notes\Asahi\009 size = 643 bytes
F:\Notes\Asahi\010 size = 754 bytes
F:\Notes\Asahi\011 size = 832 bytes
F:\Notes\Asahi\012 size = 586 bytes
F:\Notes\Asahi\013 size = 1531 bytes
F:\Notes\Asahi\014 size = 1657 bytes
F:\Notes\Asahi\015 size = 4095 bytes
F:\Notes\Asahi\015.0002 size = 543 bytes
F:\Notes\asahi.com size = 1348 bytes

cygwin の shell から ActivePerl のスクリプトを呼び出す、というわかりにくい環境で実行しています。どうも cygwin の Perl にうまいこと module がインストールできなくて、面倒だったので ActivePerl でやってしまいました。Unix でも問題なく動くと思います。shebang は変える必要ありますけど。

ASAHI.com の日本語解析に失敗すると die するようになっているのですが、いままで死んだことないです。

module に iPod のドライブ名が書いてあったり、module のなかでディレクトリ作ったりとか、あんまりしたくなかったりもしたのですが、とりあえず動くのでいいってことにしてます。

おんなじ実行環境の人がどれくらいるのかが疑問だ。

Windows で mount した iPod のドライブに autoflush でファイル書き込むとディスクに負荷かけたりするんですかね？なんとなく tmp に書いて mv した方が良い気がする...。