来源: BlogBus 原始链接: http://www.blogbus.com:80/blogbus/blog/diary.php?diaryid=81254 存档链接: https://web.archive.org/web/20041129022314id_/http://www.blogbus.com:80/blogbus/blog/diary.php?diaryid=81254

Just my feelings && some Perl stuffs ^-^ 这个blog记录我的一些生活琐事，关于Perl的以及其他在学习计算机，网络技术时所得的经验和有趣的东西 <<<IBM工程师幽了比尔盖茨一默~ | 首页 | 用Perl写你自己的IRC Robot>>> IRCRobot by Perl 时间: 2004-02-04 今天想写个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 下载） atzone 发表于 2004-02-04 00:51 引用(Trackback0) 评论 发表评论 最后更新 诚征有志青年若干名 Engineering geek names son version 2.0 用Perl写你自己的IRC Robot IRCRobot by Perl IBM工程师幽了比尔盖茨一默~ 我喜欢这样的桌面环境~~！ Perl代码美化工具Perltidy Use HTTP::Daemon & XML::RSS 三篇Perl好文 好BT的梦 Skyshui Eliiott Fatb@zzu Blogbus银河影院 Plod 广告狂热者 TAOWEN的个人主页