今天想写个robot玩一下，有很多途径与robot沟通，但是我平常用及时通信软件比较多，所以找到了Net::Jabber，但是在我的win2000+activeperl上无法通过XML::Stream的安装测试，老是在第3个测试那里死掉。于是把希望投到Net::ICQ和Net::MSN上，无奈他们都出了最新的协议，CPAN上的模块不支持，sucks！只剩IRC了，IRC也不错嘛，正好Net::IRC能安装成功，最近weblog这么热，就写个抓新闻或者weblog站点rss文件，然后分析显示其中主题的IRCRobot吧，当然这个robot的功能非常少，只有：

自动登陆IRC并防掉线；
对该robot说的话包含他的名字，他回提示输入list查看可用rss站点名；
输入list，显示当前可用的rss站点名；
输入: grab 可用rss站点名，robot会自动抓取目的rss文件对其进行分析并返回最新的主题极其url。
输入：go home，robot关闭。

功能和robot的智能的确简单了点，不过这也是我第一次写IRC的robot，对IRC不熟，等了解了IRC的大部分命令后再写个好点的。
其实以后用IRC来监视远程系统运行情况，进行简单的系统维护还是不错的，甚至可以结合weblog的XML-RPC接口在IRC上实现对自己weblog的更新，呵呵，不错。

代码如下：

#!/usr/bin/perl #perlchina.org #cnhackTNT[at]4red.org use strict; use Net::IRC; use XML::RSS; use LWP::Simple; use Encode; $SIG{INT} = \&quit; my %rss = ( slashdot => 'http://slashdot.org/index.rss', googleblog => 'http://google.blogspace.com/index.xml', freshmeat => 'http://freshmeat.net/backend/fm.rdf', blogcn => 'http://www.blogcn.com/user_rss.asp', cnblog => 'http://www.cnblog.org/blog/cache/cnblog.xml', AmericanInChina => 'http://www.blogcn.com/rss.asp?uid=aradosh', AnorwegiansLife => 'http://www.blogcn.com/rss.asp?uid=houshuang' ); my %init = ( Nick => 'Grabber', Server => shift || 'css.sunnet.org', Port => 6667, Ircname => 'I am a rss grabber .~', Channel => shift || '#rssGrabber.pm' ); my $irc = new Net::IRC; my $conn = $irc->newconn(%init); $conn->add_global_handler( '376', \&on_conn ); $conn->add_global_handler( 'disconnect', \&on_disconnect ); $conn->add_handler( 'public', \&on_line ); $conn->add_handler( 'msg', \&on_line ); $irc->start; sub on_conn { print "Joining $init{'Channel'}...\n"; my $self = shift; $self->join("$init{'Channel'}"); $self->privmsg( "$init{'Channel'}", "Hi!I am the rss grabber.~" ); } sub on_line { my ( $self, $event ) = @_; my ( $nick, $mynick ) = ( $event->nick, $self->nick ); my ($arg) = ( $event->args ); print "<$nick> $arg\n"; if ( $arg =~ /grab\s+(\w+)/i ) { my $key = $1; my $topic; if ( exists $rss{$key} ) { $self->privmsg( $nick, "4 Plz wait for awhile,I am grabbing news from 12 $rss{$key}!!" ); $topic = &grab($key); if ($topic) { $self->privmsg( $nick, "-" x 80 ); for ( keys %$topic ) { $self->privmsg( $nick, encode( "euc-cn", $_ ) . ' 7| ' . encode( "euc-cn", $topic->{$_} ) ); sleep 2; } $self->privmsg( $nick, "-" x 80 ); $self->privmsg( $nick, 'Done!' ); } else { $self->privmsg( $nick, '4Empty?!mybe the server\'s problem' ); } } else { $self->privmsg( $nick, '4I dont\'t have this server\'s rss url' ); } } if ( $arg =~ m/$mynick/i ) { $self->privmsg( $nick, 'Do u want read news or blogs?type \'list\' for available rss seeds.' ); } if ( $arg =~ m/list/i ) { $self->privmsg( $nick, '4the present rss seeds includes:' ); $self->privmsg( $nick, '-' x 80 ); $self->privmsg( $nick, '12' . $_ ) for keys %rss; $self->privmsg( $nick, '-' x 80 ); $self->privmsg( $nick, 'Done!' ); } if ( $arg =~ /go home/i ) { $self->privmsg( $init{'Channel'}, 'BYE BYE~~' ); $self->quit; exit 0; } } sub on_disconnect { my ( $self, $event ) = @_; print "Disconnected from ", $event->from(), " (", ( $event->args() )[0], "). Attempting to reconnect...\n"; $self->connect(); } sub quit { print "Somebody force me exit:-(\n"; exit 0; } sub grab { my $key = shift; my $topic = {}; my $o = new XML::RSS; my $content = get( $rss{$key} ) or return ( { Error => "Can\'t grab news from $rss{$key} !!" } ); $o->parse($content); foreach my $item ( @{ $o->{'items'} } ) { next unless defined( $item->{'title'} ) && defined( $item->{'link'} ); $topic->{ '4' . $item->{'title'} } = '12' . $item->{'link'}; } return $topic; } syntax highlighted by Code2HTML, v. 0.9.1

方便自己用的，没什么特殊功能。

(要支持中文的话，需要下载gb2312.enc文件，拷贝到perl目录下lib/xml/parser/encoding下，这个文件可以在http://atzone.fatb.org/source/gb2312.enc下载）