twitt(url)yのRSSの文字化けに対応した

Twitterに貼られたURLをランキングするサービスとして、Twitturlyというものがあります。
この日本人(日本語?)ランキングRSSは、時々文字化けします。


この原因は、RSS内にタイトルと内容を元のページから取得していますが、元ページの内容がUTF8以外の場合、RSSへの登録が正しく行われないためです(エンコーディングの変換をしていない?)。
さらに、RSSFeedBurnerが複数の文字コードが混在したRSSを処理しようとした結果、2バイトコードの箇所がすべて??に置き換わっているのが原因の様です。


そこで、この問題の対応として、ランキングページを元にRSSを作成するスクリプトを作成し動作させてみました。
1時間に1回動作させていますので、もしよろしければRSSリーダに登録してご利用ください。

http://feeds.feedburner.jp/Twitturly-CurrentTop100japaneseVersion


以下、取得スクリプト

#!/usr/bin/env perl

use strict;
use warnings;
use Encode;
use Encode::Guess;
use LWP;
use URI;
use XML::RSS;
use Web::Scraper;
#use Dumpvalue;

#my $dump = Dumpvalue->new();

my $utf8 = Encode::find_encoding('utf8');

my $uri = new URI('http://twitturly.com/page/1/filter/lang/Japanese/');

my $scraper = scraper {
    process 'div.content', 'content' => {
        process 'table', 'entries[]' => {
            'item' => scraper {
                process 'div.count',            'count'        => 'TEXT';
                process 'div.result_title b a', 'result_title' => 'TEXT';
                process 'div.result_title b a', 'result_uri'   => '@href';
                process 'div.result_link a',    'result_link'  => '@href',
                process 'div.result_desc',      'result_desc'  => sub {
                    my $text = $_->as_text or return;
                    # Auto Description と入っている場合は文字化けしてるケースが多いから除去
                    return "" if $text =~ /^ \[ Auto Description \]/ ;
                    return $text;
                };
            }
        }
    }
};

my $response = $scraper->scrape($uri);

my $rss = new XML::RSS (version => '2.0');
$rss->channel(title => "Twitturly - Current Top 100 (Japanese Version)",
              link  => "http://twitturly.com",
              description => "Twitturly is a service for tracking what URLs people are talking about as they talk about them on Twitter.",
              );

for my $entry ( @{$response->{entries}} ){
    my $item = $entry->{item};

    next unless $entry;
    next unless $entry->{item};
    next unless $item->{result_uri};

    # ページタイトルを取得する
    my $uri  = $item->{result_uri};
    my $page_title = "";
    my $ua = LWP::UserAgent->new();
    my $res = $ua->get($uri);
    if($res->is_success){
        Encode::Guess->set_suspects(qw/utf8 euc-jp shiftjis 7bit-jis/);
        $page_title = $res->title;
        eval {
            # 文字コードの判定を行ってutf8に変換
            my $decoder = Encode::Guess->guess($res->title);
            $page_title = $decoder->decode($res->title);
        };
    } else {
        $page_title = $res->status_line;
    }
    # リンクされた件数とページタイトルをitemのタイトルとする
    my $title = $item->{count} . ' Tweets | ' . $page_title;

    $rss->add_item(title => $title,
                   link  => $item->{result_link},
                   description => $item->{result_desc}
                   );
}
$rss->save("twitturly_jp.xml");