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

バグ修正です．

• タイトル内に改行があって，かつ\r が含まれる場合タイトルがうまく出なかったのを修正．
• ユーザエージェント名の文字列内に"libwww-perl" があると403 を返してくるサイトがあるのでユーザエージェント名変更．> 2ch/livedoor/gigazine とか

<matoken> http://hato.2ch.net/ebooks/
-zerra_xyz-P/#koedolug:*.jp- ようこそボボンハウスへ
<matoken> http://books.livedoor.com/
-zerra_xyz-P/#koedolug:*.jp- 403 Forbidden
<matoken> http://gigazine.net/index.php?/news/comments/20101001_pancake_royalhost/ なんだろう．後でデバッグいれてみます
-zerra_xyz-P/#koedolug:*.jp- 403 Forbidden

#!/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/;
use HTML::Entities;

my $version = "0.73";

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

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);
		$ua->agent("zerra_xyz-P $version/IRC-Bot");
		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_entities( decode( 'Guess',( $res->content ))) || '';
		}
		Encode::_utf8_off($line);
		$line =~s/[\r\n]//go;
		print "Content-Type > " . $res->header("Content-Type") ."\n";

		my $pattern = "<title.*>(.+)</title>";
		if( $line =~ /$pattern/i ) {
			$line = $1;
			$line = decode_entities( $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);
$irc->start;

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