更新情報を拾ってtweetするボットの紹介、第二弾です。今回は、@webunbot_free が対象 。

新着情報かつ、無償公開記事を抽出する仕組みとソースコード(perl)を解説します。

基本構造はボット第一弾と同じです。予めバッチ取得しておいたインデックスページに対し、HTML構文解析をHTML::TokeParser モジュールを使い実行。最後は、Net::Twitter で tweet します。

第一弾と違うのは、「新着無償記事があれば tweet する」という所です。1度tweetしたものは、重複tweetを避けるため、ファイルにデータとして保管しておく工夫が必要です。内部的には、テキストにURLと記事を書き出しているだけです。

では、順番を追って見ていきます。まずは、cron で定期的にバッチを流すところです。毎時30分にスクリプトを実行します。

30 * * * *    /home/zem/develop/webun.jp/index/webun_free.sh

中身は、次の通り。

#!/bin/sh

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

古いものはバックアップをとり、wget でファイルを取得、-O のアウトプットで ‘news.html’として保存。さらに perl で free_parse.pl を実行します。

第一弾と大きく違うのは、”free.gif”が含まれている記事を無償記事と判別するところです。記事があった場合、LWP でリンク先の URL をチェックし、記事日付をチェックします。また、それが新着かどうかのチェックを実施します。

#!/usr/bin/perl

# Feb 11, 2012  ver 0.01 created by Masahito Zembutsu <zem@pocketstudio.jp>
# Licensed by GPLv2
# Module for"Pocketstudio.net Network Services

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

binmode(STDOUT, ":utf8");

#use Scalar::Util 'blessed';

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

# parse HTML
&parseNews();

exit;

sub parseNews() {

        open(DAT,"$dat") or die "ERROR: $!";
        foreach $dat (<DAT>) {
                $i++;
                if ($dat =~ m/news_major_tlist/) {
                        $hit = 1;
                }
                if ($hit and $dat =~ m/free\.gif/) {
                        $dat = decode('utf8', $dat);
                        if ($dat =~ /(.*)(href=\")(.*)(\"\>)(.*)(\<\/a)/) {
                                #print "$3\t$5\n";
                                $url = $BASEURL.$3;
                                $txt = $5;
                                if ($txt =~ /(<span>)(.*)(<\/span>)/) {
                                        $txt = $2;
                                }
                                $res =  &check_duplicate($url,$txt);
                                print "res=$res\n";
                                if ($res) {
                                        #&getBitly($url);
                                        $publish = getPublish($url);
                                        $txt .= ' '.$publish.'';
                                        &tweet_free($url,$txt);
                                }
                        }
                }
                last if ($dat =~ m/tabNavi02/);
        }
        close(DAT);

        $str .= ':: 北日本新聞 webun #webunFree'; # http://webun.jp/newlist/knpnews
#       print "[ $str ]";

        # outputG
	return;
}

sub tweet_free {

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

        my $text = $_[0];
        $text = " $_[1] $_[0] 北日本新聞 webun.jp 無料記事 #webunFree";
	my $result = $nt->update($text);
        print "[$result:$!]$text\n";
        return;
}

sub check_duplicate {
        my $match = 0;
        my ($url, $txt ) = @_;
        print "### check_duplicate\n\t$url\n\t$txt\n";
        if (open(CHECK,'/home/zem/develop/webun.jp/index/news.dat')) {
                foreach $check (<CHECK>) {
                        chomp $check;
                        my ($daturl, $txt) = split(/\t/, $check);
                        if ($daturl eq $url) {
                                $match = 1;
                        }
                        last if ($match);
                }
        }
        close(CHECK);

        print "match=$match\n";
        if ($match) {
                return 0; #debug
        } else {
                if (open(CHECK,'>>/home/zem/develop/webun.jp/index/news.dat')) {
                        print CHECK $url."\t".$txt."\n";
                }
                return 1;
        }
        return 0;
}

sub getPublish {

        my $url = $_[0];
        print "### getPublish $url\n";
        my $html = get $url;
        my $data = HTML::TokeParser->new(\$html);
        while (my $tag = $data->get_tag("div")) {
                if ($tag->[1]{id} and $tag->[1]{id} eq "date_txt") {
                        my $result = $data->get_trimmed_text("/div");
                         $result = decode('utf8', $result);
                        if ($result =~ /(\d+)(.)(\d+)(.)(\d+)(.)(\s+)(\d\d\:\d\d)/) {
                                $result = "[$1/$3/$5 $8]";
                                return $result;
                        }
                }
        }
        return;
}

1;

ただ、このボットには弱点があります。

• 記事が、公開後アップデートされた場合
• インデックスに掲載されていない過去記事が、後日に公開された場合

この２つの条件の時、tweet できていません。より厳密に記事や日付をチェックする仕組みが出来れば改良する余地はあります。しかしながら、現状、速報的なニュースの tweet を行うという目的は達成出来ていると考えていますので、当面、手を加えないかもしれません。

…あとは、開発デバッグ用の情報がいくつか残ったままなので、これもキレイにしたい所です。需要が高そうなら、ソースの詳細解説もいずれやりたいと思います。