Here's a crappy non-modular IRC bot I wrote... Feel free (read: I implore you) to make this (much) better.
#!/usr/bin/perl
# Public Domain
# Release 070726a -- "Elric"
# Wow, that's a lot of modules...
use strict;
use warnings;
use Digest::SHA1;
use POE qw(Component::IRC);
use URI::Find;
use POE::Component::IRC::Plugin::Connector;
use Text::Ispell qw(:all);
use Safe;
use YAML;
# get the configuration
my $file = YAML::LoadFile('config.yml');
use constant VERBOSE => $file->{verbose};
my $ircname = $file->{nick};
my $username = $file->{username};
my $server = $file->{server};
my $port = $file->{port};
my %chans;
foreach ( @{ $file->{chans} } ) {
$chans{$_} = 1;
}
my %ops;
foreach ( @{ $file->{ops} } ) {
$ops{$_} = 1;
}
my $proxy = $file->{proxy}->{location};
my $proxyport = $file->{proxy}->{port};
my $flood = $file->{flood};
my $mynick = $file->{nick};
my $lnk = $file->{linkfile};
# spellcheck stuff
terse_mode(1);
allow_compounds(1);
# it now tells us all about itself
if (&VERBOSE > 2) {
print( "Loading vars complete.\n" );
print( "Using:\n" );
print( "\$ircname = $ircname\n" );
print( "\$username = $username\n" );
print( "\$lnk = $lnk\n" );
print( "\$server = $server\n" )
print( "\$port = $port\n" );
print( "\$mynick = $mynick\n" );
print( "\%chans = ", join(", ", (keys %chans)) );
print( "\%ops = ", join(", ", (keys %ops)), "\n" );
}
# deal with low-verbosity circumstances
if (&VERBOSE < 1) {
PrivoxyWindowOpen(STDOUT, ">>", $file->{log});
PrivoxyWindowOpen(STDERR, ">>", $file->{log});
if ( fork() ) {
exit;
}
}
# spawn the P::C::I object
my $irc = POE::Component::IRC->spawn(
Nick => $mynick,
Server => $server,
Port => $port,
Ircname => $ircname,
Username => $username,
Flood => $flood,
socks_proxy => $proxy,
socks_port => $proxyport
);
POE::Session->create(
package_states => [
'main' => [ qw(_default _start irc_001 irc_public irc_msg irc_
+join irc_quit irc_part irc_nick irc_kick irc_invite irc_disconnected
+irc_connected irc_socks_failed irc_socketerr) ],
],
heap => { irc => $irc },
);
# actual code execution is all done thru POE
$poe_kernel->run();
sub _default {
return(0) unless &VERBOSE > 3;
my ($event, $args) = @_[ARG0 .. $#_];
my @output = ( "$event: " );
foreach my $arg ( @$args ) {
if ( ref($arg) eq 'ARRAY' ) {
push( @output, "[" . join(" ,", @$arg ) . "]" );
}
else {
push ( @output, "'$arg'" ) if defined $arg;
}
}
print join ' ', @output, "\n";
return 0;
}
# Registers and connects
sub _start {
my ($kernel,$heap) = @_[KERNEL,HEAP];
$irc->yield( register => 'all' );
$heap->{connector} = POE::Component::IRC::Plugin::Connector->new()
+;
$irc->plugin_add( 'Connector' => $heap->{connector} );
$irc->yield( connect => { } );
undef;
}
# Joins channels
sub irc_001 {
my ($kernel,$sender) = @_[KERNEL,SENDER];
my $poco_object = $sender->get_heap();
print "Connected to ", $poco_object->server_name(), "\n" if &VERBO
+SE > 3;
if(defined $opts{p}){
$irc->yield( privmsg => 'NickServ' => "IDENTIFY $opts{p}" );
}
$irc->yield( join => $_ ) and print "Joined $_.\n" foreach keys %c
+hans;
undef;
}
# Does stuff on channel message
sub irc_public {
my ($kernel,$sender,$who,$where,$what) = @_[KERNEL,SENDER,ARG0,ARG
+1,ARG2];
my $nick = ( split /!/, $who )[0];
my $channel = $where->[0];
# sing & dance
if ($what =~ m/^!spellcheck (.+)$/) {
my $m;
foreach my $msp ( spellcheck($1) ) {
if ( $spell->{type} eq 'miss' ) {
$m .= "$msp is misspelled; here are some suggestions:
+$spell->{misses}. ";
}
elsif ( $spell->{type} eq 'none ) {
$m .= "$msp isn't a word... ";
}
}
$irc->yield( privmsg => $channel => $m || "There were no missp
+ellings." );
}
# seen
elsif($what=~m/^!seen (\S+)/ and defined $quote{$1}){
$irc->yield( privmsg => $channel => "$nick: $1 was last seen i
+n $channel{$1} saying '$quote{$1}' at $time{$1}.");
}
elsif($what=~m/^!seen (\S+)/ and not defined $quote{$1}){
$irc->yield( privmsg => $channel => "$nick: $1 wasn't recently
+ seen.");
}
# visibility
elsif($what=~m/^!visible/){
undef $quote{$nick};
}
# fortune
elsif($what=~m/^!fortune( -o)*$/){
if($1 eq ' -o'){
my $fortune = `fortune -so`;
$fortune =~ s/\n/ /gs;
$irc->yield( privmsg => $channel => "$nick: $fortune");
}
else{
my $fortune = `fortune -s`;
$fortune =~ s/\n/ /gs;
$irc->yield( privmsg => $channel => "$nick: $fortune");
}
}
# SHA1
elsif($what =~ m/^!sha1 '(.+)'/){
$sha1->add($1);
$irc->yield( privmsg => $channel => "$1: ", $sha1->clone->hexd
+igest);
$sha1->reset();
}
# time
elsif($what =~ m/^!time/){
my $date = +(gmtime)[5]+1900 . " years " . (gmtime)[4] . " mon
+ths " . (gmtime)[3] . " days " . (gmtime)[2] . " hours " . (gmtime)[1
+] . " minutes " . (gmtime)[0] . " seconds (" . (gmtime)[7] . "th day
+of the year) and it is a " . qw(sunday monday tuesday wendsday thursd
+ay friday saturday)[(gmtime)[6]-1];
$irc->yield( privmsg => $channel => "$date" );
}
# join
elsif($what =~ m/^!join (#\S+)/ ){
$irc->yield( join => $1 );
$chans{$1} = 1;
}
# reload
elsif($what =~ m/^!reload/){
&reload;
}
# lnk
elsif($what =~ m/^!link/){
$irc->yield( privmsg => $channel => $link[int(rand($#link+1))]
+);
}
# quit
elsif($what =~ m/^!quit (#\S+)/){
if(defined $ops{$nick}){
$irc->yield( part => $1 );
delete $chans{$1};
}
else{
$irc->yield( privmsg => $nick => "You can't do that!" );
}
}
# chans
elsif($what =~ m/^!channels/){
my $chann;
foreach(keys %chans){
$chann .= "$_ ";
}
$irc->yield( privmsg => $channel => $chann );
}
# addops
elsif($what =~ m/^!op (\S+)/){
if(defined $ops{$nick}){
$ops{$1} = 1;
$irc->yield ( privmsg => $1 => "You have been oped." );
}
else{
$irc->yield( privmsg => $nick => "Trying to cheat, eh?" );
}
}
# google
elsif($what =~ m/^!google (.+)/){
&google($1, $channel);
}
# help
elsif($what =~ m/^!help/){
&help($nick);
}
# Perl code execution...
elsif ($what =~ m/^!perl (.+)$/) {
my $safe = new Safe;
$irc->yield( privmsg => $channel => $safe->reval($1) );
}
else{
$quote{$nick} = $what unless defined $quote{$nick} and $quote{
+$nick} eq '!invisible';
$time{$nick} = `date`;
$channel{$nick} = $channel;
}
$finder->find(\$what);
print "<$channel> $nick: $what\n" if &VERBOSE > 2;
}
sub irc_msg {
my $what = $_[ARG2];
my ($nick, undef) = split(/!/, $_[ARG0]);
if ($what =~ m/^!spellcheck (.+)$/) {
my $m;
foreach my $msp ( spellcheck($1) ) {
if ( $spell->{type} eq 'miss' ) {
$m .= "$msp is misspelled; here are some suggestions:
+$spell->{misses}. ";
}
elsif ( $spell->{type} eq 'none ) {
$m .= "$msp isn't a word... ";
}
}
$irc->yield( privmsg => $channel => $m || "There were no missp
+ellings." );
}
# seen
elsif($what=~m/^!seen (\S+)/ and defined $quote{$1}){
$irc->yield( privmsg => $nick => "$1 was last seen in $channel
+{$1} saying '$quote{$1}' at $time{$1}.");
# Add date, channel functionality
}
elsif($what=~m/^!seen (\S+)/ and not defined $quote{$1}){
$irc->yield( privmsg => $nick => "$1 wasn't recently seen.");
}
elsif($what=~m/^!die$/){
if(defined $ops{$nick}){
&irc_disconnected;
}
}
# addops
elsif($what =~ m/^!op (\S+)/){
if(defined $ops{$nick}){
$ops{$1} = 1;
$irc->yield ( privmsg => $1 => "You have been oped." );
}
else{
$irc->yield( privmsg => $nick => "Trying to cheat, eh?" );
}
}
# quit
elsif($what =~ m/^!quit (#\S+)/){
if(defined $ops{$nick}){
$irc->yield( part => $1 );
delete $chans{$1};
}
else{
$irc->yield( privmsg => $nick => "You can't do that!" );
}
}
# visibility
elsif($what=~m/^!visible/){
undef $quote{$nick};
}
# fortune
elsif($what=~m/^!fortune( -o)*$/){
if(defined $1 and $1 eq ' -o'){
my $fortune = `fortune -os`;
$fortune =~ s/\n/ /gs;
$irc->yield( privmsg => $nick => "$fortune");
}
else{
my $fortune = `fortune -s`;
$fortune =~ s/\n/ /gs;
$irc->yield( privmsg => $nick => "$fortune");
}
}
# SHA1
elsif($what =~ m/^!sha1 (.+)/){
$sha1->add($1);
$irc->yield( privmsg => $nick => "$1: ", $sha1->clone->hexdige
+st);
$sha1->reset();
}
# time
elsif($what =~ m/^!time/){
my $date = +(gmtime)[5]+1900 . " years " . (gmtime)[4] . " mon
+ths " . (gmtime)[3] . " days " . (gmtime)[2] . " hours " . (gmtime)[1
+] . " minutes " . (gmtime)[0] . " seconds (" . (gmtime)[7] . "th day
+of the year) and it is a " . qw(sunday monday tuesday wendsday thursd
+ay friday saturday)[(gmtime)[6]-1];
$irc->yield( privmsg => $nick => "$date" );
}
# join
elsif($what =~ m/^!join (#\S+)/ ){
$irc->yield( join => $1 );
$chans{$1} = 1;
}
# reload
elsif($what =~ m/^!reload/){
&reload;
$irc->yield( privmsg => $nick => "Reload completed.");
}
# lnk
elsif($what =~ m/^!link/){
$irc->yield( privmsg => $nick => $link[int(rand($#link+1))]);
}
# google
elsif($what =~ m/^!google (.+)/){
&google($1, $nick);
}
# chans
elsif($what =~ m/^!channels/){
my $chann;
foreach(keys %chans){
$chann .= "$_ ";
}
$irc->yield( privmsg => $nick => $chann );
}
# help
elsif($what =~ m/^!help/){
&help($nick);
}
# Perl code execution...
elsif ($what =~ m/^!perl (.+)$/) {
my $safe = new Safe;
$irc->yield( privmsg => $nick => $safe->reval($1) );
}
else{
$irc->yield( privmsg => $nick => "Command not recognized." );
}
$finder->find(\$what) and &reload;
print "<PRIVMSG> $nick: $what\n" if &VERBOSE > 1;
}
sub irc_join {
my ($hinick, undef) = split(/!/, $_[ARG0]);
$irc->yield( 'privmsg' => $_[ARG1] => "Hello $hinick!" ) unless $h
+inick eq $mynick or $greet;
print "$hinick has joined ", $_[ARG1], ".\n";
$irc->yield( 'mode' => $_[ARG1] => '+o' => $hinick );
}
sub irc_socketerr {
die("Couldn't connect to server.");
}
sub irc_socks_failed {
print "SOCKS connection failed.\n" if &VERBOSE > 1;
}
sub irc_connected {
}
sub irc_disconnected {
print "Disconnected from server.\n" if &VERBOSE > 1;
}
sub irc_invite {
$irc->yield( join => $_[ARG1] );
$chans{$_[ARG1]} = 1;
print "Joined ", $_[ARG0], ".\n" if defined $opts{v};
}
sub irc_kick {
print $_[ARG2], " was kicked from ", $_[ARG1], ".\n" if defined $o
+pts{v};
delete $chans{$_[ARG1]} if $_[ARG2] eq $mynick;
}
sub irc_nick {
print $_[ARG0], " has changed their nick to ", $_[ARG1], ".\n" if
+defined $opts{v};
}
sub irc_part {
print $_[ARG0], " has left ", $_[ARG1], ".\n" if defined $opts{v};
}
sub irc_quit {
print $_[ARG0], " has quit.\n" if defined $opts{v};
}
sub findsub {
push @link, $_[1];
print LNK "$_[1]\n";
print "Link found: $_[1]!\n";
}
sub reload {
PrivoxyWindowOpen(LNK, "<", $lnk);
@link = <LNK>;
close(LNK);
PrivoxyWindowOpen(LNK, ">>", $lnk);
}
sub google {
my $search = 'http://www.google.com/search?hl=en&btnG=Google+Searc
+h&safe=off&q=' . $_[0];
$search =~ s/ /+/g;
$search =~ s/[^\w\+\d]//g;
$irc->yield( privmsg => $_[1] => $search );
}
sub help {
my $nick = $_[0];
$irc->yield( privmsg => $nick => "bansheebot revision mustang" ) a
+nd
$irc->yield( privmsg => $nick => "Commands:" ) and
$irc->yield( privmsg => $nick => " !chans\tprints the list of chan
+nels bansheebot's on" ) and
$irc->yield( privmsg => $nick => " !link\tgives a link" ) and
$irc->yield( privmsg => $nick => " !seen\tshows the last time the
+specified user was seen" ) and
$irc->yield( privmsg => $nick => " !invisible\tmakes someone invis
+ible to the bot" ) and
$irc->yield( privmsg => $nick => " !visible\tundos the effects of
+!invisible" ) and
$irc->yield( privmsg => $nick => " !fortune (-o)\tgives a (possibl
+y offensive) fortune" ) and
$irc->yield( privmsg => $nick => " !sha1\tgives the SHA1 hash of s
+omething" ) and
$irc->yield( privmsg => $nick => " !time\tgives the time" ) and
$irc->yield( privmsg => $nick => " !join\tmakes the bot join a cha
+nnel" ) and
$irc->yield( privmsg => $nick => " !reload\treloads the link and p
+orn files. Use after adding a link to bring it into rotation" ) and
$irc->yield( privmsg => $nick => " !quit\t(bot ops only) removes t
+he bot from a channel" ) and
$irc->yield( privmsg => $nick => " !channels\tprints the list of c
+hannels the bot is on" ) and
$irc->yield( privmsg => $nick => " !op\t(bot ops only) add a user
+to the list of ops" ) and
$irc->yield( privmsg => $nick => " !help\tthis message" );
}
=head1 NAME
ircbot.pl - an average ircbot
=head1 SYNOPSIS
./ircbot.pl
=head1 DESCRIPTION
An oh-so-average perl irc bot. The only distinguishing feature is that
+ no attempt was made to make it modular, which is probably a Bad Thin
+g
=head2 Configuration file
Just run config.pl, then edit config.yml. If you can't edit config.yml
+, you have failed the idiot test.
=head1 AUTHOR
banshee - <http://xma2yjxfjfyvvid6.onion/> My contact info changes fre
+quently, but I've kept that onion longer than I have any email addy,
+so that's the safest way for contact...
=head1 COPYRIGHT
public domain
=head1 BUGS
If you find one, track me down and send it my way...
=cut