URL からtitle を取得してくれるirc bot 修正(0.71)

koedolug perl irc

- URL からtitle を取得してくれるirc bot - matoken’s meme -hatena-
http://d.hatena.ne.jp/matoken/20100928/1285697339

少し叩いてもらったらボロボロ問題が出てきたので少し修正．

#!/usr/bin/perl
use strict;
use warnings;
use Net::IRC;
use LWP::UserAgent;
use utf8;
use Encode;
use Encode::Guess qw/euc-jp shiftjis 7bit-jis/;

my %conf = (
        Nick     => 'zerra_xyz-P',
        Username => 'IRC-Bot',
        Server   => 'irc.ircnet.ne.jp',
        Port     => 6667,
        Ircname  => 'zerra-0.71',
#       Password => '',
);

my $channel = '#koedolug:*.jp';
my $enc_to = 'ISO-2022-JP';

sub on_connect {
        my ($self, $event) = @_;
        $self->join($channel);
        print "Connect..\n"
}

sub on_public {
        my ($self, $event) = @_;

        my $nick = $event->nick;
        my $type = $event->type;
        my ($arg) = $event->args;

        Encode::from_to($arg, $enc_to, 'UTF-8');
        if ($type eq 'public' && $arg =~ /(s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+)/) {
                my $url = $1;
                print "url > [$url]\n";

                my $ua = LWP::UserAgent->new;
                $ua->timeout(10);
                my $req = HTTP::Request->new(HEAD => $url);
                my $res = $ua->request($req);
                my $line = '';
                if( $res->header("Content-Type") =~ /html/io ){
                        $req = HTTP::Request->new(GET => $url);
                        $res = $ua->request($req);
                        $line = decode( 'Guess',( $res->content )) || '';
                }
                Encode::_utf8_off($line);
                $line =~s/\n//go;
                print "Content-Type > " . $res->header("Content-Type") ."\n";

                my $pattern = "<title.*>(.+)</title>";
                if( $line =~ /$pattern/i ) {
                        $line = $1;
                } else {
                        $line = $res->header("Content-Type");
                }
                print"title > [$line]\n";
                Encode::from_to($line, 'UTF-8', $enc_to);
                $self->notice($channel, $line);
        }
}

my $irc = Net::IRC->new;
my $conn = $irc->newconn(%conf);
$conn->add_handler('endofmotd', \&on_connect);
$conn->add_handler('public', \&on_public);

修正内容．

  • LWP::Simple からLWP::UserAgent に変更．

これで，gzip/ssl/redirect に対応．

  • head を先に取得してContent-Type にhtml が含まれていたら本文を取得するよう変更．
  • html 以外ならContent-Type を返すようにした．


後はhtml 読み込みを</title>以降読まないようにしたい．LWP で出来るかな?

そんなこんな．

追記20101001)

<matoken> http://www.amazon.co.jp/gp/product/4091834574
-zerra_xyz-P/#koedolug:*.jp- Amazon.co.jp&#xFF1A; &#x5149;&#x901F;&#x30B7;&#x30B9;&#x30BF;&#x30FC; 2 &#x5B87;&#x5B99;&#x306B;&#x305F;&#x3063;&#x305F;&#x3072;&#x3068;&#x308A;&hellip; (&#x30D3;&#x30C3;&#x30B0;&#x30B3;&#x30DF;&#x30C3;&#x30AF;&#x30B9;): &#x661F;&#x91CC; &#x3082;&#x3061;&#x308B;: &#x672C;

数値文字参照で帰ってくる場合の処理が抜けているので，多分今夜入れる．入れた．
以下diff

8a9
> use HTML::Entities;
16c17
<       Ircname  => 'zerra-0.71',
---
>       Ircname  => 'zerra-0.72',
51c52
<                       $line = decode( 'Guess',( $res->content )) || '';
---
>                       $line = decode_entities( decode( 'Guess',( $res->content ))) || '';

動きもok

<matoken> http://www.amazon.co.jp/gp/product/4091834574
-zerra_xyz-P/#koedolug:*.jp- Amazon.co.jp： 光速シスター 2 宇宙にたったひとり… (ビッグコミックス): 星里 もちる: 本