Plaggerで列車運行情報を取得（その後2）－ 2chdat_m.pm

続きは、2chdat_m.pmについて。
オリジナルは取得したフィードを1つのスレッドとし、各エントリーをレスとして出力している。
subject.txtには1つのスレッドしか登録されておらず、そのタイトルはCustomFeedで指定したものである。
2chブラウザでは板を開くとsubject.txtに記載されたスレッド一覧が表示されるが、それが1つしかなく、しかも自分が設定したものを毎回見ることになる。
見たい情報があるかどうかは、subject.txtに記載されているdatを取得するまではわからない。
PCならば回線も処理速度も速いのでたいした問題ではないが、モバイルだとけっこうイラつく。（ウィルコムだからか？）

そこで、subject.txtにはフィードタイトルと各エントリーのタイトルを全て出力するようにした。
このようにすることで、板を開いたときに何が登録されているかすぐにわかるようになった。
その中から詳細な情報が知りたいもののみレスを取得すれば良い。
現状はテストも兼ねて、フィードのタイトルのスレッドには各エントリーのタイトルと本文を全て出力している。

フィードタイトルのdatはPlaggerが勝手にファイル名をつけてくれたが、各エントリーのdatはid_safeが重複するものがあるらしく消えてしまう。（そもそもid_safeが何なのかがよくわかっていないorz）
仕方なく各エントリーのタイトルをMIMEでエンコードし、Windowsで使えない文字を消した上でファイル名とした。
また、オリジナルと違って各エントリーもスレッドとしてdatファイルを持つことになるので、ファイルが際限なく増殖してしまう。
これはcronでファイルの削除を毎日実行することで対処した。

以下、変更後のコード。

package Plagger::Plugin::Publish::2chdat_m;
use utf8;
use strict;
use base qw( Plagger::Plugin );
 
use Encode;
use File::Spec;
use MIME::Base64;
 
sub register {
    my($self, $context) = @_;
    $context->register_hook(
        $self,
        'publish.feed' => \&feed,
    );
}
 
sub init {
    my $self = shift;
    $self->SUPER::init(@_);
 
    my $dir = $self->conf->{dir};
    unless (-e $dir && -d _) {
        mkdir $dir, 0755 or Plagger->context->error("$dir: $!");
        mkdir File::Spec->catfile($dir, 'dat'), 0755 or Plagger->context->error("$dir/dat: $!");
    }
}
 
sub feed {
    my($self, $context, $args) = @_;
 
    my $feed = $args->{feed};
    my $out_s = File::Spec->catfile($self->conf->{dir}, 'subject.txt');
    my $out_fd = File::Spec->catfile($self->conf->{dir}, 'dat', $feed->id_safe.".dat");
    $context->log(info => "Writing dat output to $out_fd");
    open my $fh_s, ">:encoding(shift_jis)", $out_s or $context->erorr("$out_s: $!");
    open my $fh_fd, ">:encoding(shift_jis)", $out_fd or $context->error("$out_fd: $!");
 
    if ($feed->count != 0) {
            printf $fh_fd "%s<><>%s ID:%s<> ",
                $feed->title,
                $self->format_date(Plagger::Date->now()),
                substr($feed->id_safe, 0, 8);
            printf $fh_fd $feed->description."<br>";
            for my $entry ($feed->entries) {
                printf $fh_fd "%s", 
                    "<br>"."<b>".$entry->title."</b><br>".$self->format_body($entry->body)."<br>";
            }
            printf $fh_fd " <>\n";
            close $fh_fd;
 
            printf $fh_s "%s.dat<>%s (1)\n",
                $feed->id_safe,
                $feed->title;
 
        for my $entry ($feed->entries) {
            my $out_e = File::Spec->catfile($self->conf->{dir}, 'dat', $self->format_title($entry->title).".dat");
            $context->log(info => "Writing dat output to $out_e");
            open my $fh_e, ">:encoding(shift_jis)", $out_e or $context->error("$out_e: $!");
 
            printf $fh_e "%s<><>%s ID:%s<> %s\n",
                $entry->title,
                $self->format_date($entry->date || Plagger::Date->now()),
                substr($entry->id_safe, 0, 8),
                $self->format_body($entry->body)." <>";
            close $fh_e;
 
            printf $fh_s "%s.dat<>%s (1)\n",
                $self->format_title($entry->title),
                $entry->title;
        }
            close $fh_s;
 
    } else {
            printf $fh_fd "No Info<><>%s ID:00000000<> No Info\n",
                $self->format_date(Plagger::Date->now());
            close $fh_fd;
 
            printf $fh_s "%s.dat<>%s (1)\n",
                $feed->id_safe,
                $feed->title;
            close $fh_s;
    }
}
 
sub format_date {
    my($self, $date) = @_;
    my $clone = $date->clone;
    $clone->set_locale("ja_JP");
    return $clone->strftime("%m/%d(%a) %H:%M");
}
 
sub format_title {
    my($self, $title) = @_;
    my $title_f = encode_base64($title);
    $title_f =~ tr/\r?\n?//d;
#   Windowsでファイル名にできない文字（|\/<>,:;?"*）を削除
    $title_f =~ s/\||\\|\/|\<|\>|\,|\:|\;|\?|\"|\*//g;
    $title_f;
}
 
sub format_body {
    my($self, $body) = @_;
 
    # replace images
    $body =~ s!<img .*?src="(.*?)".*?>!$1!ig;
 
    # ad-hoc replacement of A links
    $body =~ s{<a .*?href="(.*?)".*?>(.*?)</a>}
              {my($url, $label) = ($1, $2);
               $label =~ m!^https?://! ? $url : "$label ($url)"}ieg;
 
    # respect newline in <pre> tags
    $body =~ s{(<pre>)(.*?)(</pre>)}{$1 . nl2br($2) . $3}seig;
 
    # other than that, nuke newlines
    $body =~ tr/\r\n//d;
 
    # <> is a separator
    $body =~ s/<>/&lt;&gt;/g;
 
    $body;
}
 
sub nl2br {
    my $str = shift;
    $str =~ s/\r?\n/<BR>/g;
    $str;
}
 
1;

変更後はこのように表示されている。
左側がsubject.txtを読み込んだところ。右側がフィードタイトルのレスを取得したところ。