【perl】とある新聞社のサイトから、更新情報を拾ってtweetするbotの作り方

【perl】とある新聞社のサイトから、更新情報を拾ってtweetするbotの作り方 はてなブックマーク - 【perl】とある新聞社のサイトから、更新情報を拾ってtweetするbotの作り方


先日自分がtweetしていました通り、更新情報を拾ってtweetするボットの紹介です。対象のボット第一弾は @webunbot_top3 です。こんな感じで、人気記事のトップ3をtweetします。

富山県に関する情報が、もっとネットに溢れたらいいのにな、という思いで作っています。このボットは、北日本新聞社のサイト http://webun.jp/ の県内記事アクセス数トップ3tweetするbotです。

構造はシンプルです。予めバッチ取得しておいたインデックスページのHTML構文解析をHTML::TokeParser モジュールを使い、Net::Twitter で tweet します。

まず、バッチ部分は cron に次のように指定しています。

01 * * * *      /home/zem/develop/webun.jp/index/webun_top3.sh

これは、毎時1分にデータを取得するシェルスクリプトです。中身はこちら。

#!/bin/sh

cd /home/zem/develop/webun.jp/index
mv news.html ./archive_news/news_`date +%Y-%m%d_%H%M`.html
wget http://webun.jp/news -O news.html
perl ./news_parse.pl

wgetで最新のデータを取得し、古いものをバックアップとして日時をつけてアーカイブ化していきます。次に、構文解析・tweet する news_parse.pl はこちらです。

#!/usr/bin/perl

# Feb 11, 2012  ver 0.01 created by Masahito Zembutsu <zem@pocketstudio.jp>
# Licensed by Under
# Module for Pocketstudio.net Network Services, the project toyama.info

use HTML::TokeParser;
use Encode qw(decode);
use utf8;
use Net::Twitter;

binmode(STDOUT, ":utf8");

# define data files
$dat = '/home/zem/develop/webun.jp/index/news.html';

# parse HTML
&parseNews();
exit;

sub parseNews() {
        # read file
        my $data = HTML::TokeParser->new($dat) || die "Can't open: $!";
        my $str;
        if (my $tag = $data->get_tag("ol")  ) {
                while (my $token = $data->get_tag("a")) {
                        $i++;
                        last if ($i > 3);
                        my $url = $token->[1]{href} || "-";
                        my $text = $data->get_trimmed_text("/a");
                        $text = decode('utf8', $text);
                        $str .= $i.'位「 '.$text."」\n";
                }
        }
        my @time = localtime();
        $str .= $time[2].'時 北日本新聞 webun 富山一覧  http://bit.ly/xgVt5Y #webunBest3'; # http://webun.jp/newlist/knpnews
        # output
        &tweet($str);
        return;
}

sub tweet {

	my $nt = Net::Twitter->new(
		traits => [qw/API::REST OAuth WrapError/],
		consumer_key    => 'xxxxxxxxxxxxxxxx',
		consumer_secret => 'xxxxxxxxxxxxxxxx',
		ssl => 1,
	);
	$nt->access_token       ('xxxx');
	$nt->access_token_secret('xxxx');

        my $text = $_[0];
	my $result = $nt->update($text);
        print "[$result:$!]$text\n"; # for debug
        return;
}

1;

まだライセンスも何も決めてません。そのうち github にもあげようと思います。
この系統の bot を perl で作りたいかたの参考になれば幸いです。

第二弾は、無料記事を紹介する @webunbot_free の構造を予定しています。