Published on Blog Developer's Cookbook.
Printer friendly version of http://blog.bulknews.net/cookbook/blosxom/rss/genfeed.html.


genfeed - 汎用 RSS ジェネレータ

by miyagawa at Tue, 28 Oct 2003 00:29

サイトごとにカスタマイズされた正規表現を用意すれば、HTML を容易に RSS に変換することができます。ただ、サイトを1つ追加するごとに、スクリプトを作成するのは手間です。異なるのは正規表現のパターンだけですから、これを定義ファイル化して、汎用的に RSS を生成するツールを作ってみます。


先に紹介した 関心空間 RSS ジェネレータ のうち

これらの要素以外のロジックは、サイト毎に独立です。よって汎用 RSS ジェネレータでは、これらの要素をサイト定義ファイルとして外に出してしまい、順に処理するような形とすればよいでしょう。

ここで定義ファイルのサンプルは List 1 のような形とします。ここでは asahi.comを例としています。定義ファイルは RFC822 ライクなヘッダ形式で、
titleRSS channel の title
linkRSS channel の link
descriptionRSS channel の description
matchマッチした結果が item のどの要素にマッピングされるか
を定義し、空行をはさんでパターンを記述します。

サンプルコード

サイトのパターン等のデータを定義ファイル化し、順に RSS 変換するプログラム gendeed は List 2 のようになります(*1)。スクリプトの大まかな流れは、
  1. サイトの定義ファイルをロード
  2. HTML をローカルのキャッシュファイルに取得
  3. HTML をパターンにマッチさせて、RSS を生成
のようになります。

use DirHandle;
use Encode;
use FileHandle;
use HTTP::Status;
use LWP::UserAgent;
use URI;
use XML::RSS;
使用するモジュールをロードします。ディレクトリからファイルを取得するDirHandle、URI の相対パスを絶対 URL に変換するのに URI を使用します。

our $VERSION = "0.01";
our $SiteDir = "sites";
our $OutDir  = "feeds";

mkdir "$SiteDir/cache", 0755 unless -e "$SiteDir/cache";
mkdir $OutDir, 0755          unless -e $OutDir;
User-Agent に使用するバージョン番号 $VERSION、サイトの定義ファイルを格納する $SiteDir、RSS ファイルを出力する $OutDir をパッケージ変数として定義し、ディレクトリがなければ mkdir します。

my $ua = LWP::UserAgent->new();
   $ua->agent("genfeed/$VERSION");
LWP::UserAgent のオブジェクトを初期化します。User-Agent 文字列にソフトウェア名とバージョン番号を入れておきます。

my @sites = load_sites();
load_sites でサイト定義ファイルを読み込みます。

sub load_sites {
    my $dh = DirHandle->new($SiteDir) or die "$SiteDir: $!";
    my @sites;
    for my $file (grep -f "$SiteDir/$_", $dh->read) {
        push @sites, load_site($SiteDir, $file);
    }
    return @sites;
}
load_sites では、$SiteDir に含まれるファイルから load_site を呼び出し、サイト定義をロードします。

sub load_site {
    my($dir, $file) = @_;
    my $fh = FileHandle->new("$dir/$file") or die "$dir/$file: $!";
    my %param;
    while (<$fh>) {
        chomp;
        last if /^$/;
        /^(\S+): (.*)$/ and $param{$1} = $2;
    }
    $param{match} = [ split / /, $param{match} ];
    $param{pattern} = do { local $/; <$fh> };
    $param{filename} = $file;
    return \%param;
}
load_site はファイルを open し、RFC822 形式のヘッダをパースしながら、空行を見つけたら $param{pattern} にパターンを格納します。また $param{match} はスペースで区切って配列リファレンスとします。先に定義した asahi.com の場合、

$site = {
    title => 'asahi.top',
    link  => 'http://www.asahi.com/',
    description => 'Asahi.com',
    match => [ 'link', 'title' ],
    pattern => "<li>\n<a href="(.*?)">(.*?)</a>\(\d\d:\d\d\)</li>",
};

のようなハッシュリファレンスとなります。

for my $site (@sites) {
    crawl_site($ua, $site);
}
load_sites で読み込んだサイト定義について、crawl_site でクローリングします。

sub crawl_site {
    my($ua, $site) = @_;
    my $cache = "$SiteDir/cache/$site->{filename}.html";
    my $base = URI->new($site->{crawl} || $site->{link});
    my $resp = $ua->mirror($base, $cache);
サイトの定義ファイル名からキャッシュファイルのパスを決定(*2)し、クロール先の URL を URI オブジェクトにします。

クロール先は、crawl というヘッダがあればそれを優先し、なければ link 要素を拾います。これは、サイトのトップページ(link)以外に、その日の記事一覧が取得できるページ(crawl)があるようなニュースサイトの場合、そのページから記事をマッチさせる方が効率が良いためです。

URI とキャッシュファイルを引数にして mirror メソッドを実行します。これはローカルのキャッシュファイルの mtime を利用して If-Modified-Since などを HTTP リクエストヘッダに付加するため、ネットワーク資源を有効活用することができます。

    $resp->code == RC_NOT_MODIFIED and return;
    $resp->is_success or do { warn "Error: ", $site->{title}; return };
レスポンスのステータスが 304 Not Modified の場合、元ページが更新されていないため、RSS も更新せず return します。レスポンスが失敗した場合には、エラーを STDERR に吐き出し、次のサイトへ進みます。

    my $rss = XML::RSS->new(version => 0.91);
    $rss->channel(
        title => $site->{title},
        link  => $site->{link},
        description => $site->{description},
    );
XML::RSS オブジェクトを生成します。ここでもバージョンは 0.91 としましたが、日付が取得できるようであれば、RSS 1.0 にして dc:date 要素を入れた方がよいかもしれません。

    my $html = do { local $/; my $fh = FileHandle->new($cache); <$fh> };
キャッシュファイルを open して、一気読みします。Perl の特殊変数 $/ を undef にしておくと、ファイルの中身を一気に読み込む(*3)ことが出来ます。

    my $charset = extract_charset($resp, $html);
    $html = decode($charset, $html);
HTTP レスポンスおよび HTML からエンコーディングを取得して、Encode::decode します。これにより $html 変数が Unicode 文字列になります。

sub extract_charset {
    my($resp, $html) = @_;
    $resp->header('Content-Type') =~ /charset=([\w\-]*)/ and return $1;
    $html =~ /<meta .*?charset="([\w\-]*?)"/ and return $1;
    return guess_encoding($html);
}
レスポンスの Content-Type から charset=utf-8 といった文字列をマッチさせてエンコーディングを拾います。また Content-Type に charset 指定がない場合には HTML 内の meta タグから同様の表記を拾います。それでも失敗する場合には、guess_encoding を呼びます。

sub guess_encoding {
    require Encode::Guess;
    Encode::Guess->set_suspects(qw/Shift_JIS euc-jp/);
    my $data = shift;
    my $enc  = Encode::Guess->guess($data);
    ref($enc) or die "Can't guess: $enc"; # idiom
    return $enc->name;
}
guess_encoding では、Encode::Guess モジュールを使用してエンコーディングの自動判定を行います。Encode::Guess->set_suspects() に候補のエンコーディングを渡します。ここでは日本語のページを想定しているため、Shift_JIS と euc-jp のみを指定しています。

    my @whole_match = $html =~ /$site->{pattern}/g;
    my $match_num = @{$site->{match}};
    while (my @match = splice(@whole_match, 0, $match_num)) {
        my %data; @data{@{$site->{match}}} = @match;
        $data{link} = URI->new_abs($data{link}, $base);
        $rss->add_item(%data);
    }
デコードした HTML に対し、サイトの定義にある pattern でマッチをかけます。正規表現の g オプションで、すべてを1つの配列にマッチさせます。match 要素が2個 (たとえば linktitle) の場合、すべてのマッチの前から2個ずつとっていくために、$match_num にその値を格納します。

splice 関数を使用して、マッチ配列から順に要素をとりだし、ハッシュのスライスを用いて item 要素を構築します。またマッチした linkは相対パスとなっていることが多いため、URI->new_abs を利用して、クローリング元の URI からの相対リンクとして絶対 URI を構築します。

    my $xml = "$OutDir/$site->{filename}.xml";
    open my $out, ">:utf8", $xml or die "$xml: $!";
    $out->print($rss->as_string());
最後に出力する RSS ファイルを UTF-8 モードで open し、as_string メソッドで文字列化して書き込みます。

実行例

先に紹介した asahi.com に加え、CNET Japan の定義ファイル List 3 も定義しています。CNET Japan では トップページより、ヘッドラインページの方が情報を一覧で取得しやすいため、こちらを crawl 要素として定義しています。

% ./genfeed.pl
% ls feeds
feeds:
asahi.top.xml   cnet.japan.xml

コマンドラインから実行すると、feeds ディレクトリに asahi.top.xmlcnet.japan.xml などの RSS ファイルが作成されます。

Listings

List 1: asahi.top
title: asahi.com
link: http://www.asahi.com/
description: Asahi.com
match: link title

<li>
<a href="(.*?)">(.*?)</a>\(\d\d:\d\d\)</li>
List 2: genfeed.pl
#!/usr/local/bin/perl -w
# genfeed - generic RSS feed generator

use strict;
use DirHandle;
use Encode;
use FileHandle;
use HTTP::Status;
use LWP::UserAgent;
use URI;
use XML::RSS;

our $VERSION = "0.01";
our $SiteDir = "sites";
our $OutDir  = "feeds";

mkdir "$SiteDir/cache", 0755 unless -e "$SiteDir/cache";
mkdir $OutDir, 0755          unless -e $OutDir;

my $ua = LWP::UserAgent->new();
   $ua->agent("genfeed/$VERSION");

my @sites = load_sites();
for my $site (@sites) {
    crawl_site($ua, $site);
}

sub load_sites {
    my $dh = DirHandle->new($SiteDir) or die "$SiteDir: $!";
    my @sites;
    for my $file (grep -f "$SiteDir/$_", $dh->read) {
        push @sites, load_site($SiteDir, $file);
    }
    return @sites;
}

sub load_site {
    my($dir, $file) = @_;
    my $fh = FileHandle->new("$dir/$file") or die "$dir/$file: $!";
    my %param;
    while (<$fh>) {
        chomp;
        last if /^$/;
        /^(\S+): (.*)$/ and $param{$1} = $2;
    }
    $param{match} = [ split / /, $param{match} ];
    $param{pattern} = do { local $/; <$fh> };
    $param{filename} = $file;
    return \%param;
}

sub crawl_site {
    my($ua, $site) = @_;
    my $cache = "$SiteDir/cache/$site->{filename}.html";
    my $base = URI->new($site->{crawl} || $site->{link});
    my $resp = $ua->mirror($base, $cache);

    $resp->code == RC_NOT_MODIFIED and return;
    $resp->is_success or do { warn "Error: ", $site->{title}; return };

    my $rss = XML::RSS->new(version => 0.91);
    $rss->channel(
        title => $site->{title},
        link  => $site->{link},
        description => $site->{description},
    );

    my $html = do { local $/; my $fh = FileHandle->new($cache); <$fh> };

    my $charset = extract_charset($resp, $html);
    $html = decode($charset, $html);

    my @whole_match = $html =~ /$site->{pattern}/g;
    my $match_num = @{$site->{match}};
    while (my @match = splice(@whole_match, 0, $match_num)) {
        my %data; @data{@{$site->{match}}} = @match;
        $data{link} = URI->new_abs($data{link}, $base);
        $rss->add_item(%data);
    }

    my $xml = "$OutDir/$site->{filename}.xml";
    open my $out, ">:utf8", $xml or die "$xml: $!";
    $out->print($rss->as_string());
}

sub extract_charset {
    my($resp, $html) = @_;
    $resp->header('Content-Type') =~ /charset=([\w\-]*)/ and return $1;
    $html =~ /<meta .*?charset="([\w\-]*?)"/ and return $1;
    return guess_encoding($html);
}

sub guess_encoding {
    require Encode::Guess;
    Encode::Guess->set_suspects(qw/Shift_JIS euc-jp/);
    my $data = shift;
    my $enc  = Encode::Guess->guess($data);
    ref($enc) or die "Can't guess: $enc"; # idiom
    return $enc->name;
}
List 3: cnet.japan
title: CNET Japan
link: http://japan.cnet.com/
crawl: http://japan.cnet.com/archive/headline.htm
description: CNET Japan
match: link title

<li><span class="j3"><a href="(.*?)">(.*?)</a></span>
*1) データベースの処理等を除けば、Bulknews で動いているエンジンと同等です。
*2) 定義ファイルが asahi.top であれば、キャッシュは cache/asahi.top.html となります。
*3) slurp といいます。

Copyright©2002-2003 Tatsuhiko Miyagawa