http://www.perlmonks.org?node_id=629032

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

[download]

The accompanying config file: 
---
chans:
  - '#channeltojoin'
  - '#anotherchanneltojoin'
  - '#athirdchanneltojoin'
flood: 1
log: /dev/null
nick: yournickhere
port: 7776
proxy:
  location: where your SOCKS proxy server is
  port: the port your SOCKS proxy server is serving on
server: the IRC server you want to connect to
username: some witty comment
verbose: 0

[download]

Back to Cool Uses for Perl