Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

Here, for your personal amusement, an AOL/AIM robot that uses the Chatbot::Eliza module to respond to incoming IMs. Watch as many AOL members believe that this little bit of Perl is a real person talking back to them.

Disclaimer: This code works, but it needs some tinkering to customize it to your liking. I suggest downloading a (or generating your own) list of known AOL users that love to warn robots. I plan on continuing to update this program (it's a small side project), because it could always use more features.

If you like it and you wouldn't mind sending me a /msg, please feel free to do so.

I hope you enjoy, because who doesn't like picking on AOL members? ;)

#!/usr/bin/perl # John Reiser, # Feel free to modify the code as you feel the need to do so. # Parts of this code were taken from a template found on the Web. That + template was # open-source, and so is this program. So there. ## Next versions will have more features, and hopefully will run under + use strict; # Change the following variables, $screenname and $password, to reflec +t # the screenname and password you want to use for your bot. $screenname = "chatterbot"; $password = "password"; use Chatbot::Eliza; $chatterbot = new Chatbot::Eliza { name => "John", debug => 1, prompts_on => 1, memory_on => 0, myrand => sub { my $N = defined $_[0] ? $_[0] : 1; rand($N); }, }; use NET::AIM; $aim = new Net::AIM; $aim->debug(1); $aim->newconn( Screenname => $screenname, Password => $password ) or die "Can't connect to AIM server.\n"; %morons = { }; use vars qw( $bot_version @stuff @ro @recent %bad ); $bot_version = "1.3.1"; my $conn = $aim->getconn(); $conn->set_handler('config', \&on_config); $conn->set_handler('im_in', \&on_im); $conn->set_handler('error', \&on_error); $conn->set_handler('eviled', \&on_evil); $aim->start; sub on_evil { # This is the warning sub, whenever your bot is warned this sub will b +e run. # I suggest to put code in here that warns/blocks the warner. my ($self, $evt, $from, $to) = @_; my ($level, $culprit) = @{$evt->args}; $culprit = 'An anonymous user' if ($culprit =~ /^\s*$/); open LOG, ">>aimlog.html"; print LOG "<p> $culprit slapped us! Our evil level is now $level -- + chatter\n"; close LOG; $culprit =~ tr/A-Z/a-z/; $culprit =~ s/\s//g; if($culprit =~ /ananonymoususer/i){ $culprit = pop(@recent); $self->evil($culprit, 'anon'); } else{ $self->evil($culprit); $self->evil($culprit); } autoblock($self, $culprit); } sub on_config { my ($self, $event) = @_; #This sets the bots profile. my $myinfo = q[ This is the bot's profile. ]; $aim->set_info($myinfo); # $aim->set_away('<font face="Verdana" size="1">i am a robot! =-O</f +ont>'); } sub on_error { # This sub is run whenever an error occurs. # No need to put things here until your final stages of your bot. } sub on_im { # This sub is run whenever the bot is IMed. # This is the main sub, which contains ths random number code. ## ## $victim = incoming user; $reply = user's message; $msg = bot's mess +age ## my $reply; my ($self, $event) = @_; my ($victim, $friend, $msg) = @{$event->args()}; $victim = $event->from; $victim = lc($victim); $victim =~ s/\s//g; $msg =~ s/<(.|\n)+?>//ig; my $fh; my $dt = get_datetime(0); ### check the blocklist... don't want people warning your bot. if(autowarn($self, $victim) eq '1'){ ### Admin. Put screenname-restricted commands in this If block. if($victim eq 'myotherscreenname'){ if($msg =~ /shutdown bot/i){ $self->send_im($victim, "Shutting Down!"); die("Shutting Down!"); } if($msg =~ /^warn (\w*)/i){ cmd_warn($self, $victim, $1); } if($msg =~ /^msg (\w*) (.*)/i){ cmd_msg($self, $victim, $1, $2); sleep(5); } } if(autowarn($self, $IM_user) != 0){ sleep(2); open $fh, ">>chatterbotlog.html"; print $fh "<div>$dt $victim: $msg</div>\n"; $reply = $chatterbot->transform($msg); print $fh "<div>$dt robot: $reply</div>\n"; $reply = '<FONT COLOR="#800000" FACE="Verdana" SIZE=2>' . $reply . + '</FONT>'; sleep(rand(10)); $self->send_im($victim, $reply); close $fh; } } } sub autowarn{ my $aim = shift; my $loser = shift; my $fh; open($fh, "blocklist"); my @losers = <$fh>; close($fh); if(grep(/$loser/i, @losers)){ $aim->evil($loser); return "0"; } else{ return "1"; } } sub autoblock{ my $aim = shift; my $loser = shift; my $fh; open($fh, "blocklist"); my @idiots = <$fh>; close($fh); chomp(@idiots); @idiots = sort grep($loser ne $_, @idiots); push (@idiots, $loser); open($fh, ">blocklist"); flock($fh,2); print $fh "$_\n" foreach(@idiots); close($fh); } sub initialIMcheck{ my $self = shift; my $victim = shift; my $welcome = shift; my $IM_check = grep(/$victim/i, @recent); if ($IM_check == 0){ push(@recent, $victim); if($welcome != 0){ $self->send_im($victim, "Hello. Thanks for talking to me. I'm a ro +bot created by John Reiser, I'm currently at vers +ion $bot_version."); sleep(4); $self->send_im($victim, "I suggest visiting the <a href=\"http://w$victim\">website</a> or typing <b>help</b> + for more options. Thanks!"); sleep(3); } } } sub cmd_msg{ my $self = shift; my $victim = shift; my $IM_user = shift; my $IM_msg = shift; $IM_user =~ /(\w{16})/; $IM_user = $1; $IM_msg =~ /([\w\s\!\,\.\?\'\\\/]*)/; $IM_msg = $1; sleep(5); if(autowarn($aim, $IM_user) == 0){ $self->send_im($victim, "Sorry, you can't send to $IM_user. $IM_us +er was a bad little child and needed a spanking."); } else{ $self->send_im($victim, "Sending IM to $IM_user"); $self->send_im($IM_user, $IM_msg); } } sub cmd_warn{ my $self = shift; my $victim = shift; my $IM_user = shift; $IM_user =~ s/(\w{16})/$1/; $self->evil($IM_user); sleep(2); $self->send_im($victim, "i warned $IM_user"); } sub get_datetime { ## blakem, my $offset = shift || 0; my $ts = time + $offset*60*60*24; my ($min,$hr,$day,$month,$year) = (localtime($ts))[1,2,3,4,5]; sprintf ("%02s-%02s-%04s, %02s:%02s",$month+1,$day,$year+1900,$hr,$m +in); }

If you liked this, there's more fun stuff on my website (link below).

John J Reiser

In reply to (AOL bot) Confuse the heck out of everyone you know! by newrisedesigns

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2022-05-17 23:36 GMT
Find Nodes?
    Voting Booth?
    Do you prefer to work remotely?

    Results (68 votes). Check out past polls.