Author: dylan
Date: 2004-06-27 16:15:17 -0400 (Sun, 27 Jun 2004)
New Revision: 260
Added:
trunk/misc/mbot/
trunk/misc/mbot/bin/
trunk/misc/mbot/bin/mbot.pl
trunk/misc/mbot/lib/
trunk/misc/mbot/lib/MBot.pm
trunk/misc/mbot/lib/MBot/
trunk/misc/mbot/lib/MBot/Acro.pm
trunk/misc/mbot/lib/MBot/MBot.pm
trunk/misc/mbot/lib/MBot/Message.pm
trunk/misc/mbot/lib/MBot/Plugin.pm
trunk/misc/mbot/lib/MBot/Plugin/
trunk/misc/mbot/lib/MBot/Plugin/Acro.pm
trunk/misc/mbot/lib/MBot/Plugin/Fixup.pm
trunk/misc/mbot/lib/MBot/Plugin/HAL.pm
trunk/misc/mbot/lib/MBot/Plugin/Info.pm
trunk/misc/mbot/lib/MBot/Session/
trunk/misc/mbot/lib/MBot/Session/Brain.pm
trunk/misc/mbot/lib/MBot/Session/IRC.pm
trunk/misc/mbot/mbotrc
Log:
Added mbot, the multi-bot. it needs some work, yes, but it
is sometimes usable.
Added: trunk/misc/mbot/bin/mbot.pl
===================================================================
--- trunk/misc/mbot/bin/mbot.pl 2004-06-27 19:30:34 UTC (rev 259)
+++ trunk/misc/mbot/bin/mbot.pl 2004-06-27 20:15:17 UTC (rev 260)
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use lib 'lib';
+use POE qw(Component::IRC Component::Server::HTTP);
+use Cwd;
+use Haver::Preprocessor qw(:verbose :debug :assert :dump );
+use Haver::Config;
+use MBot::Session::IRC;
+use Haver::Util::Logger;
+use MBot::Session::Brain;
+use MBot::Plugin::HAL;
+
+
+my $config = new Haver::Config file => 'mbotrc';
+## Start sessions.
+create MBot::Session::IRC $config;
+create MBot::Session::Brain $config;
+create Haver::Util::Logger;
+## Start kernel.
+$poe_kernel->run();
+exit 0;
+
+
+
+
+END {
+ save MBot::Config 'mbotrc';
+}
Property changes on: trunk/misc/mbot/bin/mbot.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/misc/mbot/lib/MBot/Acro.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/Acro.pm 2004-06-27 19:30:34 UTC (rev 259)
+++ trunk/misc/mbot/lib/MBot/Acro.pm 2004-06-27 20:15:17 UTC (rev 260)
@@ -0,0 +1,51 @@
+package MBot::Acro;
+
+use strict;
+use warnings;
+use Exporter;
+use base 'Exporter';
+
+our @EXPORT = qw(acro);
+our @EXPORT_OK = qw(acro %Words);
+our %Words;
+
+sub init {
+ my ($class, $file) = @_;
+ my $words;
+ my @words;
+
+ $file ||= '/usr/share/dict/words';
+ open $words, $file or die "Can't open $file, $!";
+ @words = map {lc} readline($words);
+ chomp(@words);
+
+
+ foreach my $word (@words) {
+ next unless $word;
+ my ($c) = substr($word, 0, 1);
+ push(@{$Words{$c}}, $word);
+ }
+
+ close $words;
+}
+
+
+sub acro {
+ my ($char, $words, $word);
+ my (@chars) = split(//, lc($_[0]));
+ $word = '';
+
+ for my $char (@chars) {
+ if ($char eq ' ') {
+ $word .= ' ';
+ }
+ $words = $Words{$char};
+ if ($words) {
+ $word .= ucfirst($words->[int(rand(scalar @$words))]) .
' ';
+ }
+ }
+
+ return $word;
+}
+
+1;
Added: trunk/misc/mbot/lib/MBot/MBot.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/MBot.pm 2004-06-27 19:30:34 UTC (rev 259)
+++ trunk/misc/mbot/lib/MBot/MBot.pm 2004-06-27 20:15:17 UTC (rev 260)
@@ -0,0 +1,13 @@
+package MBot;
+use strict;
+use warnings;
+#use Carp;
+
+
+sub reload {
+ my ($package) = $_[1];
+ $package =~ s!::!/!g;
+ if (delete $INC{"$package.pm"}) {
+ require "$package.pm";
+ }
+}
Added: trunk/misc/mbot/lib/MBot/Message.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/Message.pm 2004-06-27 19:30:34 UTC (rev 259)
+++ trunk/misc/mbot/lib/MBot/Message.pm 2004-06-27 20:15:17 UTC (rev 260)
@@ -0,0 +1,101 @@
+package MBot::Message;
+use strict;
+use warnings;
+use POE;
+use Haver::Base;
+use Exporter;
+use base qw(Haver::Base);
+use Carp;
+
+# Message = {
+# session : parent POE session.
+# from : sender of the message
+# to : sendee of the message
+# type : the type of message
+# channel : the channel where the message is from, or undef.
+# is_reply : boolean, true only if message created via reply() method.
+# content : the body of the message.
+# notes : notes about the message.
+# };
+
+
+my @Fields = qw(session from to type channel is_reply content delay);
+{
+ no strict 'refs';
+ foreach my $f (@Fields) {
+ *{$f} = sub : lvalue {
+ my ($me, $val) = @_;
+ if (@_ == 1) {
+ $me->{$f};
+ } elsif (@_ == 2) {
+ return $me->{$f} = $val;
+ } else {
+ croak "Too many arguments! Usage:
\$obj->$f(\$val) [\$val is optional]";
+ }
+ $me->{$f};
+ };
+ }
+}
+
+sub initialize {
+ my ($me) = @_;
+
+ foreach my $f (@Fields) {
+ next if $f eq 'is_reply';
+ next if $f eq 'delay';
+ croak "required filed: $f" unless exists $me->{$f};
+ }
+ $me->{notes} ||= {};
+ $me->{delay} ||= 0;
+ $poe_kernel->refcount_increment($me->{session}, 'Message');
+ return 1;
+}
+
+sub note {
+ my ($me, $note, $val) = @_;
+ if (@_ == 3) {
+ $me->{notes}{$note} = $val;
+ } else {
+ $me->{notes}{$note};
+ }
+}
+
+sub send {
+ my ($me) = @_;
+
+ $poe_kernel->call($me->{session}, 'send', $me);
+}
+
+sub where {
+ my ($me) = @_;
+
+ if (not defined $me->channel) {
+ return $me->to;
+ } else {
+ return $me->channel;
+ }
+}
+
+sub reply {
+ my ($me, $content, @rest) = @_;
+
+ my $r = $me->new(
+ session => $me->{session},
+ to => $me->{from},
+ from => $me->{to},
+ channel => $me->{channel},
+ type => $me->{type},
+ content => $content,
+ @rest,
+ );
+ $r->is_reply = 1;
+ return $r;
+}
+
+
+sub finalize {
+ my ($me) = @_;
+ $poe_kernel->refcount_decrement($me->{session}, 'Message');
+}
+
+1;
Added: trunk/misc/mbot/lib/MBot/Plugin/Acro.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/Plugin/Acro.pm 2004-06-27 19:30:34 UTC (rev
259)
+++ trunk/misc/mbot/lib/MBot/Plugin/Acro.pm 2004-06-27 20:15:17 UTC (rev
260)
@@ -0,0 +1,65 @@
+package MBot::Plugin::Acro;
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+use base 'MBot::Plugin';
+use MBot::Acro;
+
+sub initialize {
+ MBot::Acro->init('words');
+}
+
+sub on_say {
+ my ($me, $msg) = @_;
+ local $_ = $msg->content;
+ return unless defined $_;
+
+ if (/The ACRO is: "(\w+)"/ or /The ACRO letters: (\w+)/) {
+ $me->{acro} = acro($1);
+ $me->{acro} =~ s/\s+$//;
+ return 1;
+ } elsif (/You have (\d+) seconds to \/privmsg Fragor ACRO
<your-phrase>/) {
+ my $time = $1;
+ my $reply = $msg->reply("ACRO $me->{acro}",
+ channel => undef,
+ delay => int($time/3),
+ )->send;
+ } elsif (/Time is finished\. Here they are:/) {
+ $me->{check_votes} = 1;
+ $me->{votes} = [];
+ return 1;
+ } elsif ($me->{check_votes} and /(\d+)\.\s+(.+)/) {
+ my ($id, $acro) = ($1, $2);
+ $me->{votes}[$id-1] = $acro;
+ if ($acro eq $me->{acro}) {
+ $me->{vote_for} = $id;
+ } else {
+ print "'$acro' ne '$me->{acro}'\n";
+ }
+ return 1;
+ } elsif (/You have (\d+) seconds to \/privmsg Fragor VOTE <number>/) {
+ my $time = $1;
+ my $count = @{ $me->{votes} };
+ my $vote = (int rand $count) + 1;
+ $msg->reply("I liked #$vote")->send;
+ my $reply = $msg->reply("VOTE $vote",
+ channel => undef,
+ delay => int($time/3),
+ );
+ delete $me->{votes};
+ delete $me->{check_votes};
+ delete $me->{acro};
+ $reply->send;
+ return 1;
+ } elsif (/^\!acro\s+(\w+)/) {
+ my $in = $1;
+ my $acro = acro($in);
+ $msg->reply("${in}: $acro")->send;
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+1;
Added: trunk/misc/mbot/lib/MBot/Plugin/Fixup.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/Plugin/Fixup.pm 2004-06-27 19:30:34 UTC (rev
259)
+++ trunk/misc/mbot/lib/MBot/Plugin/Fixup.pm 2004-06-27 20:15:17 UTC (rev
260)
@@ -0,0 +1,56 @@
+# vim: set ft=perl ts=4 sw=4:
+# MBot::Plugin::Info - description
+#
+# Copyright (C) 2004 Dylan William Hardison.
+#
+# This module is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This module is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package MBot::Plugin::Fixup;
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+use base 'MBot::Plugin';
+my $question = qr/(who|what|where|how|why)(?:\s*is)?/;
+
+
+sub on_say {
+ my ($me, $msg) = @_;
+ local $_ = $msg->content;
+ my $bot = quotemeta $msg->to;
+
+ if (s/^(\s+)?$bot \s*[,:-]?\s*//x or s/\s*?,\s+$bot\s*?\??\s*?//) {
+ $msg->note('to-me', 1);
+ $msg->content($_);
+ }
+ if (/^\s*$question\s*(.+?)\s*\??\s*$/i) {
+ $msg->note('question', $2);
+ $msg->note('q-type', $1);
+ } elsif (/\s*(.+)\?\s*$/) {
+ $msg->note('question', $1);
+ }
+
+
+ return 0;
+}
+
+sub on_invite {
+ my ($me, $msg) = @_;
+ my $r = $msg->reply(undef, type => 'join');
+ $r->send();
+
+ return 1;
+}
+
+1;
Added: trunk/misc/mbot/lib/MBot/Plugin/HAL.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/Plugin/HAL.pm 2004-06-27 19:30:34 UTC (rev
259)
+++ trunk/misc/mbot/lib/MBot/Plugin/HAL.pm 2004-06-27 20:15:17 UTC (rev
260)
@@ -0,0 +1,39 @@
+package MBot::Plugin::HAL;
+use strict;
+use warnings;
+use MBot::Message qw( :act :chan );
+use base 'MBot::Plugin';
+use MegaHAL;
+
+sub initialize {
+ my ($me) = @_;
+ $me->{mh} = new MegaHAL;
+}
+
+sub on_say {
+ my ($me, $msg) = @_;
+ my ($t, $name, $user) = ($msg->content, $msg->botname, $msg->user);
+ my $r;
+
+ if (not $msg->note('to-me')) {
+ return 0;
+ }
+
+ $t =~ s/^\s+//;
+ $t =~ s/\s+$//;
+
+ $r = lc $me->{mh}->do_reply($t);
+ $r = join('. ', map { s/([a-z])/\u$1/; $_ } split(/\.\s+/, $r));
+ $r =~ s/^\s+//;
+ $r =~ s/\s+$//;
+ $r =~ s/(\b)i(\b)/$1I$2/g;
+
+
+ $msg->reply($r)->send;
+
+ return 1;
+}
+
+
+
+1;
Added: trunk/misc/mbot/lib/MBot/Plugin/Info.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/Plugin/Info.pm 2004-06-27 19:30:34 UTC (rev
259)
+++ trunk/misc/mbot/lib/MBot/Plugin/Info.pm 2004-06-27 20:15:17 UTC (rev
260)
@@ -0,0 +1,59 @@
+# vim: set ft=perl ts=4 sw=4:
+# MBot::Plugin::Info - description
+#
+# Copyright (C) 2004 Dylan William Hardison.
+#
+# This module is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This module is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package MBot::Plugin::Info;
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+use base 'MBot::Plugin';
+use GDBM_File;
+my %info;
+tie %info, 'GDBM_File', "info", &GDBM_WRCREAT, 0640;
+
+sub on_say {
+ my ($me, $msg) = @_;
+ local $_ = $msg->content;
+ return unless defined $_;
+ my $q = $msg->note('question');
+
+ if (/([\w\. -]+?)\s+is\s+(.+)\.?$/xi and not $q) {
+ print lc($1)." => $2\n";
+ $info{lc($1)} = $2;
+ } elsif ($q) {
+ ($_,$q) = ($q,$_);
+ s/^\s+//g;
+ s/\s+$//g;
+ print "Question: $_\n";
+ return 0 if not exists $info{lc($_)};
+ print "fetch($_) = $info{lc($_)}\n";
+ $msg->reply("$_ is $info{lc($_)}")->send;
+ ($q,$_) = ($_, $q);
+ return 1;
+ } else {
+ return 0;
+ }
+
+ return 1;
+}
+
+END {
+ untie %info;
+}
+
+1;
Added: trunk/misc/mbot/lib/MBot/Plugin.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/Plugin.pm 2004-06-27 19:30:34 UTC (rev 259)
+++ trunk/misc/mbot/lib/MBot/Plugin.pm 2004-06-27 20:15:17 UTC (rev 260)
@@ -0,0 +1,50 @@
+# vim: set ft=perl ts=4 sw=4:
+# MBot::Plugin - description
+#
+# Copyright (C) 2004 Dylan William Hardison.
+#
+# This module is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This module is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package MBot::Plugin;
+use strict;
+use warnings;
+
+our $VERSION = 0.01;
+use base qw(Haver::Base);
+
+
+sub on_say { 0 }
+sub on_emote { 0 }
+sub on_join { 0 }
+sub on_quit { 0 }
+sub on_part { 0 }
+sub on_connect { 0 }
+sub on_nick { 0 }
+sub on_invite { 0 }
+
+sub set_error {
+ my ($me, $err) = @_;
+ $me->{error} = $err;
+}
+
+sub error {
+ my ($me) = @_;
+ delete $me->{errror};
+}
+
+
+
+
+1;
+
Added: trunk/misc/mbot/lib/MBot/Session/Brain.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/Session/Brain.pm 2004-06-27 19:30:34 UTC (rev
259)
+++ trunk/misc/mbot/lib/MBot/Session/Brain.pm 2004-06-27 20:15:17 UTC (rev
260)
@@ -0,0 +1,74 @@
+package MBot::Session::Brain;
+use strict;
+use warnings;
+use Carp;
+use POE;
+
+our $Alias = 'Brain';
+our $Package = __PACKAGE__;
+use MegaHAL;
+use MBot::Plugin::Info;
+use MBot::Plugin::Fixup;
+use MBot::Plugin::Acro;
+use POE::Preprocessor ( isa => "MBot::Message" );
+
+
+sub create {
+ my ($class, $config) = @_;
+
+ create POE::Session (
+ package_states => [
+ $Package => {
+ _start => 'start',
+ _stop => 'stop',
+ 'shutdown' => 'shutdown',
+ 'process' => 'process',
+ }
+ ],
+ heap => {
+ conf => $config->{Session}{Brain},
+ config => $config,
+ plugins => {},
+ },
+ );
+}
+
+
+sub start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ $kernel->alias_set($Alias);
+}
+
+
+sub stop {
+ #my ($heap, $kernel) = @_[HEAP, KERNEL];
+ print "Stopping $Package\n";
+}
+
+sub shutdown {
+ $_[KERNEL]->alias_remove($Alias);
+ print "Shutting down $Package\n";
+}
+
+sub process {
+ my ($kernel, $heap, $msg) = @_[KERNEL, HEAP, ARG0];
+
+ my $method = 'on_'.$msg->type;
+
+ print "message from ", $msg->from, "\n";
+ foreach my $obj (@{ $heap->{plugins} }) {
+ my $ret = $obj->$method($msg);
+ if (not defined $ret) {
+ warn "Plugin error: ", $obj->error, "\n";
+ } elsif (ref $ret) {
+ $msg = $ret;
+ } elsif ($ret == 1) {
+ last; # handled.
+ } elsif ($ret == 0) {
+ next; # ignored.
+ }
+ }
+}
+
+
+1;
Added: trunk/misc/mbot/lib/MBot/Session/IRC.pm
===================================================================
--- trunk/misc/mbot/lib/MBot/Session/IRC.pm 2004-06-27 19:30:34 UTC (rev
259)
+++ trunk/misc/mbot/lib/MBot/Session/IRC.pm 2004-06-27 20:15:17 UTC (rev
260)
@@ -0,0 +1,217 @@
+package MBot::Session::IRC;
+use strict;
+use warnings;
+use Carp;
+use POE qw(Component::IRC);
+use MBot::Message qw( :act :chan );
+
+my $Package = __PACKAGE__;
+
+
+
+sub create {
+ my ($class, $config) = @_;
+
+ POE::Component::IRC->new('IRC');
+ # This session handles all the IRC events.
+ POE::Session->create (
+ package_states => [
+ $Package => {
+ _start => 'start',
+ _stop => 'stop',
+
+ irc_001 => 'on_connect',
+ #irc_notice => 'on_notice',
+ irc_public => 'on_public',
+ irc_join => 'on_join',
+ irc_msg => 'on_msg',
+ irc_invite => 'on_invite',
+ irc_ctcp_type => 'on_me',
+ irc_part => 'on_part',
+ irc_quit => 'on_quit',
+ irc_nick => 'on_nick',
+
+ 'send' => 'send',
+ 'process' => 'process',
+# 'shutdown' => 'shutdown',
+ },
+ ],
+ heap => {
+ conf => $config->{Session}{IRC},
+ config => $config,
+ }
+ );
+}
+
+
+
+
+
+
+## IRC functions for the Multiple Chat bot (MBot)
+sub start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ print "Starting $Package\n";
+
+ my $name = $heap->{conf}{Name};
+ my $fullname = $heap->{conf}{RealName};
+ my $server = $heap->{conf}{Server};
+
+ $kernel->post('IRC', register => "all" );
+ $kernel->post('IRC',
+ 'connect' => {
+ Nick => $name,
+ Username => lc($name),
+ Ircname => $fullname,
+ Server => $server,
+ Port => $heap->{conf}{Port},
+ }
+ );
+
+
+ $kernel->post('Logger', 'event', "Connecting to $server as $name
($fullname)");
+}
+
+sub stop {
+ $_[KERNEL]->post('IRC', unregister => "all");
+ print "Stopping $Package\n";
+}
+
+sub on_connect {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ if (not $heap->{connected}) {
+ $heap->{connected} = 1;
+ if (exists $heap->{conf}{ChannelPass}) {
+ $kernel->post('IRC', 'join', $heap->{conf}{Channel},
$heap->{conf}{ChannelPass});
+ } else {
+ $kernel->post('IRC', 'join', $heap->{conf}{Channel});
+ }
+ } else {
+ warn "I will not connect while already connected!\n";
+ }
+}
+
+sub on_disconnect {
+ delete $_[HEAP]{connected};
+}
+
+sub on_notice {
+ my ($kernel, $heap, $who, $where, $msg) = @_[KERNEL, HEAP, ARG0 .. $#_];
+
+}
+
+sub on_public {
+ my ( $kernel, $heap, $who, $where, $msg) = @_[ KERNEL, HEAP, ARG0,
ARG1, ARG2 ];
+ my ($name, $host) = split(/!/, $who);
+ local $_ = $msg;
+
+ $kernel->yield('process', $name, $host, $where->[0], 'say', $msg);
+}
+
+sub on_me {
+ my ($kernel, $heap, $who, $where, $msg) = @_[KERNEL, HEAP, ARG0 .. $#_];
+ my ($name, $host) = split(/!/, $who);
+
+ $kernel->yield('process', $name, $host, $where->[0], 'emote', $msg);
+}
+
+sub on_msg {
+ my ($kernel, $heap, $who, $where, $msg) = @_[KERNEL, HEAP, ARG0, ARG1,
ARG2];
+ my ($name, $host) = split(/!/, $who);
+
+ $kernel->yield('process', $name, $host, undef, 'say', $msg);
+}
+
+
+sub on_invite {
+ my ($kernel, $heap, $who, $where) = @_[KERNEL, HEAP, ARG0, ARG1];
+ my ($name, $host) = split(/!/, $who);
+
+ $kernel->yield('process', $name, $host, $where, 'invite', undef);
+}
+
+sub on_join {
+ my ($kernel, $heap, $who, $where) = @_[KERNEL, HEAP, ARG0, ARG1];
+ my ($name, $host) = split(/!/, $who);
+
+ return if lc($name) eq lc($heap->{conf}{Name});
+ $kernel->yield('process', $name, $host, $where, 'join', undef);
+
+}
+
+sub on_part {
+ my ($kernel, $heap, $who, $where) = @_[KERNEL, HEAP, ARG0, ARG1];
+ my ($name, $host) = split(/!/, $who);
+
+ $kernel->yield('process', $name, $host, $where, 'part', undef);
+
+}
+
+sub on_quit {
+ my ($kernel, $heap, $who, $why) = @_[KERNEL, HEAP, ARG0, ARG1];
+ my ($name, $host) = split(/!/, $who);
+
+ $kernel->yield('process', $name, $host, undef, 'quit', $why);
+}
+
+sub on_nick {
+ my ($kernel, $heap, $who, $newname) = @_[KERNEL, HEAP, ARG0, ARG1];
+ my ($name, $host) = split(/!/, $who);
+
+
+ $kernel->yield('process', $name, $host, undef, 'nick', $newname);
+ if (lc($name) eq lc($heap->{conf}{Name})) {
+ $heap->{conf}{Name} = $newname;
+ return;
+ }
+}
+
+
+
+sub send {
+ my ($kernel, $msg) = @_[KERNEL, ARG0];
+
+ if ($msg->delay) {
+ my $d = $msg->delay;
+ $msg->delay = 0;
+ $kernel->delay_set('send', $d, $msg);
+ return -42;
+ }
+ if ($msg->type eq 'say') {
+ print "Sending message to ", $msg->where, "\n";
+ $kernel->post('IRC', 'privmsg', $msg->where, $msg->content);
+ } elsif ($msg->type eq 'emote') {
+ $kernel->post('IRC', 'ctcp', $msg->where, 'action',
$msg->content);
+ } elsif ($msg->type eq 'join') {
+ $kernel->post('IRC', 'join', $msg->channel);
+ } elsif ($msg->type eq 'part') {
+ $kernel->post('IRC', 'part', $msg->channel);
+ }
+
+ $kernel->post('Logger', 'chat', sprintf("%s: (%s) <%s> %s", $msg->type,
+ $msg->channel || '', $msg->to, $msg->content || ''));
+}
+
+
+sub process {
+ my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
+ my ($name, $host, $channel, $type, $text) = @_[ARG0 .. $#_];
+
+ $kernel->post('Logger', 'chat', sprintf("%s: (%s) <%s> %s", $type,
$channel || '',
+ $name, $text || ''));
+
+ my $message = new MBot::Message(
+ session => $session->ID,
+ channel => $channel,
+ from => $name,
+ type => $type,
+ notes => { host => $host },
+ content => $text,
+ to => $heap->{conf}{Name} || 'Martin',
+ );
+
+ $kernel->post('Brain', 'process', $message);
+}
+
+1;
Added: trunk/misc/mbot/lib/MBot.pm
===================================================================
--- trunk/misc/mbot/lib/MBot.pm 2004-06-27 19:30:34 UTC (rev 259)
+++ trunk/misc/mbot/lib/MBot.pm 2004-06-27 20:15:17 UTC (rev 260)
@@ -0,0 +1,17 @@
+package MBot;
+use strict;
+use warnings;
+use Carp;
+
+our
+$VERSION = 0.01;
+
+
+__END__
+=head1 NAME
+
+MBot - Framework for a Bot with Multiple interfaces and functions.
+
+Ho-hum. Need to write something here....
+
+=cut
Added: trunk/misc/mbot/mbotrc
===================================================================
--- trunk/misc/mbot/mbotrc 2004-06-27 19:30:34 UTC (rev 259)
+++ trunk/misc/mbot/mbotrc 2004-06-27 20:15:17 UTC (rev 260)
@@ -0,0 +1,10 @@
+--- #YAML:1.0
+Name: Martin
+Session:
+ IRC:
+ Channel: '#edynn'
+ ChannelPass: vinegar
+ Name: Martin
+ Port: 6666
+ RealName: Martin von Hendersen
+ Server: cosine.aftran.com
