代码： 全选
2009-04-10 10:01:52 五 ~/应用/脚本
☎ cat gir.pl
#!/usr/bin/perl
#
# girbot.pl
# Gir IRC Bot
#
# Author: Wraithnix ([email protected])
# Version: 0.1
# Web: http://www.riotmod.com
#
# This script is released under the
# GNU General Public License.
#
use strict;
use Net::IRC;
use Switch;
# ============
# SUPPORT CODE
# ============
# GetSetting
# Arguments: setting to retrieve,configuration file
# Returns: The setting value, or "" if it doesn't exist
# Description: Use this sub to load values
# from a configuration file.
# Settings are stored in this format:
# <setting>=<value>
sub GetSetting
{
my ($setting,$config_file)=@_;
open(CFGFILE,"<$config_file")
or die "Can't open configuration file ($config_file)";
my @slist=<CFGFILE>;
foreach my $selem (@slist)
{
if (index($selem,"#")==0) { next; }
my @ln=split("=",$selem);
if ($ln[0] =~ /$setting/i)
{
chomp $ln[1];
return $ln[1];
}
}
close CFGFILE;
}
# =============
# MAIN BOT CODE
# =============
# Set our configuration file
my $configuration_file = "/home/exp/.irc-bot.cfg";
# You can start the bot with a config file as a
# commandline argument. Without the argument,
# the bot loads its settings from "gir.cfg", in
# the same directory as the bot.
if($#ARGV==0) { $configuration_file=$ARGV[0]; }
# Now, we can load in our script's settings
my $cfg_nick=GetSetting("nick",$configuration_file);
my $cfg_altnick=GetSetting("altnick",$configuration_file);
my $cfg_ident=GetSetting("ident",$configuration_file);
my $cfg_port=GetSetting("port",$configuration_file);
my $cfg_server=GetSetting("server",$configuration_file);
my $cfg_room=GetSetting("room",$configuration_file);
my $cfg_master=GetSetting("master",$configuration_file);
#my $welcome=GetSetting("welcome",$configuration_file);
#----------------------------------------------
my $ppp='\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}';
my $ipv6='[\da-fA-F]{1,4}:[\da-fA-F]{1,4}:[\da-fA-F]{1,4}';
my @Amynick=("iPhone","iFvwm","iGoogle","iGnome","iOpera");
push(@Amynick,$cfg_master);
my @ACmd=("welcome","voice","http");
my $voice=1;
my $welcome=0;
my $http=0;
#----------------------------------------------
# Just about all of the settings are "strings", except
# for the "port". Let's make sure that that setting
# is numerical, and if not, set it to the most common
# port, 6667:
if($cfg_port=~/\D/) { $cfg_port=6667; }
#if($cfg_room=~/\D/) { $cfg_room="#ubuntu-cn"; }
# Now that all of our settings are loaded in,
# let's create the IRC object
my $irc = new Net::IRC;
print "Creating connection to IRC server...";
my $conn = $irc->newconn(Server => "$cfg_server",
Port => $cfg_port,
Nick => "$cfg_nick",
Ircname => "$cfg_ident",
Username => "$cfg_ident")
or die "Can't connect to IRC server.";
print "done!\n";
# With that out of the way, let's create
# some subs for our object handlers
# What our bot will do when it finishes
# connecting to the IRC server
sub on_connect {
my $self = shift;
print "*** Connected to IRC.\n";
print "Joining $cfg_room ...\n";
$self->join("${cfg_room}");
$self->privmsg("${cfg_room}", "Ξ");
}
# This sub will print various
# incoming date while we're still
# connecting to IRC
sub on_init {
my ($self, $event) = @_;
my (@args) = ($event->args);
shift (@args);
print "*** @args\n";
}
# This sub will handle what happens when the
# bot receives public (channel) text.
sub on_public {
my ($self, $event) = @_;
my @to = $event->to;
my ($nick, $mynick) = ($event->nick, $self->nick); # Sender text,
#+Bot nick
my $host=$event->host; # Sender's hostname
my ($arg) = ($event->args); # The message
# Here's where we want to "parse" channel text
# print "<$nick> $arg\n";
#----------------------------------------------
if($nick=~$self->nick) {return 1;} #自己的话
if($voice==1){
foreach (@Amynick){
if($arg=~/\b$_\b/i){
`aplay 2>/dev/null '/home/exp/应用/Game-Grid-Wars/sounds/bonus1.wav'`;
last;}}}
#----------------------------------------------
my ($c,$w)=split(/\s/,$arg);
my @Afunc=(
["h", "echo t 翻译 p 查IP库 ap 精确ip r 写倒字 f 写点字 c 计算 y 荧光字 w 城市天气 u url字串和utf8互转 py 汉字查拼音 bd 百度 deb 包信息 en 中文翻译英文 cn 英文翻译中文"],
["t", "sdcv.pl"],
["p", "ip-ip纯真库.pl"],
["f", "t.bash", 2],
["c", "c"],
["r", "r"],
["w", "w.pl"],
["y", "f-荧光字贴图.bash"],
["u","url字串和utf8互转.pl"],
["py","han-pinyin.pl"],
["bd","baidu.pl", 1],
["deb","deb.pl"],
["ap","apnic.pl"],
["en","cn-en.bash"],
["cn","en-cn.bash", 1],
);
for my $i ( 0 .. $#Afunc ){
if($Afunc[$i][0] eq $c){
if($Afunc[$i][2]==1){$w=$arg; $w=~s/^.*? //; $w=~s/ /+/g;} #全部参数
print "cmd:\t <$Afunc[$i][1] 2>/dev/null $w>\n";
my $r=`$Afunc[$i][1] \'$w\'`;
if($Afunc[$i][2]==2){ #多行输出
for my $i ($r=~/(.*)\n/g){
$self->privmsg("${cfg_room}", $i);
}
}
else{
$self->privmsg("${cfg_room}", $r);
}
# $self->privmsg("${cfg_room}", `$Afunc[$i][1] $w`);
}
}
#----------------------------------------------
if($http==1){
if($arg=~/http:\/\/\S*/){
my $g=$&;
if ($g!~/\.flv$|\.w..$|\.mp.{1,2}$|\.gz$|\.rar$|paste\.|\.zip$/){
my $t=`web-title.pl \'$g\'`;
# my $r=`wget --no-cookies --no-follow-ftp \'$&\' -O -|enconv`;
# w3m -no-cookie -dump_source http://www.lwpl.cn/|g title
# $r=~/<title>(.*?)<\/title>/is;my $t=$&;$t=~s/<[^>]*>//g;
$self->privmsg("${cfg_room}", "$g 网页标题：$t\n");
}
else{$self->privmsg("${cfg_room}", "$g 流媒体地址。\n");}
}
}
#----------------------------------------------
if($arg=~s/.*知道(.+)吗.*/\1/){
# $arg=~s/.*知道(.+)[吗?？]*/--\1--/;
# print "解析0：=$&=\n";
print "解析1：=$arg=\n";
}
#----------------------------------------------
}
# This sub will handle what happens when the
# bot receives private message text
sub on_join {
my ($self, $event) = @_;
my ($nick) = $event->nick; # Message Sender
# my ($arg) = ($event->args); # Message Text
my $host=$event->host;
#----------------------------------------------
if(join(" ",@Amynick)=~$nick) {return 1;} # 主人列表，忽略
#----------------------------------------------
my @Anick=(
["roylez","金主席"],["GundamZZ","包包"],["bones7456","排骨"],
["AutumnCat","球猫"],["iNutshell","栗子壳"],["manphiz","糖糖"],
["freeflying","狒狒"],["iPeipei","佩佩朶"],["Arthrun","老雕"],
["ShelyII","猞猁"],["lerosua","广陵散"],["^k^","这猪猪bot"],
["sunmoon1997","月月神教"],["palomino|working","破马"],
["Epocher","洗脚"],["oneleaf","叶子"],["mOo","摸光"],
["zhan","鲇鱼"],["GNUdog","狗狗"],["eXopeth","蜗牛"],
["DawnFantasy","豆腐"],["Fong","赌棍"],
);
for my $i ( 0 .. $#Anick ){
if($nick=~/^$Anick[$i][0]\d*\b/i){
$nick=$Anick[$i][1]; last;
}
}
#----------------------------------------------
my $a="";
while($a eq ""){
switch ($host) {
case "59.36.101.19" {$a="ubuntu-cn论坛的webirc"}
case /^$ipv6.*/ {$a="太阳系v6"}
case /^$ppp$/ {$a=`ip-ip纯真库.pl $host`}
case /.*mibbit.*/ {$a="mibbit"}
case m:/: {$a="太阳系"}
else{
print "---------\n";
while (my ($k,$v) = each %$event){print "- $k => $v\n";}
$host=`host $host`;
print "- new host----$host.\n";
if($host=~/\b$ppp\b/){$host=$&;}
else{$a="鬼搞鬼搞的地方";}
}
}
}
#----------------------------------------------
if($a=~"IANA"){$a="外太空";}
chomp($a);
print "$host==$a==\n";
if($welcome==1) {
$self->privmsg("${cfg_room}", "欢迎来自 $a 的 $nick 加入 ubuntu 技术聊天室。《".$event->user."》\n");}
else{
print "欢迎来自 $a 的 $nick 加入 ubuntu 技术聊天室。《".$event->user."》\n";}
#----------------------------------------------
}
sub on_msg {
my ($self, $event) = @_;
my ($nick) = $event->nick; # Message Sender
my ($arg) = ($event->args); # Message Text
my $host=$event->host;
# Here's where we want to "parse" message text
# print " - $nick - $arg\n";
#----------------------------------------------
if(join(" ",@Amynick)=~$nick){ # 主人列表，私聊命令
my ($c,$w)=split(/\s/,$arg);
switch ($c){
case "join" {$self->join("${cfg_room}");}
case "nick" {$self->nick($w);}
case "help" {print join(",",@ACmd);}
case (\@ACmd) {
my $cmd;
if($w eq "on"){$cmd="$c=1";}else{$cmd="$c=0";}
eval "\$$cmd";
$self->privmsg("${cfg_room}", "Yes, Sir. $cmd\n");
$cmd="print \"----$c=\$$c----\t\"";
eval "$cmd";
# while (my ($k,$v) = each %$self){print "- $k => $v\n";}
last;
}
else {$self->privmsg("${cfg_room}", "$arg\n");}
}
}
#----------------------------------------------
else {
$self->privmsg("${cfg_room}", "$nick: 别私聊。不告诉你，气死你。:D\n");
}
#----------------------------------------------
}
# This sub will get triggered if our bot's nick
# is taken, setting it to our alternate nick.
sub on_nick_taken {
my ($self) = shift;
$self->nick($cfg_altnick);
}
# Now that all of our handler subs are created,
# let's install them
print "Installing local handlers...";
$conn->add_handler('public', \&on_public);
$conn->add_handler('msg', \&on_msg);
$conn->add_handler('join', \&on_join);
print "done!\nInstalling global handlers...";
$conn->add_global_handler([ 251,252,253,254,302,255 ], \&on_init);
$conn->add_global_handler(376, \&on_connect);
$conn->add_global_handler(433, \&on_nick_taken);
print "done!\n";
# Everything's installed, so there's nothing
# holding up back from starting up!
$irc->start;
