swk's log / 2006-08-15

2006-08-15 Tue

* pya! filter [tech] 7 users

pya! が大好きだ．でも全部見て回る体力はない．

というわけで，ざっと一覧を眺めて評価の高いものだけ拾い読みしていたりしていたのだけど，いまいち幸せでない．評価の高いものだけ選んでフィードできればいいのになあ．

と思ったので作ってみました．

http://www.kagami.org/pya_filter/p.cgi

pya! の過去ログを 15 ページほど蓄えておいて，リクエストが来ると条件に合致する記事一覧を RSS として吐く．デフォルトの条件は「プラス評価が300以上」．

未読管理のできる RSS リーダで読めば，条件を満たした時点で新着として現れることになります．

pya! のページ構成が変わったらきっと動かなくなるに違いないのは仕様です．というかつまり無断でやってますので，怒られたらさっさと引き上げます．

あとこれ plagger でできると思うので誰かよろしく．

フィルタ条件は，cond パラメータとして渡してやる．空白で区切られた(よってエンコードされた URL 上では + で区切られた) 文字列のリストで，スタックマシンよろしく条件を記述する．たとえば

http://www.kagami.org/pya_filter/p.cgi?cond=$positive+300+ge

で「プラス評価が300以上の記事を抽出」となる．これがデフォルト．他には

http://www.kagami.org/pya_filter/p.cgi?cond=$positive+$negative+minus+500+ge+$over18+not+and

で「プラス評価がマイナス評価に比べて相対500以上で，かつ(18+)でないものを抽出」となる．たぶん．

リストの要素は以下の 3 種類:

整数 ... スタックにその数を push する
変数 ... スタックにその変数の内容を push する
演算子 ... スタックから 2 個，または 1 個の値を pop して，それらに対する演算結果をスタックに push する

これらを順にすべて評価して，最後にスタックのトップに残った値が真だったらその記事はフィードに含める．偽だったら含めない．

変数はとりあえず以下の通り:

$good	「イイ」の数
$ero	「エロいな」の数
$bad	「ハゥ」の数
$positive	$good + $ero
$negative	$bad
$hit	ヒット数
$pu	PU 同意数
$over18	(18+) だったら 1，さもなくば 0

演算子には 2 項演算と 1 項演算がある．2 項演算 op は，pop した値を順に x2, x1 として，x1 op x2 を計算する．op の種類はとりあえず:

ge	>=
gt	>
le	<=
lt	<
eq	==
ne	!=
plus	+
minus	-
and	&&
or	\|\|

1 項演算 op は，pop した値 x に対して op x を計算する．op の種類はとりあえず:

not

出力される RSS の description の部分には「(・∀・)イイ」とかの評価数が表示されます．なので，記事内容に更新があったときに新着記事として扱う RSS リーダを使っている場合は，一度読んだ記事が何度も何度も現れることになります．

例えば bloglines の場合は subscription の設定で Updated Items を ignore するように設定することができて，そうすればこの点は問題にはなりません．そのようなオプション設定のない RSS リーダを使っている場合は，CGI に渡す hide_scores というパラメータを真にすることで， description が空の RSS を吐くようにすることができます:

http://www.kagami.org/pya_filter/p.cgi?cond=$positive+$negative+minus+500+ge+$over18+not+and&hide_scores=1

過去ログを取って来る方のソース:

#!/usr/bin/env perl

use strict;
use LWP::UserAgent;
use Storable;

my $regexp1 = '<tr><td width.+?>(.+?)</td><td .+?><a href=\'pyaimg/pimg.php\?imgid=(\d+)\'.+?>(.+?)</a></td></tr><tr><td .+?>No\.(\d+)</td><td width.+?><SPAN CLASS.+?>(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}) :: .+?=(\d+).+?</td>(.+?)</tr>';
my $regexp2 = '<td .+?><Img Src=\'(.+?)\.gif\'.*?> : (\d+)</td>';

my $store_file = "/home/swk/pya_db/pya.stor";

&main;

sub main
{
    my $html_code = &get_pya();

    my @posts = ();

    while ($html_code =~ /$regexp1/g) {
        my %h = ();
        $h{type} = $1;
        $h{imgid} = $2;
        $h{title} = $3;
        $h{no} = $4;
        $h{date} = $5;
        $h{time} = $6;
        $h{hit} = $7;
        $h{counters} = $8;
        push(@posts, \%h);
    }

    foreach my $p (@posts) {
        $p->{title} =~ s/<b>//g;
        $p->{title} =~ s/<\/b>//g;

        while ($p->{counters} =~ /$regexp2/g) {
            my $ctype = $1;
            my $cval = $2;
            $p->{$ctype} = $cval;
        }
        undef($p->{counters});

        $p->{good} = $p->{ii1} + $p->{ii10}
                     + $p->{ii5} + $p->{ii6} + $p->{ii7};
        $p->{ero} = $p->{ero1} + $p->{ero2} + $p->{ero3} + $p->{ero4};
        $p->{bad} = $p->{ii2} + $p->{ii12};

        $p->{positive} = $p->{good} + $p->{ero};
        $p->{negative} = $p->{bad};

        $p->{pu} = $p->{p1} + $p->{p2} + $p->{p3} + $p->{p4} + $p->{p5};

        $p->{over18} = ($p->{title} =~ /^\(18\+\)/)? 1: 0;

        $p->{dcdate} = $p->{date} . 'T' . $p->{time} . ':00+09:00';
        $p->{permlink} = 'http://pya.cc/pyaimg/pimg.php?imgid=' . $p->{imgid};

        $p->{score} = join(', ', 
                           ("hit: $p->{hit}",
                            "(・∀・)イイ: $p->{positive}",
                            "(;´Д｀)ハゥ: $p->{negative}",
                            "PU: $p->{pu}"));

        if ($p->{title} =~ /^(.+) \((情報：.+)\)\s*$/) {
            $p->{itemheader} = &html2xmlstr($1);
            $p->{itemauthor} = &html2xmlstr($2);
        } else {
            $p->{itemheader} = &html2xmlstr($p->{title});
            $p->{itemauthor} = 'pya';
        }
    }

    Storable::store(\@posts, $store_file . '.new');
    rename($store_file . '.new', $store_file);
}

sub get_pya
{
    my $page_max = 15;
    my $pya_str = "";
    my $pya_url = 'http://pya.cc/kako.php?genre=1&kakopage=';

    my $ua = LWP::UserAgent->new;
    for (my $i = 1; $i <= $page_max; $i++) {
        my $http_response = $ua->get($pya_url . $i);
        $pya_str .= $http_response->content;
        sleep(3);
    }

    return $pya_str;
}

sub html2xmlstr { # from chalow-1.0rc4
    local ($_) = @_;
    s/&nbsp;/ /g;
    s|<img.+?alt="(.*?)".*?>|[$1]|gosm;
    s/[\t\n]//g;
    s/[\x00-\x1f]+/ /g;
    s/\s\s+/ /g;
    s|<[^<>]+?>||gosm;
    s/&lt;/</go;
    s/&/&amp;/go; s/>/&gt;/go; s/</&lt;/go; s/\"/&quot;/go; # "いつもの４つ
    return $_;
}

CGI のソース:

#!/usr/bin/perl -T

use strict;
use POSIX qw(strftime);
use Template;
use Storable;
use CGI;
use Encode;

my $store_file = "/home/swk/pya_db/pya.stor";

my $rss_tt2 = << "RSS"
<?xml version="1.0" encoding="utf-8"?>
<rdf:RDF
 xmlns="http://purl.org/rss/1.0/"
 xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
 xmlns:dc="http://purl.org/dc/elements/1.1/"
 xmlns:content="http://purl.org/rss/1.0/modules/content/"
 xmlns:admin="http://webns.net/mvcb/"
 xml:lang="ja">
<channel rdf:about="[% self_url %]">
 <title>filtered pya</title>
 <link>http://pya.cc/</link>
 <description>filtered pya!</description>
 <dc:language>ja</dc:language>
 <dc:date>[% rss_dcdate %]</dc:date>
 <admin:generatorAgent rdf:resource="http://www.kagami.org/pya_filter/"/>
 <items>
 <rdf:Seq>
 [% FOREACH i = items -%]
  <rdf:li rdf:resource="[% i.permlink %]"/>
 [% END -%]
 </rdf:Seq>
 </items>
</channel>
[% FOREACH i = items -%]
<item rdf:about="[% i.permlink %]">
 <title>[% i.itemheader %]</title>
 <link>[% i.permlink %]</link>
 <description>
 ([% i.type %])[% UNLESS hide_scores %] [% i.score %] [% END %]
 </description>
 <dc:creator>[% i.itemauthor %]</dc:creator>
 <dc:date>[% i.dcdate %]</dc:date>
</item>
[% END -%]
</rdf:RDF>
RSS
        ;

&main;

sub main
{
    my $time1 = (times)[0];
    my $q = new CGI;
    print $q->header(-type => 'application/xml',
                     -charset => 'UTF-8');

    my $postsref = Storable::retrieve($store_file);
    my $cond = $q->param('cond') || '$positive 300 ge';

    my $filter = &mkfilter($cond);
    my @items = map &$filter($_), @$postsref;
    
    my $tt2 = Template->new();
    my $rss_out;
    $tt2->process(\$rss_tt2, {
        self_url => $q->url(-full => 1, -query => 1),
        hide_scores => $q->param('hide_scores')? 1: 0, 
        items => \@items,
        rss_dcdate => strftime("%Y-%m-%dT%H:%M:%S+09:00", localtime),
    }, \$rss_out);

    Encode::from_to($rss_out, 'euc-jp', 'utf8');
    print $rss_out;
    
    my $time2 = (times)[0];
    printf("<!-- time elapsed: %f (s) -->\n", $time2 - $time1);    
}

sub mkfilter
{
    my @cs = split(/\s+/, shift);
    my @fn = ();

    foreach my $c (@cs) {
        if ($c =~ /^(-?\d+)$/) {
            my $arg = $1;
            push(@fn, sub { push(@{$_[0]}, $arg); });
        } elsif ($c =~ /^\$([a-zA-Z_][a-zA-Z01-9_]*)$/) {
            my $arg = $1;
            push(@fn, sub { push(@{$_[0]}, ($_[1]->{$arg}) + 0); });
        } elsif ($c =~ /^([a-zA-Z_][a-zA-Z01-9_]*)$/) {
            my $arg = $1;
            push(@fn, sub { &op($_[0], $arg); });
        } else {
            return sub { return (); };
        }
    }

    return sub {
        my ($p) = @_;
        my @stk = ();
        foreach my $f (@fn) {
            &$f(\@stk, $p);
        }
        return pop(@stk)? $p: ();
    }
}

sub op
{    
    my ($s, $o) = @_;

    my %biop = ('ge' => sub { $_[0] >= $_[1]; },
                'gt' => sub { $_[0] > $_[1]; },
                'le' => sub { $_[0] <= $_[1]; },
                'lt' => sub { $_[0] < $_[1]; },
                'eq' => sub { $_[0] == $_[1]; },
                'ne' => sub { $_[0] != $_[1]; },
                'plus' => sub { $_[0] + $_[1]; },
                'minus' => sub { $_[0] - $_[1]; },
                'and' => sub { $_[0] && $_[1]; },
                'or' => sub { $_[0] || $_[1]; },
                );
    my %uop = ('not' => sub { !$_[0]; }
               );

    if (defined($biop{$o})) {
        my $b = pop(@$s);
        my $a = pop(@$s);
        push(@$s, &{$biop{$o}}($a, $b));
    } elsif (defined($uop{$o})) {
        my $a = pop(@$s);
        push(@$s, &{$uop{$o}}($a));
    }
}

作ってて思ったこと．ちゃんと評価したわけじゃないけど，上のプログラムで試した範囲では，

HTML::Template より Template Toolkit の方がちょっと速い．でも直書きする方がもっと速い (当り前?
Jcode より Encode の方がだいぶ速い．
上の CGI では，リクエストが来ると最初に cond パラメータを解釈して条件判定関数を生成し，それを保存している記事リストに map で適用している．実は，これをやらずに記事の数だけ cond の解釈を繰り返しても，そんなに顕著には遅くならなかった．Perl の正規表現エンジンって優秀だなと思った．

(追記) hide_scores まわりの説明がわかりにくかったようなので書き直しました．

関連記事:
[2007-06-12-2] ハイパー漢字検索を勝手に Ajax 化

[ コメントを全部見る / コメントを書く] [ TrackBack ( )] [固定リンク]

Su	Mo	Tu	We	Th	Fr	Sa
<<		2006-08			>>
		1	2	3	4	5
6	7	8	9	10	11	12
13	14	15	16	17	18	19
20	21	22	23	24	25	26
27	28	29	30	31