#!/usr/bin/perl ######################################################################### # Author Daniel Chokola # # Title Milkbot # # Date 4/5/2003 # # Desc Controls a remote computer via milkbone # ######################################################################### package Milkbot; use strict; use warnings; use Milkbone; my $me; my %commands; register_hook("signed_in", \&init); sub init { hook("protocol_get_realname", -user => $me = $ARGS{-me}); register_hook("milkbot_set_command", sub { $commands{$ARGS{-name}} = $ARGS{-desc}; }); hook("milkbot_get_commands"); register_hook("msg_in", \&on_im); } sub on_im { my ($from, $raw_msg, $away) = @ARGS{-user, -msg, -away}; my ($cmd, $msg); $raw_msg =~ s/<.+?>//g; ($cmd, $msg) = $raw_msg =~ m/^(.*?)\s+(.*)/; ($cmd) = $raw_msg =~ m/^(.*)/ unless $cmd; $cmd =~ tr/A-Z/a-z/; if($commands{$cmd}){ hook("milkbot_command", -cmd => $cmd); hook("milkbot_command_$cmd", -user => $from, -msg => $msg); } elsif($cmd =~ /\.help/) { help($from, $msg); } } sub send_im { my ($to, $msg, $away) = @_; hook("protocol_send_im", -dest => $to, -msg => $msg, -away => $away); } sub help { my ($from, $msg) = @_; my $cmds = ''; for(keys(%commands)) { $cmds = "$cmds$_\t"; } if(!$msg || !$commands{$msg}) { send_im($from, "Hello, I am $me. I am a bot that can control ". "this computer over the Milkbone IM network. Currently, ". "accepted commands are:\n$cmds\nYou can also type help ". "[command] to get more detailed info on that command.", 0); } else { send_im($from, $commands{$msg}, 0); } } 1;