はてなブックマーク, MM/Mmeo, del.icio.usのRSSをまとめて取得してみる

アル厨では、はてなブックマーク、MM/Memo、del.icio.usからAlpha Geekな皆さんのブックマークを取得しています。タグ情報は各サービスで表記方法が違うので、その差を意識しないqouop::SBMなるモジュールを作って対処しました(qouopに意味は無いです。ユニークなモジュール名にするために、qouop.dyndns.orgで動作させてるのでそのような名前にしました)。

インターフェースはこんな感じ。

use qouop::SBM;

# $sbm_url(rssのURL)からインスタンス作成
$sbm = qouop::SBM->create($sbm_url);

# データ取得
$sbm->get();

# 各アイテム情報取得
my $items = $sbm->get_items();
foreach my $item (@{$items}) {
    # ブックマークタイトル取得
    my $title = $item->title;

    # ブックマーク説明取得
    my $description = $item->description;

    # ブックマークされた日付取得
    my $date = $item->date;
    
    foreach my $tag (@{$item->tag}) {
        # 各$tagについての処理
    }
}

インスタンス作成がnewではなくcreateになっていますが、これはモジュール使用者側で各SBMサービスを意識したくなかったのでAbstractFactoryっぽくしているためです。createに各SBMの出力RSSを指定すると、そのRSSに載っている情報を取得できるしくみです。

では次はqouop::SBM。

package qouop::SBM;

use strict;
use warnings;
use utf8;
use LWP::UserAgent;
use XML::Simple;
use qouop::SBM::Delicious;
use qouop::SBM::Hatena;
use qouop::SBM::MM;
use Encode;

sub create {
	my ($self, $url) = @_;
	
	my $delicious_url = '^http://del.icio.us/rss/.*';
	my $hatena_url    = '^http://b.hatena.ne.jp/.*?/rss';
	my $mm_url        = '^http://1470.net/mm/mylist.html/.*?mode=xml';
	
	return qouop::SBM::Delicious->_new($url) if ($url =~ /$delicious_url/);
	return qouop::SBM::Hatena->_new($url)    if ($url =~ /$hatena_url/);
	return qouop::SBM::MM->_new($url)        if ($url =~ /$mm_url/);
	return undef;
}

sub get {
	my $self = shift;
	
	my $content = $self->_get_resource($self->{url});
	$content = $self->_convert_ltgt($content);
	
	my $parser = XML::Simple->new;
	my $rss = $parser->XMLin($content, ForceArray => 1);
	
	$self->{title} = $rss->{channel}->[0]->{title}->[0];
	
	my @items;
	foreach my $item (@{$rss->{item}}) {
		my $i = qouop::SBM::Item->new;
		
		$i->title($item->{title}->[0]);
		$i->link($item->{link}->[0]);
		$i->description($item->{description}->[0]);
		$i->date($self->_localize_date($item->{'dc:date'}->[0]));
		$i->tag($self->_get_tags(\@{$item->{'dc:subject'}}));
		
		push @items, $i;
	}
	$self->{items} = \@items;
}
sub get_title {return shift->{title};}
sub get_items {return shift->{items};}


sub _new {
	my ($class, $url) = @_;
  
	my $self = {
				url     => $url,
				title   => undef,
				items   => undef,
			   };
	bless $self, $class;

	return $self;
}

sub _get_resource {
	my ($self, $url) = @_;
  
	my $browser = LWP::UserAgent->new;
	$browser->agent('Crawler/0.1');
  
	my $page = $browser->get($url) or die "cant get URL by LWP::UserAgent.";
  
	return $page->content;
}

sub _convert_ltgt {
	my ($self, $content) = @_;
  
	my ($enc_src) = ($content =~ /<\?xml .*? encoding="(.*?)"\s*\?>/);
	my $enc_dst = 'euc-jp';
	print $enc_src;
	Encode::from_to($content, $enc_src, $enc_dst);
	my $lt = Encode::encode($enc_dst, '<');
	my $gt = Encode::encode($enc_dst, '>');

	$content =~ s/(.*)<title>(.*?)$lt(.*?)<\/title>(.*)/$1<title>$2&lt;$3<\/title>$4/g;
	$content =~ s/(.*)<title>(.*?)$gt(.*?)<\/title>(.*)/$1<title>$2&gt;$3<\/title>$4/g;
	$content =~ s/(.*)<description>(.*?)$lt(.*?)<\/description>(.*)/$1<description>$2&lt;$3<\/description>$4/g;
	$content =~ s/(.*)<description>(.*?)$gt(.*?)<\/description>(.*)/$1<description>$2&gt;$3<\/description>$4/g;
	$content =~ s/(.*)<dc:subject>(.*?)$lt(.*?)<\/dc:subject>(.*)/$1<dc:subject>$2&lt;$3<\/dc:subject>$4/g;
	$content =~ s/(.*)<dc:subject>(.*?)$gt(.*?)<\/dc:subject>(.*)/$1<dc:subject>$2&gt;$3<\/dc:subject>$4/g;

	Encode::from_to($content, $enc_dst, $enc_src);
  
	return $content;
}

sub _get_tags {die;};
sub _localize_date {
	my ($shift, $date) = @_;
	return $date;
};

1;

create関数はid:jkondoさんのAbstractFactory例みたいにevalでコード挿入のほうがスマートですが、url引数チェックが必要で結局qouop::SBMではサブクラスも意識する必要があったので、ベタで書いてます。
get関数でRSSのダウンロード、解析を行うのですが、XML::RSSだと複数dc:subject読めなさそうな雰囲気だったので、ここではXML::Simpleで対処してます(逃げのTMTOWTDI。ちなみに当時のメモみるとXML::RSSの1001,1438行目辺りがそれらしき処理と認識し、深追いすると戻ってくるにに時間がかかりそうだったのでとりあえずあきらめました)。この処理内で呼ばれている_get_localize_dateと_get_tagsは、各SBMモジュールで必要に応じてオーバーライドされています。
_convert_ltgt関数はRSS文字コード変換とlt,gtの変換に使用してますが、lt,gt変換は今は必要ないかも。

package qouop::SBM::Item;

use strict;
use warnings;
use base qw(Class::Accessor Class::Fields);
use fields qw(title link description tag date);
__PACKAGE__->mk_accessors(__PACKAGE__->show_fields('Public'));

1;

qouop::SBM::get内で設定される、各ブックマークアイテムの情報を持つ、qouop::SBM::Itemモジュール。ここではデータを持っているだけなのでClass::AccessorとClass::Fieldsで楽してます。

package qouop::SBM::Hatena;

use strict;
use warnings;
use utf8;
use base qw(qouop::SBM);
use qouop::SBM::Item;

sub _get_tags {
	my ($self, $subject) = @_;
	return [@{$subject}];
}

1;

qouop::SBM::Hatenaでは_get_tagsのみオーバーライドしています。とはいっても、はてなブックマークのタグ情報は複数dc:subjectで取得できるのでqouop::SBMから渡されたdc:subjectリファレンスをそのまま返しているだけです。

package qouop::SBM::MM;

use strict;
use warnings;
use utf8;
use base qw(qouop::SBM);
use qouop::SBM::Item;

sub _get_tags {
	my ($self, $subject) = @_;

	my $token = ', ';
	my $tags = $subject->[0];
	if ($tags) {
		if ($tags =~ /$token/) {
			return split($token, $tags);
		} else {
			return [$tags];
		}
	} else {
		return undef;
	}
}

1;

MM/Memoは一つのdc:subject内に", "区切りでタグ情報が入っているので、上記のような処理になっています。

package qouop::SBM::Delicious;

use strict;
use warnings;
use utf8;
use base qw(qouop::SBM);
use qouop::SBM::Item;
use DateTime;
use DateTime::Format::W3CDTF;

sub _get_tags {
	my ($self, $subject) = @_;

	my $token = ' ';
	my $tags = $subject->[0];
	if ($tags) {
		if ($tags =~ /$token/) {
			return split($token, $tags);
		} else {
			return [$tags];
		}
	} else {
		return undef;
	}
}

sub _localize_date {
	my ($shift, $date) = @_;
	
	my $f = DateTime::Format::W3CDTF->new;
	my $dt = $f->parse_datetime($date);
	
	$dt->set_time_zone('Asia/Tokyo');
	my $ret = $dt.'+09:00';
	
	return $ret;
};

1;

del.icio.usは一つのdc:subjectにスペース区切りでタグ情報が入っているので、上記のような_get_tags処理となっています。del.icio.usだけは時刻情報が9時間ずれているので、DateTime::Format::W3CDTFで時刻情報を合わせています。

iTMS騒ぎでこのモジュールについて書くことを忘れていたのですが、「Perlプログラマのレベル10 - Perlプログラミング救命病棟より」で思い出したので今頃書きました。このモジュール書き始めたころはperlでプライベートメソッドの定義方法もわかりませんでした(とりあえず先頭に_をつけるのが暗黙の了解、なんですよね？)。多分正規表現の使い方とかモジュール設計でレベル7以上の人たちと差が出るんでしょうね。