サイドバーのブックマーク

はてなブックマークはコメントを書かないとdescriptionにサイトの要約が入って、サイドバーに表示するときにコメントなのか要約なのか分かりにくくなってしまうので、以下のようなCGIを間に挟んで表示を調整することにした。

この辺はできればはてな側で対応してくれるといいんだけど。要望を出すとしたらはてなブックマークに対してかな？

#! /usr/bin/perl

# hatena-bookmark-reformat.cgi
#  - Reformating hatena-bookmark rss
#  by id:nozom

use strict;

use HTTP::Request::Common;
use LWP::UserAgent;
use XML::Simple;
use XML::RSS;
use CGI;

sub main {
    my %modules = (
        dc => 'http://purl.org/dc/elements/1.1/',
        content => 'http://purl.org/rss/1.0/modules/content/',
        taxo => 'http://purl.org/rss/1.0/modules/taxonomy/',
    );

    CGI::charset('UTF8');

    my $user = CGI::param('keywords') || 'nozom';

    my $ua = new LWP::UserAgent;
    my $res = $ua->request(GET "http://b.hatena.ne.jp/$user/rss");
    if (! $res->is_success) {
        print CGI::header();
        print $res->as_string;
        exit;
    }

    my $xs = new XML::Simple;
    my $xml = $xs->XMLin($res->content);
    my $channel = $xml->{channel};

    my $rss = new XML::RSS(version => '1.0');
    while (my ($prefix, $uri) = each %modules) {
        $rss->add_module(prefix => $prefix, uri => $uri);
    }

    $rss->channel(
        title => $channel->{title},
        link => $channel->{link},
        about => $channel->{'rdf:about'},
        language => $channel->{lang},
        description => $channel->{description},
    );

    foreach my $item (@{$xml->{item}}) {
        my $desc = $item->{description};
        if (ref($desc)) {
            $desc = '';
        } else {
            $desc =~ s/^\s+//s;
            $desc =~ s/\s+$//s;

            my $content = $item->{'content:encoded'};
            $content =~ s/<.*?>//gs;
            $content =~ s/^\s+//s;
            $content =~ s/\s+$//s;
            $content =~ s/\s*\n\s+.*$//s;

            $desc = '' if $content eq $desc;
        }

        my $subj = $item->{'dc:subject'};
        $subj = [$subj] if ref($subj) ne 'ARRAY';
        my @tags = map { CGI::escapeHTML($_) } @{$subj};

        my $taxo = $item->{'taxo:topics'}->{'rdf:Bag'}->{'rdf:li'};
        $taxo = [$taxo] if ref($taxo) ne 'ARRAY';

        $rss->add_item(
            title => CGI::escapeHTML($item->{title}),
            link => CGI::escapeHTML($item->{link}),
            description => join('', map { "[$_]" } @tags) . $desc,
            dc => {
                date => CGI::escapeHTML($item->{'dc:date'}),
                creator => CGI::escapeHTML($item->{'dc:creator'}),
                subject => join(', ', map { CGI::escapeHTML($_) } @{$subj}),
            },
            taxo => [ map { CGI::escapeHTML($_->{resource}) } @{$taxo} ],
            content => {
                encoded => CGI::escapeHTML($item->{'content:encoded'}),
            }
        );
    }

    print CGI::header(-type => 'application/xml');

    # dirty hack
    (my $str = $rss->as_string) =~ s/^(<rdf:RDF)/\1 xml:lang="ja"/m;
    print $str;
}
&main;

CGI::charsetを設定しないと、CGI::escapeHTMLでlatin文字が&#xx;形式に変換されてしまう。これが分からなくてちょっとハマった。