From e84b3cbc89c328a8e7d1909e7cfe10acb35a0e56 Mon Sep 17 00:00:00 2001 From: Someone Date: Thu, 6 Dec 2012 03:28:31 +0100 Subject: [PATCH] some old base --- BotModules/.bugmail.log | 0 BotModules/Bugzilla.bm | 743 +++++++ BotModules/BugzillaMailHandler.pl | 530 +++++ BotModules/BugzillaMailHandler.txt | 91 + BotModules/COPYING | 27 + BotModules/CVS/Entries | 43 + BotModules/CVS/Entries.Log | 2 + BotModules/CVS/Repository | 1 + BotModules/CVS/Root | 1 + BotModules/CVS/Tag | 1 + BotModules/Converter.bm | 630 ++++++ BotModules/Currencies.bm | 60 + BotModules/FTP.bm | 248 +++ BotModules/Filter.bm | 83 + BotModules/Flood.bm | 102 + BotModules/FortuneCookies.bm | 143 ++ BotModules/General.bm | 171 ++ BotModules/God.bm | 341 +++ BotModules/Google.bm | 150 ++ BotModules/Greeting.bm | 361 ++++ BotModules/HelloWorld.bm | 29 + BotModules/Infobot.bm | 790 +++++++ BotModules/Infobot.pl | 69 + BotModules/Infobot.txt | 195 ++ BotModules/Insult.bm | 136 ++ BotModules/Karma.bm | 196 ++ BotModules/KeepAlive.bm | 51 + BotModules/KookBot.bm | 109 + BotModules/List.bm | 179 ++ BotModules/MagicEightBall.bm | 77 + BotModules/MiniLogger.bm | 155 ++ BotModules/Parrot.bm | 66 + BotModules/Quiz.bm | 571 +++++ BotModules/Quotes.bm | 651 ++++++ BotModules/RDF.bm | 268 +++ BotModules/Rude.bm | 94 + BotModules/Seen.bm | 290 +++ BotModules/ServicesLogin.bm | 88 + BotModules/Sheriff.bm | 140 ++ BotModules/Spell.bm | 119 + BotModules/Stocks.bm | 54 + BotModules/Tinderbox.bm | 508 +++++ BotModules/Translate.bm | 179 ++ BotModules/UUIDGen.bm | 68 + BotModules/WWW.bm | 136 ++ BotModules/Wishlist.bm | 55 + BotModules/XMLLogger.bm | 219 ++ BotModules/devel.txt | 993 +++++++++ INSTALL | 443 ++++ INSTALL.UNIX.CHROOT-JAIL | 514 +++++ INSTALL.WIN32 | 29 + README | 4 + config/CVS/Entries | 2 + config/CVS/Repository | 1 + config/CVS/Root | 1 + config/CVS/Tag | 1 + config/sample | 130 ++ factoids-are.dir | Bin 0 -> 12288 bytes factoids-are.pag | Bin 0 -> 12288 bytes factoids-is.dir | Bin 0 -> 16037 bytes factoids-is.pag | Bin 0 -> 16037 bytes lib/CVS/Entries | 3 + lib/CVS/Entries.Log | 1 + lib/CVS/Repository | 1 + lib/CVS/Root | 1 + lib/CVS/Tag | 1 + lib/Configuration.pm | 209 ++ lib/IO/CVS/Entries | 2 + lib/IO/CVS/Repository | 1 + lib/IO/CVS/Root | 1 + lib/IO/CVS/Tag | 1 + lib/IO/SecurePipe.pm | 67 + lib/Mails.pm | 196 ++ mozbot.pl | 3237 ++++++++++++++++++++++++++++ mozbot.pl.cfg | 243 +++ run-mozbot-chrooted | 5 + run-mozbot-from-crontab | 22 + uuidgen/CVS/Entries | 7 + uuidgen/CVS/Repository | 1 + uuidgen/CVS/Root | 1 + uuidgen/CVS/Tag | 1 + uuidgen/Makefile | 17 + uuidgen/main.c | 17 + uuidgen/md5.c | 263 +++ uuidgen/md5.h | 26 + uuidgen/token.c | 356 +++ uuidgen/token.h | 80 + 87 files changed, 16098 insertions(+) create mode 100644 BotModules/.bugmail.log create mode 100644 BotModules/Bugzilla.bm create mode 100644 BotModules/BugzillaMailHandler.pl create mode 100644 BotModules/BugzillaMailHandler.txt create mode 100644 BotModules/COPYING create mode 100644 BotModules/CVS/Entries create mode 100644 BotModules/CVS/Entries.Log create mode 100644 BotModules/CVS/Repository create mode 100644 BotModules/CVS/Root create mode 100644 BotModules/CVS/Tag create mode 100644 BotModules/Converter.bm create mode 100644 BotModules/Currencies.bm create mode 100644 BotModules/FTP.bm create mode 100644 BotModules/Filter.bm create mode 100644 BotModules/Flood.bm create mode 100644 BotModules/FortuneCookies.bm create mode 100644 BotModules/General.bm create mode 100644 BotModules/God.bm create mode 100644 BotModules/Google.bm create mode 100644 BotModules/Greeting.bm create mode 100644 BotModules/HelloWorld.bm create mode 100644 BotModules/Infobot.bm create mode 100644 BotModules/Infobot.pl create mode 100644 BotModules/Infobot.txt create mode 100644 BotModules/Insult.bm create mode 100644 BotModules/Karma.bm create mode 100644 BotModules/KeepAlive.bm create mode 100644 BotModules/KookBot.bm create mode 100644 BotModules/List.bm create mode 100644 BotModules/MagicEightBall.bm create mode 100644 BotModules/MiniLogger.bm create mode 100644 BotModules/Parrot.bm create mode 100644 BotModules/Quiz.bm create mode 100644 BotModules/Quotes.bm create mode 100644 BotModules/RDF.bm create mode 100644 BotModules/Rude.bm create mode 100644 BotModules/Seen.bm create mode 100644 BotModules/ServicesLogin.bm create mode 100644 BotModules/Sheriff.bm create mode 100644 BotModules/Spell.bm create mode 100644 BotModules/Stocks.bm create mode 100644 BotModules/Tinderbox.bm create mode 100644 BotModules/Translate.bm create mode 100644 BotModules/UUIDGen.bm create mode 100644 BotModules/WWW.bm create mode 100644 BotModules/Wishlist.bm create mode 100644 BotModules/XMLLogger.bm create mode 100644 BotModules/devel.txt create mode 100644 INSTALL create mode 100644 INSTALL.UNIX.CHROOT-JAIL create mode 100644 INSTALL.WIN32 create mode 100644 README create mode 100644 config/CVS/Entries create mode 100644 config/CVS/Repository create mode 100644 config/CVS/Root create mode 100644 config/CVS/Tag create mode 100644 config/sample create mode 100644 factoids-are.dir create mode 100644 factoids-are.pag create mode 100644 factoids-is.dir create mode 100644 factoids-is.pag create mode 100644 lib/CVS/Entries create mode 100644 lib/CVS/Entries.Log create mode 100644 lib/CVS/Repository create mode 100644 lib/CVS/Root create mode 100644 lib/CVS/Tag create mode 100644 lib/Configuration.pm create mode 100644 lib/IO/CVS/Entries create mode 100644 lib/IO/CVS/Repository create mode 100644 lib/IO/CVS/Root create mode 100644 lib/IO/CVS/Tag create mode 100644 lib/IO/SecurePipe.pm create mode 100644 lib/Mails.pm create mode 100644 mozbot.pl create mode 100644 mozbot.pl.cfg create mode 100644 run-mozbot-chrooted create mode 100644 run-mozbot-from-crontab create mode 100644 uuidgen/CVS/Entries create mode 100644 uuidgen/CVS/Repository create mode 100644 uuidgen/CVS/Root create mode 100644 uuidgen/CVS/Tag create mode 100644 uuidgen/Makefile create mode 100644 uuidgen/main.c create mode 100644 uuidgen/md5.c create mode 100644 uuidgen/md5.h create mode 100644 uuidgen/token.c create mode 100644 uuidgen/token.h diff --git a/BotModules/.bugmail.log b/BotModules/.bugmail.log new file mode 100644 index 0000000..e69de29 diff --git a/BotModules/Bugzilla.bm b/BotModules/Bugzilla.bm new file mode 100644 index 0000000..f3ec152 --- /dev/null +++ b/BotModules/Bugzilla.bm @@ -0,0 +1,743 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +# vim: syntax=perl +################################ +# Bugzilla Module # +################################ + + +package BotModules::Bugzilla; +use vars qw(@ISA); +@ISA = qw(BotModules); + +use XML::LibXML; +use Fcntl qw(:DEFAULT :flock); +use File::Basename; + +# For parsing bugmail.log records. Must be the same as +# FIELD_SEPARATOR in bugmail.pl. +use constant FIELD_SEPARATOR => '::::'; +# The log file that we read to report bug changes. +# This will be put in the directory returned by dirname($0). +use constant BUGMAIL_LOG => 'BotModules/.bugmail.log'; +1; + +# there is a minor error in this module: bugsHistory->$target->$bug is +# accessed even when bugsHistory->$target doesn't yet exist. XXX + +# This is ported straight from techbot, so some of the code is a little convoluted. So sue me. I was lazy. + +sub Initialise { + my $self = shift; + my $retval = $self->SUPER::Initialise(@_); + my ($throw_away) = $self->GetBugLog(); + $throw_away->truncate(0) if $throw_away; + $throw_away->close() if $throw_away; + return $retval; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['bugsURI', 1, 1, 'https://bugzilla.mozilla.org/'], + ['bugsDWIMQueryDefault', 1, 1, 'short_desc_type=substring&short_desc='], + ['bugsDWIMQueryChannelDefault', 1, 1, {}], + ['bugsHistory', 0, 0, {}], + ['backoffTime', 1, 1, 120], + ['ignoreCommentsTo', 1, 1, ['']], + ['ignoreCommentsFrom', 1, 1, ['|']], + ['mailIgnore', 1, 1, []], + ['skipPrefixFor', 1, 1, []], + # The keys for productReportChannels can be in the form of 'Product' + # or 'Product::::Component'. The value is a comma-separated list of + # channel names. + ['productReportChannels', 1, 1, {}], + # The fields that you want notifications about. + ['reportFields', 1, 1, ['Resolution', 'Flag', 'Attachment Flag', + 'NewBug', 'NewAttach']], + # Except in these products, you don't want notifications about + # certain fields (key is product name, value is comma-separated + # list of fields). + ['productMuteFields', 1, 1, {}], + # And in these channels, you don't want notifications about certain + # fields (the key is the channel name and the value is a + # comma-separated list of fields). + ['channelMuteFields', 1, 1, {}], + # How frequently we check for new bugmail we've received, in seconds. + ['updateDelay', 1, 1, 10], + # List of products for which component of new bugs is reported instead + # of only the product. Can also restrict to specific components + # by using Product::::Component syntax and always report components + # by using 'all'. + ['reportComponent', 1, 1, ['all']], + ['mutes', 1, 1, ''], # "channel channel channel" + # Optionally skip fetching the bug details for automatic notifications + ['reportBugDetails', 1, 1, 1] + ); +} + +sub Help { + my $self = shift; + my ($event) = @_; + my %commands = ( + '' => 'The Bugzilla module provides an interface to the bugzilla bug database. It will spot anyone mentioning bugs, too, and report on what they are. For example if someone says \'I think that\'s a dup of bug 5693, the :hover thing\', then this module will display information about bug 5693.', + 'bug' => 'Fetches a summary of bugs from bugzilla. Expert syntax: \'bugzilla [bugnumber[,]]*[&bugzillaparameter=value]*\', bug_status: UNCONFIRMED|NEW|ASSIGNED|REOPENED; *type*=substring|; bugtype: include|exclude; order: Assignee|; chfield[from|to|value] short_desc\' long_desc\' status_whiteboard\' bug_file_loc\' keywords\'; \'_type; email[|type][1|2] [reporter|qa_contact|assigned_to|cc]', + 'bug-total' => 'Same as bug (which see) but only displays the total line.', + 'bugs' => q{A simple DWIM search. Not very clever. ;-)} + . q{ Syntax: ' bugs' e.g. 'mozbot bugs'.}, + 'ignore' => q{Causes the bot to stop reporting all bug changes} + . q{ made by a particular user in the current channel.} + . q{ Syntax: 'ignore ' }, + 'unignore' => q{Causes the bot to un-ignore a previously ignored} + . q{ user. See 'ignore'} + . q{ for more details.}, + ); + if ($self->isAdmin($event)) { + $commands{'mute'} = 'Disable watching for bug numbers in a channel. Syntax: mute bugzilla in '; + $commands{'unmute'} = 'Enable watching for bug numbers in a channel. Syntax: unmute bugzilla in '; + } + return \%commands; +} + +# Schedule - called when bot connects to a server, to install any schedulers +# use $self->schedule($event, $delay, $times, $data) +# where $times is 1 for a single event, -1 for recurring events, +# and a +ve number for an event that occurs that many times. +sub Schedule { + my $self = shift; + my ($event) = @_; + $self->schedule($event, \$self->{'updateDelay'}, -1, 'Bugzilla-BugMail'); + return $self->SUPER::Schedule($event); +} + +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + if ($data[0] eq 'Bugzilla-BugMail') { + $self->CheckForBugMail($event); + } else { + return $self->SUPER::Scheduled($event, @data); + } + return 0; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*ignore (.+)[?!.\s]*$/) { + my $user = $1; + # If we aren't already ignoring them... + if (!grep($_ eq $user, @{$self->{'mailIgnore'}})) { + push (@{$self->{'mailIgnore'}}, $user); + $self->saveConfig(); + $self->say($event, + "$event->{'from'}: OK, ignoring changes produced by $user."); + } + else { + $self->say($event, + "$event->{'from'}: $user is already being ignored."); + } + } + elsif ($message =~ /^\s*unignore (.+)[?!.\s]*$/) { + my $user = $1; + my %ignoredUsers = map { $_ => 1 } @{$self->{'mailIgnore'}}; + # If we are already ignoring them... + if ($ignoredUsers{$user}) { + delete $ignoredUsers{$user}; + $self->{'mailIgnore'} = [keys %ignoredUsers]; + $self->saveConfig(); + $self->say($event, + "$event->{'from'}: OK, $user is no longer being ignored."); + } + else { + $self->say($event, "$event->{'from'}: $user wasn't being ignored."); + } + } + elsif ($message =~ m/^ \s* # some optional whitespace + (?:please\s+)? # an optional "please", followed optionally by either: + (?: (?:could\s+you\s+)? # 1. an optional "could you", + (?:please\s+)? # another optional "please", + show\s+me\s+ | # and the text "show me" + what\s+is\s+ | # 2. the text "what is" + what\'s\s+ )? # 3. or the text "what's" + bug (?:\s*id)?s? [\#\s]+ # a variant on "bug", "bug id", "bugids", etc + ([0-9].*?| # a query string, either a number followed by some optional text, or + &.+?) # a query string, starting with a &. + (?:\s+please)? # followed by yet another optional "please" + [?!.\s]* # ending with some optional punctuation + $/osix) { + my $target = $event->{'target'}; + my $bug = $1; + # Single bugs use xml.cgi, because then we get error messages + if ($bug =~ m/^\d+$/) { + $self->FetchBug($event, $bug, 'bug', {'sayAlways' => 1}); + } else { + $self->FetchBug($event, $bug, 'bugs', {'sayAlways' => 1}); + } + $self->{'bugsHistory'}->{$target}->{$bug} = $event->{'time'} if $bug =~ m/^\d+$/os; + } elsif ($message =~ m/^\s*bug-?total\s+(.+?)\s*$/osi) { + $self->FetchBug($event, $1, 'total'); + } elsif ($self->isAdmin($event)) { + if ($message =~ m/^\s*mute\s+bugzilla\s+in\s+(\S+?)\s*$/osi) { + $self->{'mutes'} .= " $1"; + $self->saveConfig(); + $self->say($event, "$event->{'from'}: Watching for bug numbers disabled in channel $1."); + } elsif ($message =~ m/^\s*unmute\s+bugzilla\s+in\s+(\S+)\s*$/osi) { + my %mutedChannels = map { $_ => 1 } split(/ /o, $self->{'mutes'}); + delete($mutedChannels{$1}); # get rid of any mentions of that channel + $self->{'mutes'} = join(' ', keys(%mutedChannels)); + $self->saveConfig(); + $self->say($event, "$event->{'from'}: Watching for bug numbers reenabled in channel $1."); + } else { + return $self->SUPER::Told(@_); + } + } else { + return $self->SUPER::Told(@_); + } + return 0; # dealt with it... +} + +sub CheckForBugs { + my $self = shift; + my ($event, $message) = @_; + if ((($event->{'channel'} eq '') or # either it was /msg'ed, or + ($self->{'mutes'} !~ m/^(?:.*\s|)\Q$event->{'channel'}\E(?:|\s.*)$/si)) and # it was sent on a channel in which we aren't muted + (not $self->ignoringCommentsFrom($event->{'from'})) and # we aren't ignoring them + (not $self->ignoringCommentsTo($message))) { # and they aren't talking to someone we need to ignore + my $rest = $message; + my $bugsFound = 0; + my $bugsToFetch = ''; + my $bug; + my $skipURI; + do { + if ($rest =~ m/ (?:^| # either the start of the string + []\s,.;:\\\/=?!()<>{}[-]) # or some punctuation + bug [\s\#]* ([0-9]+) # followed a string similar to "bug # 123" (put the number in $1) + (?:[]\s,.;:\\\/=?!()<>{}[-]+ # followed optionally by some punctuation, + (.*))?$/osix) { # and everything else (which we put in $2) + $bug = $1; + $skipURI = 0; + $rest = $2; + } elsif ($rest =~ m/\Q$self->{'bugsURI'}\Eshow_bug.cgi\?id=([0-9]+)(?:[^0-9&](.*))?$/si) { + $bug = $1; + $skipURI = 1; + $rest = $2; + } else { + $bug = undef; + } + if (defined($bug)) { + $self->debug("Noticed someone mention bug $bug -- investigating..."); + $bugsToFetch .= "$bug "; + $bugsFound++; + } + } while (defined($bug)); + if ($bugsToFetch ne '') { + $self->FetchBug($event, $bugsToFetch, 'bug', {'skipURI' => $skipURI, 'skipZaroo' =>1}); + } + return $bugsFound; + } + return 0; +} + +sub Heard { + my $self = shift; + my ($event, $message) = @_; + unless ($self->CheckForBugs($event, $message)) { + return $self->SUPER::Heard(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Baffled { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ m/^\s*(...+?)\s+bugs\s*$/osi) { + my $target = $event->{'target'}; + $self->FetchBug($event, $1, 'dwim'); + } else { + return $self->SUPER::Baffled(@_); + } + return 0; +} + +sub Felt { + my $self = shift; + my ($event, $message) = @_; + unless ($self->CheckForBugs($event, $message)) { + return $self->SUPER::Felt(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Saw { + my $self = shift; + my ($event, $message) = @_; + unless ($self->CheckForBugs($event, $message)) { + return $self->SUPER::Saw(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub FetchBug { + my $self = shift; + my ($event, $bugParams, $subtype, $params) = @_; + my $skipURI = exists($params->{'skipURI'}) ? $params->{'skipURI'} : 0; + my $skipZaroo = exists($params->{'skipZaroo'}) ? $params->{'skipZaroo'} : 0; + my $sayAlways = exists($params->{'sayAlways'}) ? $params->{'sayAlways'} : 0; + my $uri; + my $type; + my @bugs = split(' ', $bugParams); + my @ids = (); + foreach my $bug (@bugs) { + if($sayAlways || $self->needToFetchBug($event->{'target'}, $event->{'time'}, $bug)) { + push @ids, $bug; + $self->{'bugsHistory'}->{$event->{'target'}}->{$bug} = $event->{'time'} if $bug =~ m/^\d+$/os; + } + } + return unless @ids; + if ($subtype eq 'bug') { + # Code taken from Bugzilla's xml.cgi + $uri = "$self->{'bugsURI'}show_bug.cgi?ctype=xml&excludefield=long_desc&excludefield=attachmentdata&excludefield=cc".join('', map { $_ = "&id=" . $_ } @ids); + $type = 'xml'; + } elsif ($subtype eq 'dwim') { + # XXX should escape query string + my $DWIMdefaultQuery = $self->{'bugsDWIMQueryDefault'}; + if (exists $self->{'bugsDWIMQueryChannelDefault'}->{$event->{'channel'}}) { + $DWIMdefaultQuery = $self->{'bugsDWIMQueryChannelDefault'}->{$event->{'channel'}}; + } + $uri = "$self->{'bugsURI'}buglist.cgi?format=rdf&$DWIMdefaultQuery".join(',',@ids); + $subtype = 'bugs'; + $type = 'buglist'; + } else { + $uri = "$self->{'bugsURI'}buglist.cgi?format=rdf&bug_id=".join(',',@ids); + $type = 'buglist'; + } + $self->getURI($event, $uri, $type, $subtype, $skipURI, $skipZaroo); +} + +sub GotURI { + my $self = shift; + my ($event, $uri, $output, $type, $subtype, $skipURI, $skipZaroo) = @_; + + my @bugs; + + # Bugzilla really needs a LIMIT option + my $maxRes; + if ($event->{'channel'}) { + $maxRes = 5; + } else { + $maxRes = 20; + } + my $truncated = 0; + + if ($type eq 'buglist') { + # We asked for rdf, but old versions won't know how to do that + # So lets do some simple sniffing, until mozbot gives us a way + # to find out the server's returned mime type + my $format; + if ($output =~ /^<\?xml /) { + $type = 'rdf'; + } else { + $type = 'html'; + } + } + + my $lots; + my $bugCount; + + if ($type eq 'html') { + my $lots; + my @qp; + + # magicness + { no warnings; # this can go _very_ wrong easily + + $lots = ($output !~ m//osi); # if we got truncated, then this will be missing + + # Instead of relying on being able to accurately count the + # number of bugs (which we can't do if there are more than + # 199), use the number that bugzilla tells us. + if ($output =~ /(One|\d+) bugs? found/o) { + $bugCount = $1; + if ($bugCount eq "One") { + $bugCount = 1; + } + } + + $output =~ s/<\/TABLE><\/TH>//gosi; + (undef, $output) = split(/Summary<\/A><\/TH>/osi, $output); + ($output, undef) = split(/<\/TABLE>/osi, $output); + $output =~ s/[\n\r]//gosi; + @qp = split(m/
/osi, $output); + } + + if (scalar(@qp) == 0) { + $bugCount = 0; + } + + if (!$lots && $subtype eq 'bugs') { + if (scalar(@qp) > $maxRes) { + $truncated = 1; + @qp = @qp[0..$maxRes-1]; + } + + foreach (@qp) { + if ($_) { + # more magic + if (my @d = m|\1 (.*?)(.*?)(.*?)(.*?)(.*?)(.*?)(.*)|osi) { + # bugid severity priority platform owner status resolution subject + my %bug; + ($bug{'id'}, $bug{'severity'}, $bug{'priority'}, $bug{'platform'}, $bug{'owner'}, $bug{'status'}, $bug{'resolution'}, $bug{'summary'}) = @d; + push (@bugs, \%bug); + } + } + } + } + } elsif ($type eq 'xml') { + # We came from xml.cgi + my $parser = XML::LibXML->new(); + my $tree = $parser->parse_string($output); + my $root = $tree->getDocumentElement; + + my @xml_bugs = $root->getElementsByTagName('bug'); + $bugCount = scalar(@xml_bugs); + + if (scalar(@xml_bugs) > $maxRes) { + $truncated = 1; + @xml_bugs = @xml_bugs[0..$maxRes-1]; + } + + # OK, xml.cgi uses different names to the query stuff + # Take a deep breath, and use a mapping for the fields we + # care about + my %fieldMap = ( + 'bug_id' => 'id', + 'bug_severity' => 'severity', + 'priority' => 'priority', + 'target_milestone' => 'target_milestone', + 'assigned_to' => 'owner', + 'bug_status' => 'status', + 'resolution' => 'resolution', + 'short_desc' => 'summary' + ); + + foreach my $xml_bug(@xml_bugs) { + my %bug = {}; + my $error = $xml_bug->getAttribute('error'); + if (!defined $error) { + foreach my $field (keys %fieldMap) { + my @arr = $xml_bug->getElementsByTagName($field); + if (@arr) { + my $firstChild = $arr[0]->getFirstChild(); + if (defined $firstChild) { + $bug{$fieldMap{$field}} = $firstChild->getData(); + } + } + } + } + else { + my @arr = $xml_bug->getElementsByTagName('bug_id'); + $bug{'id'} = $arr[0]->getFirstChild->getData(); + $bug{'error'} = $error; + } + push @bugs, \%bug; + } + } elsif ($type eq 'rdf') { + my $parser = XML::LibXML->new(); + my $tree = $parser->parse_string($output); + my $root = $tree->getDocumentElement; + my @rdf_bugs = $root->getElementsByTagName('bz:bug'); + + $bugCount = scalar(@rdf_bugs); + + if (scalar(@rdf_bugs) > $maxRes) { + $truncated = 1; + @rdf_bugs = @rdf_bugs[0..$maxRes-1]; + } + + foreach my $rdf_bug (@rdf_bugs) { + my %bug = {}; + my @children = $rdf_bug->getChildnodes(); + foreach my $child (@children) { + next if ($child->getLocalName() eq 'text'); + my $field = $child->getLocalName(); + if ($child->getFirstChild()) { + my $val = $child->getFirstChild->getData(); + $bug{$field} = $val; + } + } + push @bugs, \%bug; + } + } else { + return $self->SUPER::GotURI(@_); + } + + # construct the response's preamble + my $preamble; + if ($bugCount == 0 && !$skipZaroo) { + $preamble = 'Zarro boogs found.'; + } else { + my $bugCountStr; + if ($bugCount) { + $bugCountStr = "$bugCount bug" . ($bugCount == 1 ? '' : 's') + . " found"; + } + + if ($subtype eq 'total') { + $self->say($event, $bugCountStr); + return; + } + + if ($lots) { + $preamble = $bugCountStr ? "$bugCountStr, which is too many for me to handle without running out of memory." + : 'Way too many bugs found. I gave up so as to not run out of memory.'; + $preamble .= "$bugCountStr Try to narrow your search or something!"; + $subtype = 'lots'; + } elsif ($subtype ne 'bug' && $bugCount > 1) { + $preamble = $bugCountStr; + if ($truncated) { + if ($event->{'channel'}) { + $preamble .= '. Five shown, please message me for more.'; + } else { + $preamble .= '. Will only show 20 results, please use the Bugzilla query form if you want more.'; + } + } + } + } + + my $prefix; + if ( !$event->{'from'} + || grep {$_ eq $event->{'from'}} @{$self->{'skipPrefixFor'}} ) + { + # they don't want to have the report prefixed with their name + $prefix = ''; + } else { + $prefix = "$event->{'from'}: "; + } + + if ($preamble) { + $self->say($event, "$prefix$preamble"); + } + + my $bug_link = $skipURI ? "" : "$self->{'bugsURI'}show_bug.cgi?id="; + + # now send out the output + foreach my $bug (@bugs) { + if (!defined $bug->{'error'}) { + # Bugzilla doesn't give the TM by default, and we can't + # change this without using cookies, which aren't supported + # by the mozbot API. Later versions allow us to use a query param + # but we can't detect that that was accepted, which would break + # the HTML parsing + # xml.cgi gives us everything, so we can print this if we got + # results from there + # Maybe the list of columns to display could be a var, one day, after + # installations from source before Dec 2001 are no longer supported, + # or we can pass cookies + $self->say($event, $prefix . + "Bug $bug_link$bug->{'id'} " . + substr($bug->{'severity'} || $bug->{'bug_severity'}, 0, 3) . ", " . + $bug->{'priority'} . ", " . + ($bug->{'target_milestone'} ? "$bug->{'target_milestone'}, " : "") . + ($bug->{'owner'} || $bug->{'assigned_to'}) . ", " . + substr($bug->{'status'} || $bug->{'bug_status'}, 0, 4) . + ($bug->{'resolution'} ? " " . $bug->{'resolution'} : "") . ", " . + substr($bug->{'summary'} || $bug->{'short_desc'} || $bug->{'short_short_desc'}, 0, 100)); + } elsif ($bug->{'error'} eq 'NotFound') { + unless($skipZaroo) { + $self->say($event, $prefix . "Bug $bug->{'id'} was not found."); + } + } elsif ($bug->{'error'} eq 'NotPermitted') { + $self->say($event, $prefix . "Bug $bug_link$bug->{'id'} is not accessible"); + } else { + unless($skipZaroo) { + $self->say($prefix . "Error accessing bug $bug->{'id'}: $bug->{'error'}"); + } + } + } +} + +sub CheckForBugMail { + my $self = shift; + my ($event) = @_; + + my ($bug_log, $bug_file) = $self->GetBugLog(); + + my @log_lines; + if (defined $bug_log) { + # We need LOCK_EX because we're going to truncate it. + flock($bug_log, LOCK_EX); + @log_lines = $bug_log->getlines(); + $bug_log->truncate(0) + or ($self->debug("Failed to truncate $bug_file: $!") && return); + flock($bug_log, LOCK_UN); + $bug_log->close() or $self->debug("Failed to close $bug_file: $!"); + $self->debug("Read " . scalar(@log_lines) . " bugmail log lines.") + if @log_lines; + } + else { + # We will have already output a more detailed error from GetBugLog. + $self->debug("CheckForBugMail Failed: Couldn't read bugmail log."); + return; + } + + # Hash to keep track of which channels we've mentioned which bug details + # in, so we don't spew the same bug details over and over. + my %said_bug; + + foreach my $line (@log_lines) { + chomp($line); + #$self->debug("Reading log line: $line"); + my $sep = FIELD_SEPARATOR; + $line =~ /^(.+)$sep(.+)$sep(.+)$sep(.+)$sep(.+)$sep(.*)$sep(.*)$sep(.+)$/; + my ($bug_id, $product, $component, $who, $field, $old, $new, $message) = + ($1, $2, $3, $4, $5, $6, $7, $8); + + # Skip this line if we never report anything for this field. + next if !grep($_ eq $field, @{$self->{'reportFields'}}); + + my @prod_mute_fields = + split(/\s*,\s*/, $self->{'productMuteFields'}->{$product}); + my @chan_list; + # Don't report to these channels if this product is muted for this field. + push (@chan_list, $self->CreateChannelList($product, $component)) + unless grep($_ eq $field, @prod_mute_fields); + + if ($field eq 'Product') { + my @old_mute_fields = + split(/\s*,\s*/, $self->{'productMuteFields'}->{$old}); + push(@chan_list, $self->CreateChannelList($old, $component)) + unless grep($_ eq $field, @old_mute_fields); + } + elsif ($field eq 'Component') { + my @comp_mute_fields = @prod_mute_fields; + push(@comp_mute_fields, + ($self->{'productMuteFields'}->{$product. $sep . $component})); + # Don't report it if the product is muted for this field, or if + # this specific component is muted for this field. + push(@chan_list, $self->CreateChannelList($product, $old)) + unless grep($_ eq $field, @comp_mute_fields); + } + # Enable Mozbot to report both product and component of new bugs. + if (grep(lc($_) eq 'all', @{$self->{'reportComponent'}}) || + grep(lc($_) eq lc($product), @{$self->{'reportComponent'}}) || + grep(lc($_) eq lc($product.$sep.$component), @{$self->{'reportComponent'}})) { + $message =~ s/^New $product bug/New $product - $component bug/i; + } + unless ($self->ignoringMailProducedBy($who)) { + # Keep track of which channels we've told already, to avoid + # duplicate messages. + my %said_to; + foreach my $channel (@chan_list) { + my @chan_mute_fields = + split(/\s*,\s*/, $self->{'channelMuteFields'}->{$channel}); + # Don't say it if we've said it before, or if this + # field is muted in this channel. + unless ( $said_to{$channel} + || grep($_ eq $field, @chan_mute_fields) ) + { + # We can't use "local" here, or the target doesn't show + # up properly in the GotURI after FetchBug. + $event->{'target'} = $channel; + $self->say($event, $message); + my $bugids = ""; + # Special case for "duplicate of messages" + if ($message =~ /DUPLICATE of bug (\d+)/) { + my $dup_id = $1; + $bugids = $dup_id unless $said_bug{$channel . $dup_id}; + $said_bug{$channel . $dup_id} = 1; + } + # Fetch bugs mentioned for dependent field changes + if ($field eq 'OtherBugsDependingOnThis' + || $field eq 'BugsThisDependsOn') { + foreach my $id (split(/,/, $old . $new)) { + $bugids = $id . " " . $bugids + unless $said_bug{$channel . $id}; + $said_bug{$channel . $id} = 1; + } + } + if (! $said_bug{$channel . $bug_id}) { + $bugids = $bug_id . " " . $bugids; + } + if ($bugids ne '') { + if ($self->{'reportBugDetails'}) { + $self->FetchBug($event, $bugids, 'bug'); + } + } + $said_to{$channel} = 1; + $said_bug{$channel . $bug_id} = 1; + } # unless $said_to + } # foreach @chan_list + } # unless ignoringMailProducedBy + } # foreach @log_lines +} + +# A helper for CheckForBugMail. +sub CreateChannelList { + my $self = shift; + my ($product, $component) = @_; + + my $chan_list = ""; + ($chan_list .= $self->{'productReportChannels'}->{$product}) + if $self->{'productReportChannels'}->{$product}; + + my $prodcomp = $product . FIELD_SEPARATOR . $component; + ($chan_list .= ',' . $self->{'productReportChannels'}->{$prodcomp}) + if $self->{'productReportChannels'}->{$prodcomp}; + + return (split /\s*,\s*/, $chan_list); +} + +# Creates the BUGMAIL_LOG file if it doesn't exist, and returns +# an open IO::File for it, and also the filename of that file. +sub GetBugLog { + my $self = shift; + + my $file_name = dirname($0) . '/' . BUGMAIL_LOG; + # And we generally trust $bug_log to be an OK path, so untaint it now. + $file_name =~ /^(.*)$/; + $file_name = $1; + my $file = new IO::File($file_name, O_RDWR | O_CREAT, 0660) + or $self->debug("Could not open/create $file_name for reading" + . " incoming bugmail: $!"); + return ($file, $file_name); +} + +sub ignoringMailProducedBy { + my $self = shift; + my ($who) = @_; + return grep($_ eq $who, @{$self->{'mailIgnore'}}) ? 1 : 0; +} + +sub ignoringCommentsTo { + my $self = shift; + my ($who) = @_; + foreach (@{$self->{'ignoreCommentsTo'}}) { + next unless $_; # Ignore blanks, happens when the array is empty (?) + return 1 if $who =~ m/^(?:.*[]\s,.;:\\\/=?!()<>{}[-])?\Q$_\E(?:[]\s,.;:\\\/=?!()<>{}[-].*)?$/is; + } + return 0; +} + +sub ignoringCommentsFrom { + my $self = shift; + my ($who) = @_; + foreach (@{$self->{'ignoreCommentsFrom'}}) { + return 1 if $_ eq $who; + } + return 0; +} + +sub needToFetchBug { + my ($self, $target, $time, $bug) = @_; + my $last = 0; + if (defined($self->{'bugsHistory'}->{$target}->{$bug})) { + $last = $self->{'bugsHistory'}->{$target}->{$bug}; + } + if (($time-$last) > $self->{'backoffTime'}) { + return 1; + } + return 0; +} diff --git a/BotModules/BugzillaMailHandler.pl b/BotModules/BugzillaMailHandler.pl new file mode 100644 index 0000000..2d43f0f --- /dev/null +++ b/BotModules/BugzillaMailHandler.pl @@ -0,0 +1,530 @@ +#!/usr/bin/perl -w +# +# The contents of this file are subject to the Mozilla Public +# License Version 1.1 (the "License"); you may not use this file +# except in compliance with the License. You may obtain a copy of +# the License at http://www.mozilla.org/MPL/ +# +# Software distributed under the License is distributed on an "AS +# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or +# implied. See the License for the specific language governing +# rights and limitations under the License. +# +# The Original Code is the Mozilla IRC Bot +# +# The Initial Developer of the Original Code is Max Kanat-Alexander. +# Portions developed by Max Kanat-Alexander are Copyright (C) 2005 +# Max Kanat-Alexander. All Rights Reserved. +# +# Contributor(s): Max Kanat-Alexander +# +# This is loosely based off an older bugmail.pl by justdave. + +# bugmail.pl requires that you have X-Bugzilla-Product and +# X-Bugzilla-Component headers in your incoming email. In 2.19.2 and above, +# this is easy. You just add two lines to your newchangedmail param: +# X-Bugzilla-Product: %product% +# X-Bugzilla-Component: %component% +# If you're running 2.18, you can do the same thing, but you need to +# apply the patch from bug 175222 +# to your installation. + +use strict; +use Fcntl qw(:flock); +use File::Basename; + +use Email::MIME; + +##################################################################### +# Constants And Initial Setup +##################################################################### + +# What separates Product//Component//[Fields], etc. in a log line. +use constant FIELD_SEPARATOR => '::::'; + +# These are fields that are multi-select fields, so when somebody +# adds something to them, the verbs "added to " or "removed from" should +# be used instead of the verb "changed" or "set". +# It's a hash, where the names of the fields are the keys, and the values are 1. +# The fields are named as they appear in the "What" part of a bugmail "changes" +# table. +use constant MULTI_FIELDS => { + 'CC' => 1, 'Group' => 1, 'Keywords' => 1, + 'BugsThisDependsOn' => 1, 'OtherBugsDependingOnThis' => 1, +}; + +# Some fields have such long names for the "What" column that their names +# wrap. Normally, our code would think that those fields were two different +# fields. So, instead, we store a list of strings to use as an argument +# to "grep" for the field names that we need to "unwrap." +use constant UNWRAP_WHAT => ( + qr/^Attachment .\d+$/, qr/^Attachment .\d+ is$/, qr/^OtherBugsDep/, +); + +# Should be whatever Bugzilla::Util::find_wrap_point (or FindWrapPoint) +# breaks on, in Bugzilla. +use constant BREAKING_CHARACTERS => (' ',',','-'); + +# The maximum width, in characters, of each field of the "diffs" table. +use constant WIDTH_WHAT => 19; +use constant WIDTH_REMOVED => 28; +use constant WIDTH_ADDED => 28; + +# Our one command-line argument. +our $debug = $ARGV[0] && $ARGV[0] eq "-d"; + +# XXX - This probably should happen in the log directory instead, but that's +# more difficult to figure out reliably. +my $bug_log = dirname($0) . '/.bugmail.log'; + +##################################################################### +# Utility Functions +##################################################################### + +# When processing the "diffs" table in a bug, some lines wrap. This +# function properly appends the "next" line for unwrapping to an +# existing string. +sub append_diffline ($$$$) { + my ($append_to, $prev_line, $append_line, $max_width) = @_; + my $ret_line = $append_to; + + debug_print("Appending Line: [$append_line] Prev Line: [$prev_line]"); + debug_print("Prev Line Len: " . length($prev_line) + . " Max Width: $max_width"); + + # If the previous line is the width of the entire column, we + # assume that we were forcibly wrapped in the middle of a word, + # and no space is needed. We only add the space if we were actually + # given a non-empty string to append. + if ($append_line && length($prev_line) != $max_width) { + debug_print("Adding a space unless we find a breaking character."); + # However, sometimes even if we have a very short line, if it ended + # in a "breaking character" like '-' then we also don't need a space. + $ret_line .= " " unless grep($prev_line =~ /$_$/, BREAKING_CHARACTERS); + } + $ret_line .= $append_line; + debug_print("Appended Line: [$ret_line]"); + return $ret_line; +} + +# Prints a string if debugging is on. Appends a newline so you don't have to. +sub debug_print ($) { + (print STDERR $_[0] . "\n") if $debug; +} + +# Helps with generate_log for Flag messages. +sub flag_action ($$) { + my ($new, $old) = @_; + + my $line = ""; + + my ($flag_name, $action, $requestee) = split_flag($new); + debug_print("Parsing Flag Change: Name: [$flag_name] Action: [$action]") + if $new; + + if (!$new) { + $line .= " cancelled $old"; + } + elsif ($action eq '+') { + $line .= " granted $flag_name"; + } + elsif ($action eq '-') { + $line .= " denied $flag_name"; + } + else { + $line .= " requested $flag_name from"; + if ($requestee) { + $line .= " " . $requestee; + } + else { + $line .= " the wind"; + } + } + + return $line; +} + +# Takes the $old and $new from a Flag field and returns a hash, +# where the key is the name of the field, and the value is an +# array, where the first item is the old flag string, and the +# new flag string is the second item. +sub parse_flags ($$) { + my ($new, $old) = @_; + + my %flags; + foreach my $old_item (split /\s*,\s*/, $old) { + my ($flag_name) = split_flag($old_item); + $flags{$flag_name} = [$old_item, '']; + } + foreach my $new_item (split /\s*,\s*/, $new) { + my ($flag_name) = split_flag($new_item); + if (!exists $flags{$flag_name}) { + $flags{$flag_name} = ['', $new_item]; + } + else { + $flags{$flag_name}[1] = $new_item; + } + } + + return %flags; +} + +# Returns a list: the name of the flag, the action (+/-/?), and +# the requestee (if that exists). +sub split_flag ($) { + my ($flag) = @_; + if ($flag) { + $flag =~ /\s*([^\?]+)(\+|-|\?)(?:\((.*)\))?$/; + return ($1, $2, $3); + } + return (); +} + +# Cuts the whitespace off the ends of a string. +# Lovingly borrowed from Bugzilla::Util. +sub trim ($) { + my ($str) = @_; + if ($str) { + $str =~ s/^\s+//g; + $str =~ s/\s+$//g; + } + return $str; +} + +##################################################################### +# Main Subroutines +##################################################################### + +# Returns a hash, where the keys are the names of fields. The values +# are lists, where the first item is what was removed and the second +# item is what was added. +sub parse_diffs ($) { + my ($body_lines) = @_; + my @body = @$body_lines; + + my %changes = (); + my $order = 0; + # Read in the What | Removed | Added table. + # End|of|table will never get run + my @diff_table = grep (/^.*\|.*\|.*$/, @body); + # The first line is the "What|Removed|Added" line, so goes away. + shift(@diff_table); + + my ($prev_what, $prev_added, $prev_removed); + # We can't use foreach because we need to modify @diff_table. + while (defined (my $line = shift @diff_table)) { + $line =~ /^(.*)\|(.*)\|(.*)$/; + my ($what, $removed, $added) = (trim($1), trim($2), trim($3)); + # These are used to set $prev_removed and $prev_added later. + my ($this_removed, $this_added) = ($removed, $added); + + debug_print("---RawLine: $what|$removed|$added\n"); + + # If we have a field name in the What field. + if ($what) { + $order++; + # If this is a two-line "What" field... + if( grep($what =~ $_, UNWRAP_WHAT) ) { + # Then we need to grab the next line right now. + my $next_line = shift @diff_table; + debug_print("Next Line: $next_line"); + $next_line =~ /^(.*)\|(.*)\|(.*)$/; + my ($next_what, $next_removed, $next_added) = + (trim($1), trim($2), trim($3)); + + debug_print("Two-line What: [$what][$next_what]"); + $what = append_diffline($what, $what, $next_what, + WIDTH_WHAT); + if ($next_added) { + debug_print("Two-line Added: [$added][$next_added]"); + $added = append_diffline($added, $added, + $next_added, WIDTH_ADDED); + } + if ($next_removed) { + debug_print("Two-line Removed: [$removed][$next_removed]"); + $removed = append_diffline($removed, $removed, + $next_removed, WIDTH_REMOVED); + } + } + + $changes{$order} = [$what, $removed, $added]; + debug_print("Filed as $what: $removed => $added"); + + # We only set $prev_what if we actually had a $what to put in it. + $prev_what = $what; + } + # Otherwise we're getting data from a previous What. + else { + my $prev_what = $changes{$order}[0]; + my $new_removed = append_diffline($changes{$order}[1], + $prev_removed, $removed, WIDTH_REMOVED); + my $new_added = append_diffline($changes{$order}[2], + $prev_added, $added, WIDTH_ADDED); + + $changes{$order} = [$prev_what, $new_removed, $new_added]; + debug_print("Filed as $prev_what: $removed => $added"); + } + + ($prev_removed, $prev_added) = ($this_removed, $this_added); + } + + return %changes; +} + +# Takes a reference to an array of lines and returns a hashref +# containing data for a buglog entry. +# Returns undef if the bug should not be entered into the log. +sub parse_mail ($) { + my ($mail_lines) = @_; + my $mail_text = join('', @$mail_lines); + my $email = Email::MIME->new($mail_text); + + debug_print("Parsing Message " . $email->header('Message-ID')); + + my $body = $email->body; + my @body_lines = split("\n", $body); + + my %bug_info; + + # Bug ID + my $subject = $email->header('Subject'); + + if ($subject !~ /^\s*\[Bug (\d+)\] /i) { + debug_print("Not bug: $subject"); + return undef; + } + $bug_info{'bug_id'} = $1; + debug_print("Bug $bug_info{bug_id} found."); + + # Ignore Dependency mails + # XXX - This should probably be an option in the mozbot instead + if (my ($dep_line) = + grep /bug (\d+), which changed state\.\s*$/, @body_lines) + { + debug_print("Dependency change ignored: $dep_line."); + return undef; + } + + # Product + $bug_info{'product'} = $email->header('X-Bugzilla-Product'); + unless ($bug_info{'product'}) { + debug_print("X-Bugzilla-Product header not found."); + return undef; + } + debug_print("Product '$bug_info{product}' found."); + + # Component + $bug_info{'component'} = $email->header('X-Bugzilla-Component'); + unless ($bug_info{'component'}) { + debug_print("X-Bugzilla-Component header not found."); + return undef; + } + debug_print("Component '$bug_info{component}' found."); + + # Who + $bug_info{'who'} = $email->header('X-Bugzilla-Who'); + + # New or Changed + # For Bugzilla vers < 3.0, this code also decides who + if ($subject =~ /^\s*\[Bug \d+\]\s*New: /i) { + $bug_info{'new'} = 1; + debug_print("Bug is New."); + unless ($bug_info{'who'}) { + my ($reporter) = grep /^\s+ReportedBy:\s/, @body_lines; + $reporter =~ s/^\s+ReportedBy:\s//; + $bug_info{'who'} = $reporter; + } + } + elsif (!$bug_info{'who'}) { + if ( my ($changer_line) = grep /^\S+\schanged:$/, @body_lines) { + $changer_line =~ /^(\S+)\s/; + $bug_info{'who'} = $1; + } + elsif ( my ($comment_line) = + grep /^-+.*Comment.*From /i, @body_lines ) + { + $comment_line =~ /^-+.*Comment.*From (\S+) /i; + $bug_info{'who'} = $1; + } + } + + unless ($bug_info{'who'}) { + debug_print("Could not determine who made the change."); + return undef; + } + debug_print("Who = $bug_info{who}"); + + # Attachment + my $attachid; + if (($attachid) = grep /^Created an attachment \(id=\d+\)/, @body_lines) { + $attachid =~ /^Created an attachment \(id=(\d+)\)/; + $bug_info{'attach_id'} = $1; + debug_print("attach_id: $bug_info{attach_id}"); + } + + # Duplicate + my $dupid; + if (($dupid) = grep /marked as a duplicate of (?:bug\s)?\d+/, @body_lines) { + $dupid =~ /marked as a duplicate of (?:bug\s)?(\d+)/; + $bug_info{'dup_of'} = $1; + debug_print("Got dup_of: $bug_info{dup_of}"); + } + + # Figure out where the diff table ends, and where comments start. + my $comments_start_at = 0; + foreach my $check_line (@body_lines) { + last if $check_line =~ /^-+.*Comment.*From /i; + $comments_start_at++; + } + + debug_print("Comments start at line $comments_start_at."); + my @diff_lines = @body_lines[0 .. ($comments_start_at - 1)]; + my %diffs = parse_diffs(\@diff_lines); + $bug_info{'diffs'} = \%diffs; + + return \%bug_info; +} + +# Takes the %bug_info hash returned from parse_mail and +# makes it into one or more lines for the bugmail log. +# BugMail Log Lines have the following format: +# ID::::Product::::Component::::Who::::FieldName::::OldValue::::NewValue::::message +# OldValue and NewValue can be empty. +# FieldName will be 'NewBug' for new bugs, and 'NewAttach' for new attachments. +# Each line ends with a newline, except the last one. +sub generate_log ($) { + my ($bug_info) = @_; + + my $prefix = $bug_info->{'bug_id'} . FIELD_SEPARATOR + . $bug_info->{'product'} . FIELD_SEPARATOR + . $bug_info->{'component'} . FIELD_SEPARATOR + . $bug_info->{'who'} . FIELD_SEPARATOR; + + my @lines; + + # New bugs are easy to handle, so let's handle them first. + if ($bug_info->{'new'}) { + push(@lines, $prefix . 'NewBug' . FIELD_SEPARATOR + # Old and New are empty. + . FIELD_SEPARATOR . FIELD_SEPARATOR + . "New $bug_info->{product} bug $bug_info->{bug_id}" + . " filed by $bug_info->{who}."); + } + + if ($bug_info->{'attach_id'}) { + push(@lines, $prefix . 'NewAttach' . FIELD_SEPARATOR + # Old and New are empty. + . FIELD_SEPARATOR . FIELD_SEPARATOR + . "$bug_info->{'who'} added attachment $bug_info->{'attach_id'}" + . " to bug $bug_info->{'bug_id'}."); + } + + # And now we handle changes by going over all the diffs, one by one. + my %diffs = %{$bug_info->{'diffs'}}; + foreach my $id (sort(keys %diffs)) { + my $field = $diffs{$id}[0]; + my $old = $diffs{$id}[1]; + my $new = $diffs{$id}[2]; + + # For attachments, we don't want to include the bug number in + # the output. + $field =~ s/^(Attachment)( .)(\d+)/$1/; + my $attach_id = $3; + + # Flags get a *very* special handling. + if ($field =~ /Flag$/) { + my %flags = parse_flags($new, $old); + foreach my $flag (keys %flags) { + my ($old_flag, $new_flag) = @{$flags{$flag}}; + my $line = $prefix . $field . FIELD_SEPARATOR + . $old_flag . FIELD_SEPARATOR + . $new_flag . FIELD_SEPARATOR + . $bug_info->{'who'}; + $line .= flag_action($new_flag, $old_flag); + if ($field =~ /^Attachment/) { + $line .= " for attachment $attach_id"; + } + $line .= " on bug $bug_info->{bug_id}."; + push(@lines, $line); + } + } + + # All other, non-Flag fields. + else { + my $line = $prefix . $field . FIELD_SEPARATOR + . $old . FIELD_SEPARATOR . $new . FIELD_SEPARATOR + . $bug_info->{who}; + # Some fields require the verbs "added" and "removed", like the + # CC field. + if (MULTI_FIELDS->{$field}) { + ($line .= " added $new to") if $new; + ($line .= " and") if $new && $old; + ($line .= " removed $old from") if $old; + $line .= " the $field field on bug $bug_info->{bug_id}."; + } + # If we didn't remove anything, only added something. + elsif (!$old) { + $line .= " set the $field field on bug" + . " $bug_info->{bug_id} to $new"; + # Hack for "RESOLVED DUPLICATE" messages. + $line .= ' of bug ' . $bug_info->{dup_of} if exists $bug_info->{dup_of}; + $line .= '.'; + } + # If we didn't add anything, only removed something. + elsif (!$new) { + $line .= " cleared the $field '$old' from bug" + . " $bug_info->{bug_id}."; + } + # If we changed a field from one value to another. + else { + $line .= " changed the $field on bug" + . " $bug_info->{bug_id} from $old to $new."; + } + push(@lines, $line); + } + } + + debug_print("Generated Log Lines."); + debug_print("Log Line: $_") foreach (@lines); + + return join("\n", @lines); +} + +# Takes a string and appends it to the buglog. +sub append_log ($) { + my ($string) = @_; + + (open FILE, ">>" . $bug_log) + or die "Couldn't open bug log file $bug_log: $!"; + debug_print("Waiting for a lock on the log..."); + flock(FILE, LOCK_EX); + print FILE $string . "\n"; + flock(FILE, LOCK_UN); + debug_print("Printed lines to log and unlocked file."); + close FILE; +} + + +##################################################################### +# Main Script +##################################################################### + +debug_print("\n\n"); + +unless (-e $bug_log) { + print STDERR "$bug_log does not exist, so I assume that mozbot is not" + . " running. Discarding incoming message.\n"; + exit; +} + +my @mail_array = ; +my $bug_info = parse_mail(\@mail_array); + +if (defined $bug_info) { + my $log_lines = generate_log($bug_info); + # If we got an email with just a comment, $log_lines will be empty. + append_log($log_lines) if $log_lines; +} + +debug_print("All done!"); +exit; diff --git a/BotModules/BugzillaMailHandler.txt b/BotModules/BugzillaMailHandler.txt new file mode 100644 index 0000000..524270c --- /dev/null +++ b/BotModules/BugzillaMailHandler.txt @@ -0,0 +1,91 @@ +BugzillaMailHandler.pl is a script that takes in mail from a +Bugzilla installation and possibly reports information about that +mail to specified channels. + +Basically, with BugzillaMailHandler.pl, you can use MozBot to inform +you about updates to bugs. For the Bugzilla project, we use this to +inform us whenever a bug is filed, whenever an attachment is added, +and whenever a bug is fixed. We also have it let us know about certain +flags, so that we can go handle those flags quickly. + +To use BugzillaMailHandler.pl: + +1) Start mozbot, and load the Bugzilla.bm module. + +2) Set up your MTA (sendmail, postfix, exim, qmail, etc.) to pipe all + mail coming to a certain address into the script instead of a local + mailbox. + + Your MTA must be able to write to files owned by the user that mozbot + is running as. For example, on my local system, my mozbot is run + as a user called "mozbot." I run postfix, so I have postfix become + the "mozbot" user before running BugzillaMailHandler.pl. + +3) Now, all bugmail coming in to BugzillaMailHandler will start producing + input in BotModules/.bugmail.log (a hidden file). Mail that isn't in + the standard Bugzilla format will be discarded. Mails that just have + comments, or just inform that a dependency has been RESOLVED will be + ignored. + +4) Now, you need to tell your bot to start reporting certain Bugzilla + Products to certain channels. In the future, there will be a command + for this, but for now you have to do it manually. There is a variable + in the Bugzilla module called "productReportChannels." It's a hash -- + the keys are names of products, and the values are comma-separated + lists of channels. + +5) Once you set that variable, your mozbot will start reporting changes + to the specified products, in the specified channels. + + However, it won't report *all* changes -- it will only report the + changes to fields that are specified in the "reportFields" variable, + which is a list of fields. Most fields have the *name that they would + have in a Bugzilla email*, in the "What" column of the table where + the mail shows bug changes. + + There are some special fields: + + Attachment Flag - Any attachment flag change. + NewBug - When a new bug is filed. + NewAttach - When a new attachment is posted to a bug. + +Now, your mozbot should be up and running and reporting the changes +that you want! + +Other Notes +----------- + +There are a few other features that you can use to fine-tune how MozBot +reports bug changes. First, anybody (not just a bot admin) can tell the +bot to temporarily stop reporting changes from a certain Bugzilla user: + + ignore user@domain.com + +And to turn back on notifications about that user: + + unignore user@domain.com + +There are also some variables you can use to configure how mozbot reports +changes, and what changes he reports: + + channelMuteFields - A hash, where the key is the name of a channel, and + the value is a comma-separated list of Fields, just + like they would show up in the reportFields var. + Changes to these fields will *not* be reported in + the specified channels, but will still be reported + in the other channels mozbot is configured to announce + things to. + + productMuteFields - A hash, where the key is the name of a Product in + Bugzilla, and the value is a comma-separated list + of Fields, just like they would show up in the + reportFields var. + Changes to the specified Fields on the specified + products will not be reported to any channel, ever. + + updateDelay - How often mozbot checks for information in the + .bugmail.log file. Usually you can keep this at the + default, unless you want to increase it for some reason. + +Questions about this functionality can be asked in #mozwebtools on +irc.mozilla.org. diff --git a/BotModules/COPYING b/BotModules/COPYING new file mode 100644 index 0000000..9711529 --- /dev/null +++ b/BotModules/COPYING @@ -0,0 +1,27 @@ +Unless otherwise stated, the contents of these file are subject to +the Mozilla Public License Version 1.1 (the "License"); you may +not use this file except in compliance with the License. You may +obtain a copy of the License at http://www.mozilla.org/MPL/ + +Software distributed under the License is distributed on an "AS +IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or +implied. See the License for the specific language governing +rights and limitations under the License. + +The Original Code is the Bugzilla Bug Tracking System. + +The Initial Developer of the Original Code is Netscape +Communications Corporation. Portions created by Netscape are +Copyright (C) 1998 Netscape Communications Corporation. All Rights +Reserved. + +Contributor(s): Harrison Page + Terry Weissman + Risto Kotalampi + Josh Soref + Ian Hickson + Zach Lipton + Jake Steenhagen + mental + Mohamed Elzakzoki + Jeff Bisbee diff --git a/BotModules/CVS/Entries b/BotModules/CVS/Entries new file mode 100644 index 0000000..a75b79f --- /dev/null +++ b/BotModules/CVS/Entries @@ -0,0 +1,43 @@ +/Bugzilla.bm/2.27/Wed Dec 17 22:26:18 2008//TMOZBOT-2_6 +/BugzillaMailHandler.pl/2.9/Wed Dec 17 22:51:25 2008//TMOZBOT-2_6 +/BugzillaMailHandler.txt/2.1/Thu May 12 22:47:21 2005//TMOZBOT-2_6 +/COPYING/2.5/Sun Oct 5 20:06:38 2003//TMOZBOT-2_6 +/Converter.bm/1.7/Wed Feb 18 14:42:55 2004//TMOZBOT-2_6 +/Currencies.bm/1.1/Sun Feb 1 16:06:18 2004//TMOZBOT-2_6 +/FTP.bm/2.2/Fri Oct 3 15:46:54 2003//TMOZBOT-2_6 +/Filter.bm/2.0/Mon Apr 23 07:09:06 2001//TMOZBOT-2_6 +/Flood.bm/1.2/Fri Oct 3 15:46:54 2003//TMOZBOT-2_6 +/FortuneCookies.bm/2.2/Sat Jan 24 23:56:12 2004//TMOZBOT-2_6 +/General.bm/2.13/Wed Apr 1 04:55:20 2009//TMOZBOT-2_6 +/God.bm/2.6/Sat Sep 4 16:26:56 2004//TMOZBOT-2_6 +/Google.bm/1.2/Sat Feb 21 02:15:14 2009//TMOZBOT-2_6 +/Greeting.bm/2.23/Thu Dec 18 06:08:43 2008//TMOZBOT-2_6 +/HelloWorld.bm/2.0/Mon Apr 23 07:09:07 2001//TMOZBOT-2_6 +/Infobot.bm/1.20/Tue Mar 17 18:05:38 2009//TMOZBOT-2_6 +/Infobot.pl/1.2/Sat Jan 24 18:40:07 2004//TMOZBOT-2_6 +/Infobot.txt/1.1/Mon Feb 25 15:49:23 2002//TMOZBOT-2_6 +/Insult.bm/1.3/Sat Apr 24 23:54:35 2004//TMOZBOT-2_6 +/Karma.bm/1.9/Mon Mar 15 13:19:23 2004//TMOZBOT-2_6 +/KeepAlive.bm/2.0/Mon Apr 23 07:09:08 2001//TMOZBOT-2_6 +/KookBot.bm/1.2/Sun Oct 19 22:33:00 2003//TMOZBOT-2_6 +/List.bm/2.1/Mon Mar 4 21:44:54 2002//TMOZBOT-2_6 +/MagicEightBall.bm/1.3/Fri Oct 3 15:46:54 2003//TMOZBOT-2_6 +/MiniLogger.bm/2.1/Tue Feb 19 21:42:04 2002//TMOZBOT-2_6 +/Parrot.bm/2.1/Thu Feb 7 08:33:17 2002//TMOZBOT-2_6 +/Quiz.bm/2.5/Fri Oct 3 15:46:54 2003//TMOZBOT-2_6 +/Quotes.bm/1.7/Tue May 3 18:38:43 2005//TMOZBOT-2_6 +/RDF.bm/2.4/Fri Nov 7 16:44:43 2008//TMOZBOT-2_6 +/Rude.bm/2.4/Sat Sep 4 16:30:13 2004//TMOZBOT-2_6 +/Seen.bm/1.3/Sat Feb 21 01:53:30 2009//TMOZBOT-2_6 +/ServicesLogin.bm/2.3/Fri Nov 7 16:35:03 2008//TMOZBOT-2_6 +/Sheriff.bm/2.1/Sun Jan 25 13:04:23 2004//TMOZBOT-2_6 +/Spell.bm/1.4/Wed Apr 1 03:52:29 2009//TMOZBOT-2_6 +/Stocks.bm/1.5/Thu Nov 6 18:58:10 2008//TMOZBOT-2_6 +/Tinderbox.bm/2.11/Sun Dec 28 06:39:26 2008//TMOZBOT-2_6 +/Translate.bm/2.2/Fri Nov 7 16:52:29 2008//TMOZBOT-2_6 +/UUIDGen.bm/2.1/Sat Nov 15 19:56:45 2008//TMOZBOT-2_6 +/WWW.bm/2.2/Mon Dec 24 08:56:37 2007//TMOZBOT-2_6 +/Wishlist.bm/2.2/Fri Dec 1 23:49:49 2006//TMOZBOT-2_6 +/XMLLogger.bm/1.3/Tue Jan 27 01:29:18 2004//TMOZBOT-2_6 +/devel.txt/2.10/Tue May 3 18:38:43 2005//TMOZBOT-2_6 +D diff --git a/BotModules/CVS/Entries.Log b/BotModules/CVS/Entries.Log new file mode 100644 index 0000000..b0e78cd --- /dev/null +++ b/BotModules/CVS/Entries.Log @@ -0,0 +1,2 @@ +A D/Quiz//// +R D/Quiz//// diff --git a/BotModules/CVS/Repository b/BotModules/CVS/Repository new file mode 100644 index 0000000..3129b17 --- /dev/null +++ b/BotModules/CVS/Repository @@ -0,0 +1 @@ +mozilla/webtools/mozbot/BotModules diff --git a/BotModules/CVS/Root b/BotModules/CVS/Root new file mode 100644 index 0000000..cdb6f4a --- /dev/null +++ b/BotModules/CVS/Root @@ -0,0 +1 @@ +:pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot diff --git a/BotModules/CVS/Tag b/BotModules/CVS/Tag new file mode 100644 index 0000000..0fe9246 --- /dev/null +++ b/BotModules/CVS/Tag @@ -0,0 +1 @@ +NMOZBOT-2_6 diff --git a/BotModules/Converter.bm b/BotModules/Converter.bm new file mode 100644 index 0000000..631a91b --- /dev/null +++ b/BotModules/Converter.bm @@ -0,0 +1,630 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Converter Module # +################################ +# Originally by GluffiS + +package BotModules::Converter; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# XXX support the suffixes "to sf" or "to dp" +# XXX support speed, volume, twips +# XXX support light year, parsec, furlong; fm, pm, µm, Mm, Gm, Tm, Pm +# XXX support 1x10^1 notation as well as the already-supported 1e1 notation + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'A generic converter. Currently supports converting between positive integers in binary, octal, decimal and hexidecimal forms, and converting temperatures, lengths, times and masses.', + 'syntax' => 'To convert a number, simply give the number with units or appropriate prefixes, for example to convert from hexadecimal: \'0x2F\'', + 'integers' => 'Decimal: Simply give the number. Hexadecimal: Prefix with 0x. Octal: Prefix with 0. Binary: Prefix with 0b.', + 'temperature' => 'Kelvin: Suffix with K. Celsius: Suffix with C. Fahrenheit: Suffix with F.', + 'length' => 'Imperial: in, ft, yd, mi. Metric: A, nm, mm, cm, m, km.', # XXX should also support light year, parsec, furlong; fm, pm, µm, Mm, Gm, Tm, Pm + 'time' => 'ISO time units: year, month, week, day, hour, minute, second. Exotic time units: millifortnight.', + 'mass' => 'Imperial: lbs, oz, stone. Metric: kg, g.', + # XXX should support speed, volume, twips + }; +} + + +sub Told { + my $self = shift; + my ($event, $message) = @_; + + # integers + if ($message =~ m/^\s*([1-9][0-9]*|0)\s*\??\s*$/osi) { + $self->convertDecimal($event, $1); + } elsif ($message =~ m/^\s*0x([a-f0-9]+)\s*\??\s*$/osi) { + $self->convertHex($event, $1); + } elsif ($message =~ m/^\s*0([0-9]+)\s*\??\s*$/osi) { + $self->convertOctal($event, $1); + } elsif ($message =~ m/^\s*0b([0-9]+)\s*\??\s*$/osi) { + $self->convertBinary($event, $1); + + # temperatures + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:kelvin|K)\s*\??\s*$/osi) { + $self->convertKelvin($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:deg(?:rees?)|[\`°])?\s*(?:cel[sc]ius|centigrade|c)\s*\??\s*$/osi) { + $self->convertCelsius($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:deg(?:rees?)|[\`°])?\s*(?:fahrenheit|f)\s*\??\s*$/osi) { + $self->convertFahrenheit($event, $1); + + # imperial lengths + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:ins?|inch(?:es)?)\s*\??\s*$/osi) { + $self->convertInches($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:ft|feet|foot)\s*\??\s*$/osi) { + $self->convertFeet($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:yds?|yards?)\s*\??\s*$/osi) { + $self->convertYards($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:mi|miles?)\s*\??\s*$/osi) { + $self->convertMiles($event, $1); + + # metric lengths + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:Å|a|angstroms?)\s*\??\s*$/osi) { + $self->convertAngstroms($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:nms?|nanometers?|nanometres?)\s*\??\s*$/osi) { + $self->convertNanometers($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:mms?|millimeters?|millimetres?)\s*\??\s*$/osi) { + $self->convertMillimeters($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:cms?|centimeters?|centimetres?)\s*\??\s*$/osi) { + $self->convertCentimeters($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:m|meters?|metres?)\s*\??\s*$/osi) { + $self->convertMeters($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:kms?|kilometers?|kilometres?|klic?ks?)\s*\??\s*$/osi) { + $self->convertKilometers($event, $1); + + # times + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:years|year|yr)\s*\??\s*$/osi) { + $self->convertYears($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:months|month|mo)\s*\??\s*$/osi) { + $self->convertMonths($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:weeks|week|wk)\s*\??\s*$/osi) { + $self->convertWeeks($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:fortnights|fortnight|mf)\s*\??\s*$/osi) { + $self->convertMillifortnights($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:days|day|d)\s*\??\s*$/osi) { + $self->convertDays($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:hours|hour|hr|h)\s*\??\s*$/osi) { + $self->convertHours($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:minutes|minute|min)\s*\??\s*$/osi) { + $self->convertMinutes($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:seconds|second|sec|s)\s*\??\s*$/osi) { + $self->convertSeconds($event, $1); + + # masses + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:grams|gram|g)\s*\??\s*$/osi) { + $self->convertGrams($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:kilograms|kilogram|kilos|kilo|kg)\s*\??\s*$/osi) { + $self->convertKilograms($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:pounds|pound|lbs)\s*\??\s*$/osi) { + $self->convertPounds($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:ounces|ounce|oz)\s*\??\s*$/osi) { + $self->convertOunces($event, $1); + } elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:stones|stone)\s*\??\s*$/osi) { + $self->convertStones($event, $1); + + # oh well + } else { + return $self->SUPER::Told(@_); + } + return 0; +} + + +# Integers + +sub convertDecimal { + my $self = shift; + my($event, $decimal) = @_; + my $hex = sprintf('%X', $decimal); + my $octal = sprintf('%o', $decimal); + my $binary = sprintf('%b', $decimal); + $self->say($event, "$event->{'from'}: $decimal = 0x$hex, 0$octal, 0b$binary"); +} + +sub convertHex { + my $self = shift; + my($event, $hex) = @_; + my $decimal = hex($hex); + my $hex = sprintf('%X', $decimal); # normalise + my $octal = sprintf('%o', $decimal); + my $binary = sprintf('%b', $decimal); + $self->say($event, "$event->{'from'}: 0x$hex = $decimal, 0$octal, 0b$binary"); +} + +sub convertOctal { + my $self = shift; + my($event, $octal) = @_; + my $decimal = oct("0$octal"); + my $hex = sprintf('%X', $decimal); + my $binary = sprintf('%b', $decimal); + $self->say($event, "$event->{'from'}: 0$octal = $decimal, 0x$hex, 0b$binary"); +} + +sub convertBinary { + my $self = shift; + my($event, $binary) = @_; + my $decimal = oct("0b$binary"); + my $hex = sprintf('%X', $decimal); + my $octal = sprintf('%o', $decimal); + $self->say($event, "$event->{'from'}: 0b$binary = $decimal, 0x$hex, 0$octal"); +} + + +# Temperature + +sub convertKelvin { + my $self = shift; + my($event, $kelvin) = @_; + my $celsius = round(1, $kelvin - 273.14); + my $fahrenheit = round(1, ($kelvin - 273.14) * 9 / 5 + 32); + my $kelvin = round(1, $kelvin); # normalise + my $prognosis = diagnoseTemperature($kelvin, $celsius, $fahrenheit); + $self->say($event, "$event->{'from'}: ${kelvin}K = $celsius°C, $fahrenheit°F, $prognosis"); +} + +sub convertCelsius { + my $self = shift; + my($event, $celsius) = @_; + my $kelvin = round(1, $celsius + 273.14); + my $fahrenheit = round(1, $celsius * 9 / 5 + 32); + my $celsius = round(1, $celsius); # normalise + my $prognosis = diagnoseTemperature($kelvin, $celsius, $fahrenheit); + $self->say($event, "$event->{'from'}: $celsius°C = ${kelvin}K, $fahrenheit°F, $prognosis"); +} + +sub convertFahrenheit { + my $self = shift; + my($event, $fahrenheit) = @_; + my $celsius = round(1, ($fahrenheit - 32) * 5 / 9); + my $kelvin = round(1, ($fahrenheit - 32) * 5 / 9 + 273.14); + my $fahrenheit = round(1, $fahrenheit); # normalise + my $prognosis = diagnoseTemperature($kelvin, $celsius, $fahrenheit); + $self->say($event, "$event->{'from'}: $fahrenheit°F = ${kelvin}K, $celsius°C, $prognosis"); +} + +sub diagnoseTemperature($$$) { + my($kelvin, $celsius, $fahrenheit) = @_; + return + $kelvin < 0 ? 'an impossible temperature' : + $kelvin == 0 ? 'absolute zero' : + $fahrenheit < 0 ? 'extremely cold' : + $celsius < 0 ? 'freezing cold' : + $celsius == 0 ? 'freezing point of water' : + $celsius < 18 ? 'cold' : + $celsius == 20 ? 'standard room temperature' : + $celsius < 25 ? 'warm' : + $celsius < 35 ? 'hot' : + $celsius <= 37 ? 'body temperature' : + $celsius < 65 ? 'very hot' : + $celsius < 95 ? 'scorching hot' : + $celsius == 100 ? 'boiling point of water' : + $celsius < 105 ? 'boiling hot' : + 'ridiculously hot'; +} + + +# Imperial Lengths + +sub convertInches { + my $self = shift; + my($event, $inches) = @_; + # imperial + # (inches) + my $feet = sigfig(3, $inches / 12.0); + my $yards = sigfig(3, $inches / 36.0); + my $miles = sigfig(3, $inches / 63360.0); + # metric + my $kilometers = sigfig(3, $inches * 0.0000254); + my $meters = sigfig(3, $inches * 0.0254); + my $centimeters = sigfig(3, $inches * 2.54); + my $millimeters = sigfig(3, $inches * 25.4); + my $nanometers = sigfig(3, $inches * 25400000.0); + my $angstroms = sigfig(3, $inches * 254000000.0); + # normalise + my $inches = sigfig(3, $inches); + $self->say($event, "$event->{'from'}: ${inches}in = ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)"); +} + +sub convertFeet { + my $self = shift; + my($event, $feet) = @_; + my $inches = $feet * 12.0; + # imperial + # (inches) + my $feet = sigfig(3, $inches / 12.0); + my $yards = sigfig(3, $inches / 36.0); + my $miles = sigfig(3, $inches / 63360.0); + # metric + my $kilometers = sigfig(3, $inches * 0.0000254); + my $meters = sigfig(3, $inches * 0.0254); + my $centimeters = sigfig(3, $inches * 2.54); + my $millimeters = sigfig(3, $inches * 25.4); + my $nanometers = sigfig(3, $inches * 25400000.0); + my $angstroms = sigfig(3, $inches * 254000000.0); + # normalise + my $inches = sigfig(3, $inches); + $self->say($event, "$event->{'from'}: ${feet}ft = ${inches}in, ${yards}yd, ${miles}mi, ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)"); +} + +sub convertYards { + my $self = shift; + my($event, $yards) = @_; + my $inches = $yards * 36.0; + # imperial + # (inches) + my $feet = sigfig(3, $inches / 12.0); + my $yards = sigfig(3, $inches / 36.0); + my $miles = sigfig(3, $inches / 63360.0); + # metric + my $kilometers = sigfig(3, $inches * 0.0000254); + my $meters = sigfig(3, $inches * 0.0254); + my $centimeters = sigfig(3, $inches * 2.54); + my $millimeters = sigfig(3, $inches * 25.4); + my $nanometers = sigfig(3, $inches * 25400000.0); + my $angstroms = sigfig(3, $inches * 254000000.0); + # normalise + my $inches = sigfig(3, $inches); + $self->say($event, "$event->{'from'}: ${yards}yd = ${inches}in, ${feet}ft, ${miles}mi, ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)"); +} + +sub convertMiles { + my $self = shift; + my($event, $miles) = @_; + my $inches = $miles * 190080.0; + # imperial + # (inches) + my $feet = sigfig(3, $inches / 12.0); + my $yards = sigfig(3, $inches / 36.0); + my $miles = sigfig(3, $inches / 63360.0); + # metric + my $kilometers = sigfig(3, $inches * 0.0000254); + my $meters = sigfig(3, $inches * 0.0254); + my $centimeters = sigfig(3, $inches * 2.54); + my $millimeters = sigfig(3, $inches * 25.4); + my $nanometers = sigfig(3, $inches * 25400000.0); + my $angstroms = sigfig(3, $inches * 254000000.0); + # normalise + my $inches = sigfig(3, $inches); + $self->say($event, "$event->{'from'}: ${miles}mi = ${inches}in, ${feet}ft, ${yards}yd, ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)"); +} + + +# Metric Lengths + +sub convertAngstroms { + my $self = shift; + my($event, $input) = @_; + # get the number + my $accurateMeters = $input / 10000000000.0; + $self->debug("Accurate KiloMeters: ".$accurateMeters/1000); + # imperial + my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0)); + my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0)); + my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0)); + my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0)); + # metric + my $kilometers = sigfig(3, $accurateMeters / 1000.0); + my $meters = sigfig(3, $accurateMeters); + my $centimeters = sigfig(3, $accurateMeters * 100.0); + my $millimeters = sigfig(3, $accurateMeters * 1000.0); + my $nanometers = sigfig(3, $accurateMeters * 1000000000.0); + my $angstroms = sigfig(3, $accurateMeters * 10000000000.0); + $self->say($event, "$event->{'from'}: ${angstroms}Å = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm (to 3sf)"); +} + +sub convertNanometers { + my $self = shift; + my($event, $input) = @_; + # get the number + my $accurateMeters = $input / 1000000000.0; + # imperial + my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0)); + my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0)); + my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0)); + my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0)); + # metric + my $kilometers = sigfig(3, $accurateMeters / 1000.0); + my $meters = sigfig(3, $accurateMeters); + my $centimeters = sigfig(3, $accurateMeters * 100.0); + my $millimeters = sigfig(3, $accurateMeters * 1000.0); + my $nanometers = sigfig(3, $accurateMeters * 1000000000.0); + my $angstroms = sigfig(3, $accurateMeters * 10000000000.0); + $self->say($event, "$event->{'from'}: ${nanometers}nm = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${angstroms}Å (to 3sf)"); +} + +sub convertMillimeters { + my $self = shift; + my($event, $input) = @_; + # get the number + my $accurateMeters = $input / 1000.0; + # imperial + my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0)); + my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0)); + my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0)); + my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0)); + # metric + my $kilometers = sigfig(3, $accurateMeters / 1000.0); + my $meters = sigfig(3, $accurateMeters); + my $centimeters = sigfig(3, $accurateMeters * 100.0); + my $millimeters = sigfig(3, $accurateMeters * 1000.0); + my $nanometers = sigfig(3, $accurateMeters * 1000000000.0); + my $angstroms = sigfig(3, $accurateMeters * 10000000000.0); + $self->say($event, "$event->{'from'}: ${millimeters}mm = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${centimeters}cm, ${nanometers}nm, ${angstroms}Å (to 3sf)"); +} + +sub convertCentimeters { + my $self = shift; + my($event, $input) = @_; + # get the number + my $accurateMeters = $input / 100.0; + # imperial + my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0)); + my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0)); + my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0)); + my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0)); + # metric + my $kilometers = sigfig(3, $accurateMeters / 1000.0); + my $meters = sigfig(3, $accurateMeters); + my $centimeters = sigfig(3, $accurateMeters * 100.0); + my $millimeters = sigfig(3, $accurateMeters * 1000.0); + my $nanometers = sigfig(3, $accurateMeters * 1000000000.0); + my $angstroms = sigfig(3, $accurateMeters * 10000000000.0); + $self->say($event, "$event->{'from'}: ${centimeters}cm = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)"); +} + +sub convertMeters { + my $self = shift; + my($event, $input) = @_; + # get the number + my $accurateMeters = $input * 1.0; + # imperial + my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0)); + my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0)); + my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0)); + my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0)); + # metric + my $kilometers = sigfig(3, $accurateMeters / 1000.0); + my $meters = sigfig(3, $accurateMeters); + my $centimeters = sigfig(3, $accurateMeters * 100.0); + my $millimeters = sigfig(3, $accurateMeters * 1000.0); + my $nanometers = sigfig(3, $accurateMeters * 1000000000.0); + my $angstroms = sigfig(3, $accurateMeters * 10000000000.0); + $self->say($event, "$event->{'from'}: ${meters}m = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)"); +} + +sub convertKilometers { + my $self = shift; + my($event, $input) = @_; + # get the number + my $accurateMeters = $input * 1000.0; + # imperial + my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0)); + my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0)); + my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0)); + my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0)); + # metric + my $kilometers = sigfig(3, $accurateMeters / 1000.0); + my $meters = sigfig(3, $accurateMeters); + my $centimeters = sigfig(3, $accurateMeters * 100.0); + my $millimeters = sigfig(3, $accurateMeters * 1000.0); + my $nanometers = sigfig(3, $accurateMeters * 1000000000.0); + my $angstroms = sigfig(3, $accurateMeters * 10000000000.0); + $self->say($event, "$event->{'from'}: ${kilometers}km = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)"); +} + + +# Time + +sub convertYears { + my $self = shift; + my($event, $input) = @_; + my $accurateSeconds = $input * 60.0 * 60.0 * 24.0 * 365.25; + my $years = sigfig(3, $input); + my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12))); + my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)))); + my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0)); + my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0)); + my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0)); + my $minutes = sigfig(3, $accurateSeconds / 60.0); + my $seconds = sigfig(3, $accurateSeconds); + $self->say($event, "$event->{'from'}: ${years}yr = ${months}mo, ${weeks}wk, ${days}d, ${hours}hr, ${minutes}min, ${seconds}s, ${millifortnights}mf"); +} + +sub convertMonths { + my $self = shift; + my($event, $input) = @_; + my $accurateSeconds = $input * 60.0 * 60.0 * 24.0 * (365.25 / 12); + my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25)); + my $months = sigfig(3, $input); + my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)))); + my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0)); + my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0)); + my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0)); + my $minutes = sigfig(3, $accurateSeconds / 60.0); + my $seconds = sigfig(3, $accurateSeconds); + $self->say($event, "$event->{'from'}: ${months}mo = ${years}yr, ${weeks}wk, ${days}d, ${hours}hr, ${minutes}min, ${seconds}s, ${millifortnights}mf"); +} + +sub convertWeeks { + my $self = shift; + my($event, $input) = @_; + my $accurateSeconds = $input * 60.0 * 60.0 * 24.0 * 7.0; + my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25)); + my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12))); + my $weeks = sigfig(3, $input); + my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0)); + my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0)); + my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0)); + my $minutes = sigfig(3, $accurateSeconds / 60.0); + my $seconds = sigfig(3, $accurateSeconds); + $self->say($event, "$event->{'from'}: ${weeks}wk = ${years}yr, ${months}mo, ${days}d, ${hours}hr, ${minutes}min, ${seconds}s, ${millifortnights}mf"); +} + +sub convertMillifortnights { + my $self = shift; + my($event, $input) = @_; + my $accurateSeconds = $input * 60.0 * 60.0 * 24.0 * 7.0 * 2.0 / 1000.0; + my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25)); + my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12))); + my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)))); + my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0)); + my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0)); + my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0)); + my $minutes = sigfig(3, $accurateSeconds / 60.0); + my $seconds = sigfig(3, $accurateSeconds); + $self->say($event, "$event->{'from'}: ${millifortnights}mf = ${years}yr, ${months}mo, ${weeks}wk, ${days}d, ${hours}hr, ${minutes}min, ${seconds}s"); +} + +sub convertDays { + my $self = shift; + my($event, $input) = @_; + my $accurateSeconds = $input * 60.0 * 60.0 * 24.0; + my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25)); + my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12))); + my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)))); + my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0)); + my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0)); + my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0)); + my $minutes = sigfig(3, $accurateSeconds / 60.0); + my $seconds = sigfig(3, $accurateSeconds); + $self->say($event, "$event->{'from'}: ${days}d = ${years}yr, ${months}mo, ${weeks}wk, ${hours}hr, ${minutes}min, ${seconds}s, ${millifortnights}mf"); +} + +sub convertHours { + my $self = shift; + my($event, $input) = @_; + my $accurateSeconds = $input * 60.0 * 60.0; + my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25)); + my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12))); + my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)))); + my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0)); + my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0)); + my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0)); + my $minutes = sigfig(3, $accurateSeconds / 60.0); + my $seconds = sigfig(3, $accurateSeconds); + $self->say($event, "$event->{'from'}: ${hours}hr = ${years}yr, ${months}mo, ${weeks}wk, ${days}d, ${minutes}min, ${seconds}s, ${millifortnights}mf"); +} + +sub convertMinutes { + my $self = shift; + my($event, $input) = @_; + my $accurateSeconds = $input * 60.0; + my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25)); + my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12))); + my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)))); + my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0)); + my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0)); + my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0)); + my $minutes = sigfig(3, $accurateSeconds / 60.0); + my $seconds = sigfig(3, $accurateSeconds); + $self->say($event, "$event->{'from'}: ${minutes}min = ${years}yr, ${months}mo, ${weeks}wk, ${days}d, ${hours}hr, ${seconds}s, ${millifortnights}mf"); +} + +sub convertSeconds { + my $self = shift; + my($event, $input) = @_; + my $accurateSeconds = $input; + my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25)); + my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12))); + my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)))); + my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0)); + my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0)); + my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0)); + my $minutes = sigfig(3, $accurateSeconds / 60.0); + my $seconds = sigfig(3, $accurateSeconds); + $self->say($event, "$event->{'from'}: ${seconds}s = ${years}yr, ${months}mo, ${weeks}wk, ${days}d, ${hours}hr, ${minutes}min, ${millifortnights}mf"); +} + + +# Mass + +sub convertGrams { + my $self = shift; + my($event, $input) = @_; + my $accurateGrams = $input; + my $grams = sigfig(3, $accurateGrams); + my $kgs = sigfig(3, $accurateGrams / 1000.0); + my $ounces = sigfig(3, $accurateGrams * 0.03527); + my $pounds = sigfig(3, $accurateGrams * 0.002205); + my $stones = sigfig(3, $accurateGrams * 0.00016); + $self->say($event, "$event->{'from'}: ${grams}g = ${kgs}kg, ${ounces}oz, ${pounds}lbs, ${stones}stone"); +} + +sub convertKilograms { + my $self = shift; + my($event, $input) = @_; + my $accurateGrams = $input * 1000.0; + my $grams = sigfig(3, $accurateGrams); + my $kgs = sigfig(3, $input); + my $ounces = sigfig(3, $accurateGrams * 0.03527); + my $pounds = sigfig(3, $accurateGrams * 0.002205); + my $stones = sigfig(3, $accurateGrams * 0.00016); + $self->say($event, "$event->{'from'}: ${kgs}kg = ${grams}g, ${ounces}oz, ${pounds}lbs, ${stones}stone"); +} + +sub convertPounds { + my $self = shift; + my($event, $input) = @_; + my $accurateGrams = $input * 453.6; + my $grams = sigfig(3, $accurateGrams); + my $kgs = sigfig(3, $accurateGrams / 1000.0); + my $ounces = sigfig(3, $accurateGrams * 0.03527); + my $pounds = sigfig(3, $input); + my $stones = sigfig(3, $accurateGrams * 0.00016); + $self->say($event, "$event->{'from'}: ${pounds}lbs = ${grams}g, ${kgs}kg, ${ounces}oz, ${stones}stone"); +} + +sub convertOunces { + my $self = shift; + my($event, $input) = @_; + my $accurateGrams = $input * 28.35; + my $grams = sigfig(3, $accurateGrams); + my $kgs = sigfig(3, $accurateGrams / 1000.0); + my $ounces = sigfig(3, $input); + my $pounds = sigfig(3, $accurateGrams * 0.002205); + my $stones = sigfig(3, $accurateGrams * 0.00016); + $self->say($event, "$event->{'from'}: ${ounces}oz = ${grams}g, ${kgs}kg, ${pounds}lbs, ${stones}stone"); +} + +sub convertStones { + my $self = shift; + my($event, $input) = @_; + my $accurateGrams = $input * 6350.3; + my $grams = sigfig(3, $accurateGrams); + my $kgs = sigfig(3, $accurateGrams / 1000.0); + my $ounces = sigfig(3, $accurateGrams * 0.03527); + my $pounds = sigfig(3, $accurateGrams * 0.002205); + my $stones = sigfig(3, $accurateGrams * 0.00016); + $self->say($event, "$event->{'from'}: ${stones}stone = ${grams}g, ${kgs}kg, ${ounces}oz, ${pounds}lbs"); +} + + +# Utility Functions + +sub round($$) { + return sprintf("%.*f", @_); +} + +sub sigfig($$) { + my($sf, $float) = @_; + my $length = length(int($float)); + if ($length == $sf) { + $float = int($float); + } elsif ($length > $sf) { + my $factor = (10 ** ($length - $sf)); + $float = int($float / $factor) * $factor; + } else { + my $factor = 0; + while (length(int($float * 10 ** $factor)) < $sf) { + $factor++; + } + $float = int($float * 10 ** $factor) / (10 ** $factor); + } + $float = sprintf("%g", $float); + $float =~ s/e(?:\+|(-))0*/x10^$1/os; + return $float; +} diff --git a/BotModules/Currencies.bm b/BotModules/Currencies.bm new file mode 100644 index 0000000..796b2be --- /dev/null +++ b/BotModules/Currencies.bm @@ -0,0 +1,60 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Currencies Module # +################################ +# Originally by Alex Schuilenburg + +package BotModules::Currencies; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'This module gets mid-market currency exchange rates from: http://www.xe.com/ucc/full.shtml', + 'currency' => 'Call this command with two currency symbols to get the exchange rate. Syntax: \'currency [value] SYM/SYM\'. For the list of supported currencies, see: http://www.xe.com/iso4217.htm', + }; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*(?:currency|how\s+much\s+is|what\s+is|what\s+are)\s+(\d*(?:.\d+)?)\s*([A-Z]{3})s?\s*(?:\/|in|as)\s*([A-Z]{3})s?[\s?!.]*$/osi) { + my $amount = $1 || 1; + my $from = uc $2; + my $to = uc $3; + $self->getURI($event, "http://www.xe.com/ucc/convert.cgi?From=$from&To=$to&Amount=$amount", 'currency', $from, $to); + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub GotURI { + my $self = shift; + my ($event, $uri, $output, $cmd, $from, $to) = @_; + $self->debug($output); + my $message = "$event->{'from'}: "; + if ($cmd eq 'currency') { + my $fromval; + if ($output =~ m/([\d,]+\.\d+)\s+$from/s) { + $fromval = $1; + } + my $toval; + if ($output =~ m/([\d,]+\.\d+)\s+$to/s) { + $toval = $1; + } + if (defined $fromval and defined $toval) { + $message .= "$fromval $from = $toval $to (mid-market rates from xe.com)"; + } elsif ($output =~ m/The following error occurred:

\s*(.+?)\s*<\//os) { + $message .= "xe.com said: $1"; + } else { + $message .= 'I\'m afraid I can\'t get currency conversions right now. Sorry.'; + } + } else { + return $self->SUPER::GotURI(@_); + } + $self->say($event, $message); +} diff --git a/BotModules/FTP.bm b/BotModules/FTP.bm new file mode 100644 index 0000000..ce9e19d --- /dev/null +++ b/BotModules/FTP.bm @@ -0,0 +1,248 @@ +################################ +# FTP Module # +################################ + +package BotModules::FTP; +use vars qw(@ISA); +use Net::FTP; +@ISA = qw(BotModules); +1; + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['host', 1, 1, 'ftp.mozilla.org'], + ['path', 1, 1, '/pub/mozilla/nightly/latest'], + ['updateDelay', 1, 1, 600], + ['preferredLineLength', 1, 1, 80], + ['data', 0, 0, {}], # data -> file -> datetime stamp + ['mutes', 1, 1, ''], # "channel channel channel" + ); +} + +# Schedule - called when bot connects to a server, to install any schedulers +# use $self->schedule($event, $delay, $times, $data) +# where $times is 1 for a single event, -1 for recurring events, +# and a +ve number for an event that occurs that many times. +sub Schedule { + my $self = shift; + my ($event) = @_; + $self->schedule($event, \$self->{'updateDelay'}, -1, 'ftp'); + $self->SUPER::Schedule($event); +} + +sub Help { + my $self = shift; + my ($event) = @_; + my %commands = ( + '' => "This module monitors the FTP site 'ftp://$self->{'host'}$self->{'path'}/' and reports new files as they appear.", + 'ftp' => 'On its own, lists the currently available files. With a suffix, does a substring search and reports all files matching that pattern. Syntax: \'ftp [pattern]\'', + ); + if ($self->isAdmin($event)) { + $commands{'mute'} = 'Disable reporting of new files in a channel. Syntax: mute ftp in '; + $commands{'unmute'} = 'Enable reporting of new files in a channel. Syntax: unmute ftp in '; + } + return \%commands; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*ftp(?:\s+(\S+?))?\s*\?*\s*$/osi) { + $self->spawnChild($event, \&ftp_check, [$self, $self->{'path'}, $self->{'host'}], 'ftp', [$event, $1]); + } elsif ($self->isAdmin($event)) { + if ($message =~ /^\s*mute\s+ftp\s+in\s+(\S+?)\s*$/osi) { + $self->{'mutes'} .= " $1"; + $self->saveConfig(); + $self->say($event, "$event->{'from'}: Reporting of new files disabled in channel $1."); + } elsif ($message =~ /^\s*unmute\s+ftp\s+in\s+(\S+)\s*$/osi) { + my %mutedChannels = map { $_ => 1 } split(/ /o, $self->{'mutes'}); + delete($mutedChannels{$1}); # get rid of any mentions of that channel + $self->{'mutes'} = join(' ', keys(%mutedChannels)); + $self->saveConfig(); + $self->say($event, "$event->{'from'}: Reporting of new files reenabled in channel $1."); + } else { + return $self->SUPER::Told(@_); + } + } else { + return $self->SUPER::Told(@_); + } +} + +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + if ($data[0] eq 'ftp') { + $self->spawnChild($event, \&ftp_check, [$self, $self->{'path'}, $self->{'host'}], 'ftp', [undef]); + } else { + $self->SUPER::Scheduled($event, @data); + } +} + +# ChildCompleted - Called when a child process has quit +sub ChildCompleted { + my $self = shift; + my ($event, $type, $output, @data) = @_; + if ($type eq 'ftp') { + my @output = split(/\n/os, $output); + if (shift(@output)) { + my @new = (); + while (@output) { + my ($file, $stamp) = (shift(@output), shift(@output)); + if ((defined($self->{'data'}->{$file})) and ($self->{'data'}->{$file} < $stamp)) { + push(@new, $file); + } + $self->{'data'}->{$file} = $stamp; + } + if ((defined($self->{'_ready'})) and (scalar(@new))) { + my $s = scalar(@new) > 1 ? 's' : ''; + @output = $self->prettyPrint($self->{'preferredLineLength'}, + "New file$s in ftp://$self->{'host'}$self->{'path'}/ : ", + '', ' ', @new); + foreach my $channel (@{$self->{'channels'}}) { + unless ($self->{'mutes'} =~ /^(.*\s|)\Q$channel\E(|\s.*)$/si) { + $event->{'target'} = $channel; + foreach (@output) { + $self->say($event, $_); + } + } + } + } + $self->{'_ready'} = 1; + if ($data[0]) { + $self->ftp_stamp($event, $data[1]); + } + } else { + if ($data[0]) { + $self->say($event, "I could not contact $self->{'host'}, sorry."); + } + $self->tellAdmin($event, "Dude, I'm having a problem with FTP. Could you prod $self->{'host'} for me please? Or fix my config? Cheers."); + } + } else { + $self->SUPER::ChildCompleted($event, $type, $output, @data); + } +} + + + +# The following is directly from the original techbot (mozbot 1.5), written by timeless. +# The only changes I made were to port it to the mozbot2 architecture. Those changes +# are commented. + +sub day_str { + my (@stamp,$ahr,$amn,$asc); + ($asc, $amn, $ahr, @stamp)=gmtime($_[3]); + $asc = "0$asc" if $asc < 10; # \ + $amn = "0$amn" if $amn < 10; # -- added these to zero-pad output + $ahr = "0$ahr" if $ahr < 10; # / + return "$_[4] ($ahr:$amn:$asc) " # added extra space to neaten output + if ($stamp[0]==$_[0] && $stamp[1]==$_[1] && $stamp[2]==$_[2]); +} + +sub ftp_stamp { + + # It seems that the original wanted ($to, $cmd, $rest) as the arguments. + # However, it doesn't use $to except at the end (which we replace) and + # it doesn't use $cmd at all. This is lucky for us, since the first + # argument of methods is always the object ref. + my $self = $_[0]; + # This function also expects to be able to use a global (!) variable + # called %latestbuilds. We grandfather that by making a lexically scoped + # copy of one of our object fields. + my %latestbuilds = %{$self->{'data'}}; + # We have to keep a copy of $event around for when we send out the + # output, of course. So let's use the second argument for that: + my $event = $_[1]; + # Finally, we have to work around a serious bug in the original version, + # which assumed any pattern input was valid regexp. [XXX use eval] + $_[2] = defined($_[2]) ? quotemeta($_[2]) : 0; + # In summary, call this function like this: + # $self->ftp_stamp($event, $pattern); + + + # various instances of time() below were changed to use $event->{'time'} + # so that we are less prone to time drift + my @day=gmtime($event->{'time'}); my @tm=@day[0..2]; @day=@day[3..5]; + my (@filestamp, $filelist, $ahr,$amn,$asc); + if ($_[2]){ # this code's output is *VERY* ugly. But I just took it as is, so deal with it. Patches welcome. + foreach my $filename (keys %latestbuilds){ + my @ltm=gmtime($latestbuilds{$filename}); + $filelist.="$filename [".($ltm[5]+1900).'-'.($ltm[4]+1)."-$ltm[3] $ltm[2]:$ltm[1]:$ltm[0]]" + if $filename=~/$_[2]/; + } + $filelist=$filelist||''; + $filelist="Files matching re:$_[2] [gmt] $filelist"; + }else{ + foreach my $filename (keys %latestbuilds){ + $filelist.=day_str(@day[0..2],$latestbuilds{$filename},$filename); + } + if ($filelist){ + $filelist="Files from today [gmt] $filelist"; + } else { + foreach my $filename (keys %latestbuilds){ + @day=gmtime($event->{'time'}-86400); @day=@day[3..5]; + $filelist.=day_str(@day[0..2],$latestbuilds{$filename},$filename); + } + $filelist="Files from yesterday [gmt] $filelist"|| # next line changed from " to \' and added missing '>' + ''; + } + } + + + # Append the current time for those not in GMT time zones + my @time; + foreach (@tm) { + # zero pad the time + $_ = "0$_" if $_ < 10; + # switch digits around (@tm is in reverse order) + unshift(@time, $_); + } + # output + local $"; + $" = ':'; + $filelist .= " time now: @time"; + # Ok, now we want to send out the results (held in $filelist). + $self->say($event, $filelist); +} + + +sub ftp_check { + + # ok, this function has been hacked for the new architecture. + # ftp_check is called in a spawned child. + # It returns the output in a fixed format back to the parent + # process. The format is + # 1 + # file + # timestamp + # file + # timestamp + # if it fails, the '1' will be missing (no output). + # It should be passed the following arguments: + # [$self, $path, $server] + my $self = $_[0]; + my $output = ''; + + my $buf=''; + my $mdtms; + my $ftpserver=$_[2]; + my $ftp = new Net::FTP($ftpserver, Debug => 0, Passive => 1); + if ($ftp){ + $output .= "1\n"; # how we find out if it worked or not + if ($ftp->login('anonymous','mozbot@localhost')){ + $ftp->cwd($_[1]); # path used to be hardcoded + for my $f ($ftp->ls){ + $mdtms=$ftp->mdtm($f); + $output .= "$f\n$mdtms\n"; # output to pipe instead of irc + } + $ftp->quit; + }; + } + + # now send out the buffered output + return $output; + +} diff --git a/BotModules/Filter.bm b/BotModules/Filter.bm new file mode 100644 index 0000000..37dac78 --- /dev/null +++ b/BotModules/Filter.bm @@ -0,0 +1,83 @@ +################################ +# Filter Module # +################################ + +# The canonical filters should be installed on your path somewhere. +# You can get the source from these from your local distributor. + +package BotModules::Filter; +use vars qw(@ISA); +use IPC::Open2; +@ISA = qw(BotModules); +1; + +my @Filters = ( + 'b1ff', + 'chef', + 'cockney', + 'eleet', + 'jethro', + 'jibberish', + 'jive', + 'kraut', + 'nyc', + 'rasterman', + 'upside-down', +); + +sub Help { + my $self = shift; + my ($event) = @_; + my $reply = { + '' => 'This module is an interface to the text filter applications.', + }; + foreach (@Filters) { + $reply->{$_} = "Pass the text through the $_ filter. Syntax: $_ "; + } + if ($self->isAdmin($event)) { + $reply->{'filtersay'} = "Pass text through a filter and send it to a channel. Syntax: filtersay "; + } + return $reply; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + foreach (@Filters) { + if ($message =~ /^\s*\Q$_\E\s+(.+?)\s*$/si) { + $self->spawnChild($event, sub { return $self->Filter(@_); }, [$_, $1], 'filter', []); + return 0; # we've dealt with it, no need to do anything else. + } elsif (($message =~ /^\s*filtersay\s+\Q$_\E\s+(\S+)\s+(.+?)\s*$/si) and ($self->isAdmin($event))) { + $self->spawnChild($event, sub { return $self->Filter(@_); }, [$_, $2], 'filter', [$1]); + return 0; # we've dealt with it, no need to do anything else. + } + } + return $self->SUPER::Told(@_); +} + +sub Filter { + my $self = shift; + my($filter, $text) = @_; + my $reader; + my $writer; + local $/ = undef; + my $pid = open2($reader, $writer, $filter); + print $writer $text; + close($writer); + my $reply = <$reader>; + close($reader); + waitpid($pid, 0); + return $reply; +} + +# ChildCompleted - Called when a child process has quit +sub ChildCompleted { + my $self = shift; + my ($event, $type, $output, @data) = @_; + if ($type eq 'filter') { + local $event->{'target'} = $data[0] if defined($data[0]); + $self->say($event, $output); + } else { + return $self->SUPER::ChildCompleted(@_); + } +} diff --git a/BotModules/Flood.bm b/BotModules/Flood.bm new file mode 100644 index 0000000..447ff06 --- /dev/null +++ b/BotModules/Flood.bm @@ -0,0 +1,102 @@ +# -*- Mode: perl; indent-tabs-mode: nil -*- +# $Id: Flood.bm,v 1.2 2003/10/03 15:46:54 ian%hixie.ch Exp $ +########################### +# Flood Protection module # +########################### + +package BotModules::Flood; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + + foreach my $chan (@{$self->{'channels'}}) { + $self->registerVariables( ["join_$chan", 0, 0, []] ); + } + $self->registerVariables( + ['numberOfJoins', 1, 1, '7'], + ['secondsToTrigger', 1, 1, '2'], + ['minutesToProtect', 1, 1, '5'], + ); +} + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'This module will help control "join flood" attacks on IRC', + }; +} + +# Set - called to set a variable to a particular value. +sub Set { + my $self = shift; + my ($event, $variable, $value) = @_; + # If changing the setting for numberOfJoins make sure + # that the arrays are empty. Otherwise, reducing the + # numberOfJoins value would not work properly. + if ($variable eq 'numberOfJoins') { + foreach my $chan (@{$self->{'channels'}}) { + @{$self->{"join_$chan"}} = (); + } + } + # now actually do the setting of the variable + return $self->SUPER::Set($event, $variable, $value); +} + +sub JoinedChannel { + my $self = shift; + my ($event, $channel) = @_; + $self->registerVariables( ["join_$channel", 0, 0, []] ); + return $self->SUPER::JoinedChannel($event, $channel); # call inherited method +} + +sub SpottedJoin { + my $self = shift; + my ($event, $channel, $who) = @_; + # If numberOfJoins or secondsToTrigger is not a positive Integer, don't do anything + if ($self->{'numberOfJoins'} !~ m/^[1-9][0-9]*$/o || $self->{'secondsToTrigger'} !~ m/^[1-9][0-9]*$/o) { + # We didn't do anything, so don't pretend like we did :) + return $self->SUPER::SpottedJoin($event, $channel, $who); + } + # Here we have the 'join_times' array to push and shift to/from + push(@{$self->{"join_$channel"}}, $event->{'time'}); + if (scalar(@{$self->{"join_$channel"}}) >= $self->{'numberOfJoins'}) { + my $oldest = shift(@{$self->{"join_$channel"}}); + my $timechange = $event->{'time'} - $oldest; + if ($self->{'secondsToTrigger'} >= $timechange) { + # We have just seen many joins happen very quickly. This channel should + # have its mode set to +i until an op can figure out what went wrong. + $self->mode($event, $event->{'channel'}, '+i'); + my $extra_text = ""; + # If minutesToProtect is a positive integer we should set mode -i after + # that number of minutes has passed. + if ($self->{'minutesToProtect'} =~ m/^[1-9][0-9]*$/o) { + my $seconds = $self->{'minutesToProtect'} * 60; + my @mode = ('mode', $event->{'channel'}, '-i'); + $self->schedule($event, $seconds, 1, @mode); + $extra_text = "I'll set it -i in $self->{'minutesToProtect'} minutes"; + } + $self->say($event, "I just saw a lot of joins happen very quickly. Because of " . + "that I set this channel's mode to be Invite Only... $extra_text"); + } + } + # By returning 0 we ensure that a join won't be processed more than once. + return 0; +} + +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + + my $what = shift(@data); + if ($what eq 'mode') { + $self->mode($event, @data); + } else { + # Call the inherited event + return $self->SUPER::Schedule(@_); + } +} diff --git a/BotModules/FortuneCookies.bm b/BotModules/FortuneCookies.bm new file mode 100644 index 0000000..c6de4a4 --- /dev/null +++ b/BotModules/FortuneCookies.bm @@ -0,0 +1,143 @@ +################################ +# Fortune Cookie Module # +################################ + +package BotModules::FortuneCookies; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'A module to get random fortune cookies.', + 'fortune' => 'Same as \'cookie\', which see.', + 'cookie' => 'To get a fortune cookie, just tell me \'cookie\'. To set a new fortune cookie, see \'new\' (or \'add\'). To find out how many cookies are left, use \'cookie status\'.', + 'new' => 'To set a new fortune cookie, say \'new cookie\' followed by the text, e.g. \'new cookie: you will have a nice day\' or whatever. The string %from% will be replaced by the name of whoever requests the cookie.', + 'add' => 'To add a new fortune cookie, say \'add cookie\' followed by the text, e.g. \'add cookie: you will have a nice day\' or whatever. The string %from% will be replaced by the name of whoever requests the cookie.', + 'fetch' => 'The command \'fetch cookies from \' will add each line in to the cookie list. Cookie lists must start with one line that reads \'DATA FILE: cookies\' and must be at most 100 lines long. Blank lines and lines starting with a hash (\'#\') are ignored.', + }; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['cookies', 1, 1, ['The sun will rise in the east today, indicating nothing in particular.']], + ['cookiesIndex', 1, 1, 0], + ['cookiesLeft', 0, 1, 10], + ['bakingTime', 1, 1, 20], + ['cookiesMax', 1, 1, 10], + ); +} + +# Schedule - called when bot connects to a server, to install any schedulers +# use $self->schedule($event, $delay, $times, $data) +# where $times is 1 for a single event, -1 for recurring events, +# and a +ve number for an event that occurs that many times. +sub Schedule { + my $self = shift; + my ($event) = @_; + $self->schedule($event, \$self->{'bakingTime'}, -1, 'newCookie'); + $self->SUPER::Schedule($event); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*(?:please[,.!1?]*\s+)?(?:(?:can|could)\s+i\s+have\s+a\s+|give\s+me\s+a\s+)?(?:fortune\s+cookie|fortune|cookie)(?:[,!1.\s]+now)?(?:[,!1.\s]+please)?\s*[?!1.]*\s*$/osi) { + if ($self->{'cookiesLeft'} > 0) { + $self->{'cookiesLeft'}--; + my $cookie = $self->GetNext('cookies'); + $cookie =~ s/%from%/$event->{'from'}/gos; + $self->say($event, $cookie); + } else { + $self->say($event, 'I\'m sorry, I\'ve run out of cookies! You\'ll have to wait for me to bake some more.'); + } + } elsif ($message =~ /^\s*(?:new|add)\s+(?:fortune\s+cookie|fortune|cookie)[-!:,;.\s]+(.....+?)\s*$/osi) { + if (not $self->findEntry('cookies', $1)) { + push(@{$self->{'cookies'}}, $1); + my $count = scalar(@{$self->{'cookies'}}); + $self->say($event, "$event->{'from'}: Thanks! I have added that fortune cookie to my recipe book. I now have $count fortunes!"); + $self->saveConfig(); + } else { + $self->say($event, "$event->{'from'}: I'm pretty sure I already know that one."); + } + } elsif ($message =~ /^\s*cookie\s+(?:report|status|status\s+report)(?:\s+please)?[?!.1]*\s*$/osi) { + my $count = scalar(@{$self->{'cookies'}}); + $self->say($event, "My cookie basket has $self->{'cookiesLeft'} cookies left out of possible $self->{'cookiesMax'}. I have $count fortunes in my recipe book."); + } elsif ($message =~ /^\s*fetch\s+cookies\s+from\s+(.+?)\s*$/osi) { + $self->getURI($event, $1, 'cookies'); + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub GetNext { + my $self = shift; + my ($list) = @_; + $self->{"${list}Index"} = 0 if $self->{"${list}Index"} > $#{$self->{$list}}; + my $reply = $self->{$list}->[$self->{"${list}Index"}++]; + # should add some deterministic way of making the output appear more random here XXX + $self->saveConfig(); + return $reply; +} + +sub findEntry { + my $self = shift; + my ($list, $cookie) = @_; + $cookie =~ s/[\s,;.!?:]/_/gos; + $cookie = quotemeta($cookie); + $cookie =~ s/_/.*/gos; + my $regexp = qr/^$cookie$/is; + foreach my $text (@{$self->{$list}}) { + return 1 if $text =~ /$regexp/; + } + return 0; +} + +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + if ($data[0] eq 'newCookie') { + $self->{'cookiesLeft'}++ unless $self->{'cookiesLeft'} >= $self->{'cookiesMax'}; + } else { + $self->SUPER::Scheduled($event, @data); + } +} + + +sub GotURI { + my $self = shift; + my ($event, $uri, $output, $type) = @_; + if ($type eq 'cookies') { + my @output = split(/[\n\r]+/os, $output); + if ((@output) and ($output[0] eq "DATA FILE: $type")) { + if (@output <= 100) { + my $count = 0; + foreach (@output[1..$#output]) { + if (/^[^#].+$/os and length($_) < 255 and not $self->findEntry($type, $_)) { + push(@{$self->{$type}}, $_); + $count++; + } + } + my $total = scalar(@{$self->{$type}}); + my $s = $count > 1 ? 's' : ''; + if ($type eq 'cookies') { + $self->say($event, "$event->{'from'}: Thanks! I have added $count fortune cookie$s to my recipe book. I now have $total fortunes!"); + } + $self->saveConfig(); + } else { + $self->say($event, "$event->{'from'}: Sorry, but you can only import 100 lines at a time."); + } + } else { + $self->say($event, "$event->{'from'}: Sorry, but that's not a valid data file."); + } + } else { + return $self->SUPER::GotURI(@_); + } +} diff --git a/BotModules/General.bm b/BotModules/General.bm new file mode 100644 index 0000000..e0969ff --- /dev/null +++ b/BotModules/General.bm @@ -0,0 +1,171 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# General Module # +################################ + +package BotModules::General; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +my $VERSION = '2.6'; + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable?, value ] + ['preferredHelpLineLength', 1, 1, 90], + ['helpStyle', 1, 1, 'compact'], # change this to 'tidy' to use alternate style + ); +} + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'The module that provides the bot-wide services.', + 'help' => 'Gives information about modules and commands. Syntax: help []', + 'shutup' => 'Tells the bot to stop talking to you. Syntax: shut up', + }; +} + +# Told - Called for messages prefixed by the bot's nick +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*(?:help|commands?)(?:\s+($variablepattern))?[ ?!.]*\s*$/osi) { + if ($1) { + # display help for that command + # first, build the help file... + my %topicList; + foreach my $module (@modules) { + my $commands; + eval { + $commands = $module->Help($event); + }; + if ($@) { + $self->debug("Module $module is having errors reporting help:\n$@"); + next; + } + if ($commands->{''}) { + my @commands = grep { /./os } keys %$commands; + $topicList{lc($module->{'_name'})} = [] unless defined($topicList{lc($module->{'_name'})}); + push(@{$topicList{lc($module->{'_name'})}}, $commands->{''}); + if (@commands) { + local $" = ', '; + push(@{$topicList{lc($module->{'_name'})}}, "The $module->{'_name'} module has the following help topics: @commands"); + } + } + foreach (keys %$commands) { + $topicList{lc($_)} = [] unless defined($topicList{lc($_)}); + push(@{$topicList{lc($_)}}, $commands->{$_}); + } + } + if (defined($topicList{lc($1)})) { + foreach (@{$topicList{lc($1)}}) { + $self->say($event, "$1: $_"); + } + } else { + $self->say($event, "No help for topic '$1'."); + } + } else { + my $helpline = $self->getHelpLine(); + $self->directSay($event, "Help topics for mozbot $VERSION ($helpline):"); + $self->say($event, "$event->{'from'}: help info /msg'ed") if ($event->{'channel'}); + if ($self->{'helpStyle'} eq 'compact') { + $self->printHelpCompact($event); + } else { + $self->printHelpTidy($event); + } + $self->directSay($event, 'For help on a particular topic, type \'help \'. Note that some commands may be disabled in certain channels.'); + } + } elsif ($message =~ /^\s*shut\s*up\s*$/osi) { + my $queue = $self->getMessageQueue(); + my @messages = @$queue; + @$queue = (); + my $count = 0; + if ($event->{'channel'}) { + foreach my $message (@messages) { + if ($message->[0] eq $event->{'channel'} and + ref $message->[1] eq 'SCALAR' and + $message->[1] =~ m/^\Q$event->{'from'}\E:/osi) { + ++$count; + } else { + push(@$queue, $message); + } + } + } else { + foreach my $message (@messages) { + if (lc $message->[0] eq lc $event->{'from'}) { + ++$count; + } else { + push(@$queue, $message); + } + } + } + if ($count) { + $self->say($event, "$event->{'from'}: Dropped $count messages."); + } else { + $self->say($event, "$event->{'from'}: I wasn't talking to you."); + } + } else { + return $self->SUPER::Told(@_); + } + return 0; # dealt with it, do nothing else +} + +sub CTCPVersion { + my $self = shift; + my ($event, $who, $what) = @_; + my @modulenames = $self->getModules(); + local $" = ', '; + $self->ctcpReply($event, 'VERSION', "mozbot $VERSION (@modulenames)"); +} + +sub printHelpCompact { + my $self = shift; + my ($event) = @_; + local $" = ', '; # to reset font-lock: " + my @helplist; + foreach my $module ($self->getModules()) { + $module = $self->getModule($module); + my %commands = %{$module->Help($event)}; + my $moduleHelp = delete($commands{''}); + my @commands = sort keys %commands; + if (@commands) { + push(@helplist, "$module->{'_name'}: @commands"); + } elsif ($moduleHelp) { + push(@helplist, "$module->{'_name'}"); + } + } + foreach ($self->prettyPrint($self->{'preferredHelpLineLength'}, undef, ' ', '; ', @helplist)) { + $self->directSay($event, $_); + } +} + +sub printHelpTidy { + my $self = shift; + my ($event) = @_; + my @modules = sort $self->getModules(); + my $longestTitle = 0; + foreach my $module (@modules) { + $longestTitle = length($module) if length($module) > $longestTitle; + $module = [$module, sort keys %{$self->getModule($module)->Help($event)}]; + } + foreach my $module (@modules) { + my $title = shift(@$module); + my $topicCount = @$module; + if (@$module and $module->[0] eq '') { + shift(@$module); + } + my @topics = @$module; + $module = ' ' x ($longestTitle - length($title)) . $title; + if (@topics) { + $self->directSay($event, $module . ': ' . join(",\n" . ' ' x ($longestTitle + 2), $self->wordWrap($self->{'preferredHelpLineLength'} - $longestTitle - 2, undef, undef, ', ', @topics))); + } elsif ($topicCount) { + $self->directSay($event, "$module: (no commands)"); + } + } +} diff --git a/BotModules/God.bm b/BotModules/God.bm new file mode 100644 index 0000000..626d95c --- /dev/null +++ b/BotModules/God.bm @@ -0,0 +1,341 @@ +# -*- Mode: perl; indent-tabs-mode: nil -*- +################################ +# God Module # +################################ + +package BotModules::God; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# XXX should also do autovoice + +sub Help { + my $self = shift; + my ($event) = @_; + my $answer = { + '' => 'A per-channel auto-opper.', + 'ops' => 'Lists the autoop list for a channel. Syntax: \'ops in \'', + 'opme' => 'Checks the autoop list, and ops the speaker if they are on the autoop list. Must be used in a channel. Syntax: \'op me\' or \'opme\'', + 'mask' => 'Add or remove a regexp mask from a channel\'s autoop list. Only bot and channel admins can do this. USE OF THIS FEATURE IS HIGHLY DISCOURAGED AS IT IS VERY INSECURE!!! Syntax: \'add mask in \' to add and \'remove mask in \' to remove. The special word \'everywhere\' can be used instead of a channel name to add a mask that works in all channels.', + 'autoop' => 'Add someone to the autoop list for a channel. Only bot and channel admins can do this. Syntax: \'autoop in \'', + 'deautoop' => 'Remove someone from the autoop list for a channel. Only bot and channel admins can do this. Syntax: \'deautoop in \'', + 'enable' => 'Enable a module in a channel. Only bot and channel admins can do this. Syntax: \'enable in \'', + 'disable' => 'Disable a module in a channel. Only bot and channel admins can do this. Syntax: \'disable in \'', + }; + if ($self->isAdmin($event)) { + $answer->{'opme'} .= '. As an administrator, you can also say \'op me in \' or \'op me everywhere\' which will do the obvious things.'; + $answer->{'promote'} = 'Add someone to the channel admin list for a channel. Only bot admins can do this. Syntax: \'promote in \'', + $answer->{'demote'} = 'Remove someone from the channel admin list for a channel. Only bot admins can do this. Syntax: \'demote in \'', + } + return $answer; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['channelAdmins', 1, 1, {}], + ['channelOps', 1, 1, {}], + ['channelOpMasks', 1, 1, {}], + ['kickLog', 1, 1, []], + ['allowPrivateOpRequests', 1, 1, 1], + ['maxInChannel', 1, 1, 4], + ); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($event->{'level'} == 1) { + if ($message =~ /^\s*(?:list\s+)?ops\s+(?:in\s+|for\s+)?(\S+)\s*\??$/osi) { + my $channel = lc($1); + $self->listOps($event, $channel); + } elsif ($message =~ /^\s*autoop\s+(\S+)\s+in\s+(\S+)\s*$/osi) { + if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) { + my $channel = $2 eq 'everywhere' ? '' : lc($2); + $self->{'channelOps'}->{$channel} .= " $1"; + $self->saveConfig(); + $self->say($event, "$event->{'from'}: User '$1' added to the autoop list of channel '$2'."); + } else { + $self->say($event, "$event->{'from'}: Only channel administrators may add people to a channel's autoop list."); + } + } elsif ($message =~ /^\s*deautoop\s+(\S+)\s+in\s+(\S+)\s*$/osi) { + if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) { + my $channel = $2 eq 'everywhere' ? '' : lc($2); + my %people = map { $_ => 1 } split(/ +/os, $self->{'channelOps'}->{$channel}); + delete($people{$1}); # get rid of any mentions of that person + $self->{'channelOps'}->{$channel} = join(' ', keys(%people)); + $self->saveConfig(); + $self->say($event, "$event->{'from'}: User '$1' removed from the autoop list of channel '$2'."); + } else { + $self->say($event, "$event->{'from'}: Only channel administrators may remove people from a channel's autoop list."); + } + } elsif ($message =~ /^\s*add\s+mask\s+(\S+)\s+(?:in|to|for|from)\s+(\S+)\s*$/osi) { + if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) { + my $channel = $2 eq 'everywhere' ? '' : lc($2); + $self->{'channelOpMasks'}->{$channel} .= " $1"; + $self->saveConfig(); + $self->say($event, "$event->{'from'}: Mask '$1' added to the autoop list of channel '$2'."); + } else { + $self->say($event, "$event->{'from'}: Only channel administrators may add masks to a channel's autoop list."); + } + } elsif ($message =~ /^\s*remove\s+mask\s+(\S+)\s+(?:in|from|for|to)\s+(\S+)\s*$/osi) { + if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) { + my $channel = $2 eq 'everywhere' ? '' : lc($2); + my %people = map { $_ => 1 } split(/ +/os, $self->{'channelOpMasks'}->{$channel}); + delete($people{$1}); # get rid of any mentions of that person + $self->{'channelOpMasks'}->{$channel} = join(' ', keys(%people)); + $self->saveConfig(); + $self->say($event, "$event->{'from'}: Mask '$1' removed from the autoop list of channel '$2'."); + } else { + $self->say($event, "$event->{'from'}: Only channel administrators may remove masks from a channel's autoop list."); + } + } elsif ($message =~ /^\s*promote\s+(\S+)\s+in\s+(\S+)\s*$/osi) { + if ($self->isAdmin($event)) { + $self->{'channelAdmins'}->{lc($2)} .= " $1"; + $self->saveConfig(); + $self->say($event, "$event->{'from'}: User '$1' promoted to channel administrator status in channel '$2'."); + } else { + $self->say($event, "$event->{'from'}: Only administrators may promote people to channel admin status."); + } + } elsif ($message =~ /^\s*demote\s+(\S+)\s+in\s+(\S+)\s*$/osi) { + if ($self->isAdmin($event)) { + my %people = map { $_ => 1 } split(/ +/os, $self->{'channelAdmins'}->{lc($2)}); + delete($people{$1}); # get rid of any mentions of that person + $self->{'channelAdmins'}->{lc($2)} = join(' ', keys(%people)); + $self->saveConfig(); + $self->say($event, "$event->{'from'}: User '$1' removed from the channel administrator list of channel '$2'."); + } else { + $self->say($event, "$event->{'from'}: Only administrators may remove people's channel admin status."); + } + } elsif ($message =~ /^\s*enable\s+(\S+)\s+in\s+(\S+)\s*$/osi) { + if (($self->isAdmin($event)) or ($self->isChannelAdmin($event, $2))) { + my $module = $self->getModule($1); + if ($1) { + push(@{$module->{'channels'}}, lc($2)); + $module->saveConfig(); + $self->say($event, "$event->{'from'}: Module '$1' enabled in channel '$2'."); + } else { + $self->say($event, "$event->{'from'}: There is no module called '$1', sorry."); + } + } else { + $self->say($event, "$event->{'from'}: Only channel administrators may change a module's status."); + } + } elsif ($message =~ /^\s*disable\s+(\S+)\s+in\s+(\S+)\s*$/osi) { + if (($self->isAdmin($event)) or ($self->isChannelAdmin($event, $2))) { + my $module = $self->getModule($1); + if ($1) { + my %channels = map { $_ => 1 } @{$module->{'channels'}}; + delete($channels{lc($2)}); # get rid of any mentions of that channel + @{$module->{'channels'}} = keys %channels; + $module->saveConfig(); + $self->say($event, "$event->{'from'}: Module '$1' disabled in channel '$2'."); + } else { + $self->say($event, "$event->{'from'}: There is no module called '$1', sorry."); + } + } else { + $self->say($event, "$event->{'from'}: Only channel administrators may change a module's status."); + } + } elsif ($message =~ /^\s*(?:(?:(?:de)?autoop|promote|demote|enable|disable|add\s+mask|remove\s+mask)\s+(\S+)|(?:list\s+)?ops)\s*$/osi) { + $self->say($event, "$event->{'from'}: You have to give a channel, as in \' in \'."); + + # XXX next two could be merged, maybe. + } elsif ($message =~ /^\s*op\s*meh?[!1.,\s]*(?:now\s+)?(?:please|(b+[iea]+t+c+h+))?\s*[.!1]*\s*$/osi) { + if ($event->{'channel'}) { + if ($event->{'userName'}) { + unless ($self->checkOpping($event, $event->{'channel'}, $event->{'from'}, $self->isAdmin($event))) { + if ($1) { # only true if they said bitch + $self->say($event, "$event->{'from'}: No way, beetch!"); + } else { + $self->say($event, "$event->{'from'}: Sorry, you are not on my auto-op list."); + } + } + } else { + unless ($self->isMatchedByMask($event, $event->{'channel'}) and + $self->checkOpping($event, $event->{'channel'}, $event->{'from'})) { + $self->say($event, "$event->{'from'}: You haven't authenticated yet. See 'help auth' for details."); + } + } + } else { + $self->say($event, "$event->{'from'}: You have to use this command in public."); + } + } elsif ($message =~ /^\s*(?:please\s+)?op\s*me(?:\s+in\s+(\S+)|\s+everywhere)?[\s!1.]*\s*$/osi) { + if (($self->{'allowPrivateOpRequests'}) or ($self->isAdmin($event))) { + if ($1) { + $self->checkOpping($event, lc($1), $event->{'from'}, $self->isAdmin($event)); + } else { + foreach (@{$self->{'channels'}}) { + $self->checkOpping($event, $_, $event->{'from'}, $self->isAdmin($event)); + } + } + } else { + $self->say($event, "$event->{'from'}: Sorry, but no. Try \'help opme\' for details on commansyntax."); + } + } else { + my $parentResult = $self->SUPER::Told(@_); + return $parentResult < 2 ? 2 : $parentResult; + } + return 0; # we've dealt with it, no need to do anything ese. + } elsif ($event->{'level'} == 2) { + if (defined($event->{'God_channel'})) { + $event->{'God_channel_rights'} = $self->isChannelAdmin($event, $event->{'God_channel'}); + } + } + return $self->SUPER::Told(@_); +} + +# SpottedJoin - Called when someone joins a channel +sub SpottedJoin { + my $self = shift; + my ($event, $channel, $who) = @_; + $self->checkOpping(@_, 0); + return $self->SUPER::SpottedJoin(@_); # this should not stop anything else happening +} + +# do all channels when someone authenticates +sub Authed { + my $self = shift; + my ($event, $who) = @_; + foreach (@{$self->{'channels'}}) { + $self->checkOpping($event, $_, $who, 0); + } + return $self->SUPER::Authed(@_); # this should not stop anything else happening +} + +# check is someone is in the opping. +sub checkOpping { + my $self = shift; + my ($event, $channel, $who, $override) = @_; + if (($self->isAutoopped($event, $channel)) or ($self->isChannelAdmin($event, $channel)) or ($override)) { + $self->mode($event, $channel, '+o', $who); + return 1; + } + return 0; +} + +sub isChannelAdmin { + my $self = shift; + my ($event, $channel) = @_; + return (($event->{'userName'}) and + (defined($self->{'channelAdmins'}->{$channel})) and + ($self->{'channelAdmins'}->{$channel} =~ /^(|.*\s+)$event->{'userName'}(\s+.*|)$/s)); +} + +sub isAutoopped { + my $self = shift; + my ($event, $channel) = @_; + return ((($event->{'userName'}) and + (defined($self->{'channelOps'}->{$channel})) and + (($self->{'channelOps'}->{$channel} =~ /^(|.*\s+)$event->{'userName'}(\s+.*|)$/s) or + ($self->{'channelOps'}->{''} =~ /^(|.*\s+)$event->{'userName'}(\s+.*|)$/s))) or + ($self->isMatchedByMask($event, $channel))); +} + +# grrrr -- this insecure feature is here by popular demand +sub isMatchedByMask { + my $self = shift; + my ($event, $channel) = @_; + my $masks; + $masks .= $self->{'channelOpMasks'}->{$channel} if defined($self->{'channelOpMasks'}->{$channel}); + $masks .= ' '.$self->{'channelOpMasks'}->{''} if defined($self->{'channelOpMasks'}->{''}); + if (defined($masks)) { + my @masks = split(/ +/os, $masks); + my $user = $event->{'user'}; + foreach my $regexp (@masks) { + my $pattern; + if ($regexp =~ m/ ^ # start at the start + ([^!@]+) # nick part + \! # nick-username delimiter + ([^!@]+) # username part + \@ # username-host delimiter + ([^!@]+) # host part + $ # end at the end + /osx) { + + my $nick = $1; + my $user = $2; + my $host = $3; + + # This was entered as an IRC hostmask so we need to + # translate it into a regular expression. + foreach ($nick, $user, $host) { + $_ = quotemeta($_); # escape regular expression magic + s/\\\*/.*/gos; # translate "*" into regexp equivalent + } + + # If we don't match the first part of the host-mask + # (the user's nick) then we should not op them; we + # should just skip to the next mask. + next unless $event->{'from'} =~ m/^$nick$/i; + + # ok, create hostmask regexp + $pattern = "^$user\@$host\$"; + } else { + # this was entered as a regexp, check it is valid. + $pattern = $self->sanitizeRegexp($regexp); + } + if (($pattern =~ /[^\s.*+]/os) # pattern is non-trivial + and ($user =~ /$pattern/si)) { # pattern matches user + return 1; # op user (so insecure, sigh) + } + } + } + return 0; +} + +sub Kicked { + my $self = shift; + my ($event, $channel) = @_; + push(@{$self->{'kickLog'}}, "$event->{'from'} kicked us from $channel"); # XXX karma or something... ;-) + return $self->SUPER::Kicked(@_); +} + +sub getList { + my $self = shift; + my ($channel, $list) = @_; + my $data; + my @list; + $data = defined($self->{$list}->{$channel}) ? $self->{$list}->{$channel} : ''; + $data .= defined($self->{$list}->{''}) ? ' '.$self->{$list}->{''} : ''; + if ($data =~ /^\s*$/os) { + @list = ('(none)'); + } else { + @list = sort(split(/\s+/os, $data)); + while ((@list) and ($list[0] =~ /^\s*$/)) { shift @list; } + } + return @list; +} + +sub listOps { + my $self = shift; + my ($event, $channel) = @_; + my @admins = $self->getList($channel, 'channelAdmins'); + my @ops = $self->getList($channel, 'channelOps'); + my @masks = $self->getList($channel, 'channelOpMasks'); + + local $" = ' '; + my @output = (); + push(@output, "$channel admins: @admins"); + push(@output, "$channel ops: @ops"); + if (@masks > 2) { + push(@output, "$channel autoop masks:"); + foreach (@masks) { + push(@output, " $_"); + } + } else { + push(@output, "$channel autoop masks: @masks"); + } + if (scalar(@output) > $self->{'maxInChannel'}) { + foreach (@output) { + $self->directSay($event, $_); + } + $self->channelSay($event, "$event->{'from'}: long list /msg'ed"); + } else { + foreach (@output) { + $self->say($event, "$event->{'from'}: $_"); + } + } +} diff --git a/BotModules/Google.bm b/BotModules/Google.bm new file mode 100644 index 0000000..61db461 --- /dev/null +++ b/BotModules/Google.bm @@ -0,0 +1,150 @@ +################################ +# Google Module # +################################ + +# Original Author: Max Kanat-Alexander +# Author: Stephen Lau +# +# stevel's notes: +# The original version of this module used Net::Google which used the Google +# SOAP API. I've updated it to use the REST::Google::Search module which +# uses Google's AJAX API +# +# This API requires that you send a valid HTTP_REFERER, which you can set +# with the REFERER constant below: + +package BotModules::Google; +use vars qw(@ISA); +@ISA = qw(BotModules); +use REST::Google::Search; + +use constant SEPARATOR => ' -- '; +use constant REFERER => 'http://www.mozilla.org/projects/mozbot/'; +1; + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => q{Queries Google for specified search terms. }, + 'google' => q{Searches google for the specified terms.} + . q{Syntax: 'google '}, + 'fight' => q{Google fight two terms.} + . q{Syntax: 'fight vs. '} + }; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['maxResults', 1, 1, 8], + ['maxInChannel', 1, 1, 1], + ['safeSearch', 1, 1, 1], + ['maxLineLength', 1, 1, 256] + ); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + # We take anything that occurs at the end of the line, + # because Google will ignore punctuation anyway. + if ($message =~ /^(\s*google\s+)(.+)$/osi) { + my $terms = $2; + + my @searchResults = $self->doSearch($terms); + + if (!@searchResults) { + $self->say($event, "Nothing found."); + } + # If we are in a channel, and not a /msg + elsif ($event->{'channel'}) { + splice(@searchResults, $self->{'maxInChannel'}); + } + # We're in a /msg + else { + unshift(@searchResults, scalar(@searchResults) . " results found: "); + } + + foreach my $result (@searchResults) { + $self->say($event, $event->{'from'} . ': ' . $result); + } + } elsif ($message =~ /^(\s*fight\s+)(.+)\s+vs\.\s+(.+)\s*$/osi) { + my $term1 = $2; + my $term2 = $3; + my $results1 = $self->getNumResults($term1); + my $results2 = $self->getNumResults($term2); + + if ($results1 > $results2) { + $self->say($event, "$term1 beats $term2, $results1 to $results2!"); + } elsif ($results2 > $results1) { + $self->say($event, "$term2 beats $term1, $results2 to $results1!"); + } else { + $self->say($event, "It's a dead tie at $results1 results!"); + } + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub getNumResults { + my $self = shift; + my ($terms) = @_; + + REST::Google::Search->http_referer(REFERER); + my $res = REST::Google::Search->new( + q => $terms, + rsz => "large", + ); + + if ($res->responseStatus != 200) { + return 0; + } + + my $data = $res->responseData; + return $data->cursor->estimatedResultCount; +} +# Performs the actual Google search and returns the +# result as an array of lines to say. +sub doSearch { + my $self = shift; + my ($terms) = @_; + + my @searchLines = (); + REST::Google::Search->http_referer(REFERER); + my $res = REST::Google::Search->new( + q => $terms, + rsz => "large", + ); + + if ($res->responseStatus != 200) { + return @searchLines; + } + + my $data = $res->responseData; + my @results = $data->results; + + foreach my $result (@results) { + my $title = $result->title; + # The Google API puts tags into the title if the search + # terms appear in the title. + $title =~ s|||g; + $title = $self->unescapeXML($title); + my $url = $result->url; + my $line_size = (length($title) + length($result) + length(SEPARATOR)); + if ($line_size > $self->{'maxLineLength'} ) { + # The 3 is for the '...' + my $new_title_size = ($line_size - $self->{'maxLineLength'}) - 3; + my $title = substr($title, 0, $new_title_size) + . '...'; + } + my $resultLine = $title . SEPARATOR . $url; + push(@searchLines, $resultLine); + } + + return @searchLines; +} diff --git a/BotModules/Greeting.bm b/BotModules/Greeting.bm new file mode 100644 index 0000000..e8fc560 --- /dev/null +++ b/BotModules/Greeting.bm @@ -0,0 +1,361 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Greeting Module # +################################ + +package BotModules::Greeting; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'A polite module for saying hello and goodbye and so on.', + 'hi' => 'To greet the bot.', + 'bye' => 'To say goodbye to the bot.', + 'ping' => 'To check the bot is alive.', + 'status' => 'Gives the amount of time that the bot has been active.', + }; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['greetings', 1, 1, ['hi %', 'yo %', 'salut %', '%! dude!', '%: hello', '%', 'bonjour %', 'g\'day mate']], + ['greetingsIndex', 1, 1, 0], + ['byes', 1, 1, ['seeya %', 'bye %', 'night %', '/me waves goodbye to %']], + ['byesIndex', 1, 1, 0], + ['ow', 1, 1, ['%!! stop it!!', '%? You want something?', 'I\'m working! Leave me alone!', 'ow!', 'Leave me out of it!', '%: mean!']], + ['owIndex', 1, 1, 0], + ['veryow', 1, 1, ['OOOOWWWW!!!', 'GETOFF!!!', '/me fights back', 'Yikes! I\'m being attacked!!', '/me hits % over the head with a 2-by-4']], + ['veryowIndex', 1, 1, 0], + ['hit', 1, 1, ['/me smacks %target', '/me hits %target over the head with a hammer', '/me trips %target up and laughs', '%target! look over there! *smack*', '/me pokes %target in the ribs']], + ['hitIndex', 1, 1, 0], + ['hitProtected', 1, 1, {'hixie' => '%target: %source wanted me to hurt you but don\'t worry, i wuv you, i\'d never hurt you...', 'me' => '/me wacks %source in the legs with a crowbar', '' => '%source: Oh you\'d like that, wouldn\'t you, you sadist pervert.', 'yourself' => 'hey look everyone! %source likes to see others hurt themselves!', 'urself' => 'oh my! %source can\'t even spell! It\'s written "yourself", moron!'}], + ['hitEnabled', 1, 1, 1], # set to 0 to disable hitting + ['pat', 1, 1, ['/me patpats %target', '%target: yes dear, *pat* *pat*', '/me pats %target condescendingly', '%target: *pat* *pat*']], + ['patIndex', 1, 1, 0], + ['patProtected', 1, 1, {'' => '%source: what did I do now?', 'yourself' => '%source: why? what did i do wrong?'}], + ['hug', 1, 1, ['/me hugs %target', '%target: *hug*', '/me hugs %target lovingly', '%target: come \'ere! *hugs and kisses*']], + ['hugIndex', 1, 1, 0], + ['yousuck', 1, 1, ['%: no, *you* suck!', '/me pouts', '/me cries', '/me . o O ( now what have i done... )']], + ['yousuckIndex', 1, 1, 0], + ['thanks', 1, 1, ['sure thing %', 'np', '%: np', '%: just doing my job!']], + ['thanksIndex', 1, 1, 0], + ['listen', 1, 1, ['(*', '%: I\'m listening.', '%?']], + ['listenIndex', 1, 1, 0], + ['happy', 1, 1, [':)', '/me smiles', 'yay', '/me beams']], + ['happyIndex', 1, 1, 0], + ['unhappy', 1, 1, [':(', '/me sobs', '/me cries', '*sniff*', 'but... but...', '/me is all sad']], + ['unhappyIndex', 1, 1, 0], + ['vhappy', 1, 1, ['OOoh! %!', 'I love you too, %.']], + ['vhappyIndex', 1, 1, 0], + ['kinky', 1, 1, ['eep!', 'me-ow!', 'oh yeah! spank me baby!', '/me tickles %', 'he-llo, baby!']], + ['kinkyIndex', 1, 1, 0], + ['tickle', 1, 1, ['eep!', 'iiiih!', 'meep!', '/me tickles % back', 'yelp!']], + ['tickleIndex', 1, 1, 0], + ['apology', 1, 1, ['Apology accepted.', 'thanks', 's\'ok', 'heh', 'that\'s ok']], + ['apologyIndex', 1, 1, 0], + ['whoami', 1, 1, 'I am a bot. /msg me the word \'help\' for a list of commands.'], + ['lastrheet', 0, 0, 0], # time of last rheet + ['rheetbuffer', 1, 1, 10], # max of 1 rheet per this many seconds + ['rheetMaxEs', 1, 1, 100], # number of es at which to stop responding. + ['autoGreetMute', 1, 1, []], # channels to mute in + ['autoGreetings', 1, 1, {}], # people to greet and their greeting + ['autoGreeted', 0, 0, {}], # people to NOT greet, and the last time + ['autoGreetedBackoffTime', 1, 1, 20], # how long to not greet people (seconds) + ['evil', 1, 1, ['c++ is evil', '/me mumbles something about c++ being evil', 'c++ is e-- ah, nevermind.', 'c++ sucks', '/me frowns at %']], + ['evilIndex', 1, 1, 0], + ['evilBackoffTime', 1, 1, 36000], # how long to not insult c++ (10 hours by default) + ['evilMute', 1, 1, []], # channels to disable evil in, * for all channels + ['lastEvil', 1, 0, 0], # when the last c++ insult took place + ['assumeThanksTime', 1, 1, 10], # how long to assume that thanks are directed to us after hearing from them (seconds) + ['_lastSpoken', 0, 0, {}], # who has spoken to us + ['source', 1, 1, 'http://lxr.mozilla.org/mozilla/source/webtools/mozbot/'], # reply to give for CTCP SOURCE + ); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + my $now = $event->{'time'}; + $self->{'_lastSpoken'}->{$event->{'user'}} = $now; + my $me = quotemeta($event->{'bot'}->nick); + my $expandedme = join('+', split(//gos, $me)).'+'; + if ($message =~ /^\s*(?:(?:g[ood\']*\s*)?(?:mornin[g\']?|evenin[g\']?|afternoon|day)|hi|heya?|bonjour|hoi|w+a+[sz]+u+p+\?*|hello|lo|wb|welcome\s+back|greetings|yo(?:\s+yo)*(?:\s+du+de)?|m+[ayh]+(?:\s+m+a+i+n+)?\s+m+a+n+|d+u+d+e+)[?!1.\s]*(?::-?[\)Pp]\s*)*$/osi) { + if ($self->canGreet($event)) { + $self->Perform($event, 'greetings'); + } + } elsif ($message =~ /^\s*(?:bye|(?:g?'?|good\s+)night|seeya|ciao)[?!1.\s]*$/osi) { + $self->Perform($event, 'byes'); + } elsif ($message =~ /^\s*say[\s:,\"\']+(hi|hello|lo|good\s*bye|seeya)(?:\s+to\s+(\S+))(?:[,\s]*please)?[?!1.\s]*$/osi) { + if ($2) { + $self->say($event, "$2: $1"); + } else { + $self->say($event, "$1"); + } + } elsif ($message =~ /^\s* + (?: (?:you|u) \s+ + (?:really\s+)? + suck + (?: \s+hard + | (?:\s+big)? \s+ rocks)? + | (?:you|u) \s+ + (?:smell|stick) + | (?:you|u) + (?:\s+are|\s+r|'re|r) \s+ + (?:an?\s+)? + (?:really\s+)* + (?:idiot|stupid|dumb|moron|moronic|useless) + (?:\s+bot)? + | i \s+ hate \s+ (?:you|u) + | bi+tch) + [?!1.\s]*$/osix) { + $self->Perform($event, 'yousuck'); + } elsif ($message =~ /^\s*(?:oh[!1?.,\s]*)?(?:thanks|thank\s+you|cheers)[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) { + $self->Perform($event, 'thanks'); + } elsif ($message =~ /^\s*(?:good\s+bot[.!1\s]*|(?:you|u)\s+rock(?:\s+bot)?|:-?\)|(?:have\s+a\s+)?bot\s*snack[.!1\s]*)\s*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) { + $self->Perform($event, 'happy'); + } elsif ($message =~ /^\s*(?:i|we)\s+love\s+(?:you|u)[.!1\s]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) { + $self->Perform($event, 'happy'); + } elsif ($message =~ /^\s*(?:please[\s,.]+)?(?:(?:would|will)\s+you\s+)?(?:hit|kick|slap|smack)\s+(\S+?)(?:[\s,.]+please)?[.!?\s]*\s*$/osi) { + if ($self->{'hitEnabled'}) { + $self->PerformOnOther($event, 'hit', $1); + } + } elsif ($message =~ /^\s*(?:please[\s,.]+)?(?:(?:would|will)\s+you\s+)?(?:pat|pat\s*pat)\s+(\S+?)(?:[\s,.]+please)?[.!?\s]*\s*$/osi) { + $self->PerformOnOther($event, 'pat', $1); + } elsif ($message =~ /^\s*(?:please[\s,.]+)?(?:(?:would|will)\s+you\s+)?(?:hug)\s+(\S+?)(?:[\s,.]+please)?[.!?\s]*\s*$/osi) { + $self->PerformOnOther($event, 'hug', $1); + } elsif ($message =~ /^\s*(?:useless|die|get\s+a\s+life|kiss\s+my\s+ass|you\s+stupid\s+piece\s+o[f']?\s+code)[!1.\s]*$/osi) { + $self->Perform($event, 'unhappy'); + } elsif ($message =~ /^\s*sorry\b/osi) { # note that any trailing text is ignored + $self->Perform($event, 'apology'); + } elsif ($message =~ /^\s*(?:how\s+are\s+you|how\s+do\s+you\s+do|how\'?s\s+things|are\s+you\s+ok)(?:[?!1.,\s]+$expandedme)?\s*[?!1.\s]*$/osi) { + $uptime = $self->days($^T); + $self->say($event, "$event->{'from'}: fine thanks! I've been up $uptime so far!"); + } elsif ($message =~ /^\s*(?:who\s+are\s+you)\s*[?!1.\s]*$/osi) { + $self->say($event, "$event->{'from'}: $self->{'whoami'}"); + } elsif ($message =~ /^\s*(?:up\s*(?:time)|status)[?!1.\s]*$/osi) { + $uptime = $self->days($^T); + $self->say($event, "$event->{'from'}: I've been up $uptime."); + } elsif ($message =~ /^\s*r+h+e(e+)t+[!1.\s]*$/osi) { + if (length($1) < $self->{'rheetMaxEs'}) { + $self->say($event, "$event->{'from'}: rhe$1$1t!"); + } else { + $self->say($event, "$event->{'from'}: uh, whatever."); + } + } elsif ($message =~ /^\s*ping\s*$/osi) { + $self->say($event, "$event->{'from'}: pong"); + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Heard { + my $self = shift; + my ($event, $message) = @_; + my $me = quotemeta($event->{'bot'}->nick); + my $expandedme = join('+', split(//gos, $me)).'+'; + if ($message =~ /^\s*(?:(?:(?:(?:g[ood\']*\s*)?(?:mornin[g\']?|evenin[g\']?|afternoon|day)|hi|heya?|bonjour|hoi|w+a+[sz]+u+p+|hello|lo|wb|welcome\s+back|greetings|yo(?:\s+yo)*)\s+)?$expandedme[!1\s]*|o+h[\s,.!?]+look[\s,.!?]+a\s+$me[\s.!1]*)(?::-?[\)Pp]\s*)*$/si) { + if ($self->canGreet($event)) { + $self->Perform($event, 'greetings'); + } + } elsif ($message =~ /^\s*(?:bye|(?:g?\'?|good\s+)night|seeya|ciao)\s+$me[!1.\s]*$/si) { + $self->Perform($event, 'byes'); + } elsif ($message =~ /^\s*(?:oh[!1?,.\s]*)?(?:thanks|thank\s*you|cheers)\s+$me[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/si) { + $self->Perform($event, 'thanks'); + } elsif (($message =~ /^\s*(?:oh[!1?,.\s]*)?(?:thanks|thank\s*you|cheers)[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) and ($self->canAssumeThanks($event))) { + $self->Perform($event, 'thanks'); + } elsif (($message =~ /^\s*(?:good\s+bot)[!1.\s]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) and ($self->canAssumeThanks($event))) { + $self->Perform($event, 'happy'); + } elsif (($message =~ /^\s*(?:bad|foo[l\']?|idiot|dumb|useless|moron|moronic)(?:\s+bot)?[!.\s]*?$/osi) and ($self->canAssumeThanks($event))) { + $self->Perform($event, 'unhappy'); + } elsif (($message =~ /^\s*bad\s*$me[!.\s]*$/si) and ($self->canAssumeThanks($event))) { + $self->Perform($event, 'unhappy'); + } elsif (($message =~ /^\s* + (?: (?:you|u) \s+ + (?:really\s+)? + suck + (?: \s+hard + | (?:\s+big)? \s+ rocks)? + | (?:you|u) \s+ + (?:smell|stick) + | (?:you|u) + (?:\s+are|\s+r|'re|r) \s+ + (?:an?\s+)? + (?:really\s+)? + (?:idiot|stupid|dumb|moron|moronic) + (?:\s+bot)? + | i \s+ hate \s+ (?:you|u) + | bi+tch) + [?!1.\s]*$/osix) and + ($self->canAssumeThanks($event))) { + $self->Perform($event, 'yousuck'); + } elsif ($message =~ /^\s*(?:good(?:\s$me)?|yay[\s!1.]*|i\s+love\s+(?:you|u))\s+$me[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/si) { + $self->Perform($event, 'happy'); + } elsif ($message =~ /^\s*(?:$me\s*[.?\/]+)\s*$/si) { + $self->Perform($event, 'listen'); + } elsif ($message =~ /^\s*r+h(e+)t+[!1.\s]*$/osi) { + if (($event->{'time'}-$self->{'lastrheet'}) > $self->{'rheetbuffer'}) { + if (length($1) < $self->{'rheetMaxEs'}) { + $self->say($event, "rhe$1$1t!"); + } + $self->{'lastrheet'} = $event->{'time'}; + } + } elsif ($message =~ /^.+\s+c\+\+\s+.+$/osi) { + if (!(grep {$_ eq '*' or lc($_) eq $event->{'channel'}} @{$self->{'evilMute'}}) && + ($event->{'time'} - $self->{'lastEvil'}) > $self->{'evilBackoffTime'}) { + $self->{'lastEvil'} = $event->{'time'}; + $self->Perform($event, 'evil'); # calls GetNext which calls saveConfig + } + } else { + return $self->SUPER::Heard(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Felt { + my $self = shift; + my ($event, $message) = @_; + my $me = quotemeta($event->{'bot'}->nick); + if ($message =~ /^\s*(?:greets\s+$me|shakes\s+$me'?s\s+hand)[\s!1.]*$/si) { + $self->Perform($event, 'greetings'); + } elsif ($message =~ /^\s*(?:pokes|prods)\s+$me(?:[,\s]+too|\s+as\s+well)?[\s!1.]*$/si) { + $self->Perform($event, 'ow'); + } elsif ($message =~ /^\s*(?:stabs|slaps|kicks|kills|hits|punches)\s+$me[\s!1.]*$/si) { + $self->Perform($event, 'veryow'); + } elsif ($message =~ /^\s*lights\s+$me\s+on\s+fire[!1.\s]*$/si) { + $self->Perform($event, 'veryow'); + } elsif ($message =~ /^\s*(?:pats|strokes|pets)\s+$me(:?\s+affectionately|\s+lovingly)?[!1.\s]*$/si) { + $self->Perform($event, 'happy'); + } elsif ($message =~ /^\s*slaps\s+$me\s+(?:around\s+)?(?:a\s+(?:bit|lot|little|while)\s+)?with\s+a\s+(?:(?:big|fat|large|wet|and)[\s,]+)*trout[\s!1.]*$/si) { + $self->Perform($event, 'ow'); + } elsif ($message =~ /^\s*(?:hits|kicks|slaps|smacks)\s+$me[\s!1.]*$/si) { + $self->Perform($event, 'yousuck'); + } elsif ($message =~ /^\s*(?:glares|stares)\s+at\s+$me[\s!1.]*$/si) { + $self->Perform($event, 'yousuck'); + } elsif ($message =~ /^\s*(?:hugs|cuddles|snuggles(?:\s+up\s*to|\s+with)?|kisses|loves)\s+$me[\s!1.]*$/si) { + $self->Perform($event, 'vhappy'); + } elsif ($message =~ /^\s*(?:bites|spanks)\s+$me[\s.]*$/si) { + $self->Perform($event, 'kinky'); + } elsif ($message =~ /^\s*(?:tickles)\s+$me[\s.]*$/si) { + $self->Perform($event, 'tickle'); + } elsif ($message =~ /^\s*(?:gives|hands|passes|offers)\s+$me\s+(?:a\s+(?:bot\s*)?(?:snack|cookie)|a\s+present|cash|congratulations|applause|praise)[\s!1.]*$/si) { + $self->Perform($event, 'happy'); + } elsif ($message =~ /^\s*(?:gives|hands|passes|offers)\s+$me\s+(?:a\s+hot\s+date)[\s!1.]*$/si) { + $self->Perform($event, 'vhappy'); + } else { + return $self->SUPER::Felt(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Saw { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*r+h+e(e+)t+s?[!1.\s]*$/osi) { + if (($event->{'time'}-$self->{'lastrheet'}) > $self->{'rheetbuffer'}) { + $self->say($event, "rhe$1$1t!"); + $self->{'lastrheet'} = $event->{'time'}; + } + } elsif (($message =~ /^\s*(?:smiles)\s*[!1.\s]*$/si) and ($self->canAssumeThanks($event))) { + $self->Perform($event, 'happy'); + } else { + return $self->SUPER::Felt(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +# SpottedJoin - Called when someone joins a channel +sub SpottedJoin { + my $self = shift; + my ($event, $channel, $who) = @_; + return if grep lc($_) eq $channel, @{$self->{'autoGreetMute'}}; + my $user = $event->{'user'}; + if ($self->canGreet($event) and $self->{'autoGreetings'}->{$who}) { + $self->sayOrEmote($event, $self->Expand($event, $self->{'autoGreetings'}->{$who})); + $self->{'autoGreeted'}->{$user} = $event->{'time'}; + } + return 1; # don't block other modules... +} + +sub CTCPPing { + my $self = shift; + my ($event, $who, $what) = @_; + $self->ctcpReply($event, 'PING', $what); +} + +sub CTCPSource { + my $self = shift; + my ($event, $who, $what) = @_; + $self->ctcpReply($event, 'SOURCE', $self->{'source'}); +} + +sub GetNext { + my $self = shift; + my ($list) = @_; + $self->{"${list}Index"} = 0 if $self->{"${list}Index"} > $#{$self->{$list}}; + my $reply = $self->{$list}->[$self->{"${list}Index"}++]; + $self->saveConfig(); + return $reply; +} + +sub canGreet { + my $self = shift; + my ($event) = @_; + my $user = $event->{'user'}; + my $reply = 1; + if (defined($self->{'autoGreeted'}->{$user})) { + $reply = (($event->{'time'} - $self->{'autoGreeted'}->{$user}) > $self->{'autoGreetedBackoffTime'}); + delete($self->{'autoGreeted'}->{$user}); + } + return $reply; +} + +sub canAssumeThanks { + my $self = shift; + my ($event) = @_; + my $who = $event->{'user'}; + return ((defined($self->{'_lastSpoken'}->{$who})) and (($event->{'time'} - $self->{'_lastSpoken'}->{$who}) <= $self->{'assumeThanksTime'})); +} + +sub Perform { + my $self = shift; + my ($event, $list) = @_; + $self->sayOrEmote($event, $self->Expand($event, $self->GetNext($list))); +} + +# replaces '%' with the target nick (XXX cannot escape a "%"!!!) +sub Expand { + my $self = shift; + my ($event, $data) = @_; + $data =~ s/%/$event->{'from'}/gos; + return $data; +} + +sub PerformOnOther { + my $self = shift; + my ($event, $list, $other) = @_; + my $data; + my $me = quotemeta($event->{'nick'}); + if ($other =~ m/^$me$/si and + defined $self->{"${list}Protected"}->{''}) { + $data = $self->{"${list}Protected"}->{''}; + } elsif (defined $self->{"${list}Protected"}->{lc $other}) { + $data = $self->{"${list}Protected"}->{lc $other}; + } else { + $data = $self->GetNext($list); + } + if ($other eq 'me') { + $other = $event->{'from'}; + } + $data =~ s/%source/$event->{'from'}/gos; + $data =~ s/%target/$other/gos; + $self->sayOrEmote($event, $data); +} diff --git a/BotModules/HelloWorld.bm b/BotModules/HelloWorld.bm new file mode 100644 index 0000000..9c3297d --- /dev/null +++ b/BotModules/HelloWorld.bm @@ -0,0 +1,29 @@ +################################ +# Hello World Module # +################################ + +package BotModules::HelloWorld; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'This is the demo module that says Hello World.', + 'hi' => 'Requests that the bot emit a hello world string.', + }; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*hi\s*$/osi) { + $self->say($event, 'Hello World!'); + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + diff --git a/BotModules/Infobot.bm b/BotModules/Infobot.bm new file mode 100644 index 0000000..78394fd --- /dev/null +++ b/BotModules/Infobot.bm @@ -0,0 +1,790 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Infobot Module # +################################ +# some of these ideas are stolen from infobot, of course. +# see www.infobot.org + +package BotModules::Infobot; +use vars qw(@ISA); +@ISA = qw(BotModules); +use AnyDBM_File; +use Fcntl; +1; + +# XXX "mozbot is a bot" fails (gets handled as a Tell of "is a bot" :-/) +# XXX "who is foo" responds "I don't know what is foo" (should respond "I don't know _who_ is foo") + +# it seems tie() works on scope and not on reference counting, so as +# soon as the thing it is tying goes out of scope (even if the variable +# in question still has active references) it loses its magic. +our $factoids = {'is' => {}, 'are' => {}}; +tie(%{$factoids->{'is'}}, 'AnyDBM_File', 'factoids-is', O_RDWR|O_CREAT, 0666); +tie(%{$factoids->{'are'}}, 'AnyDBM_File', 'factoids-are', O_RDWR|O_CREAT, 0666); + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'Keeps track of factoids and returns them on request. '. + 'To set factoids, just tell me something in the form \'apple is a company\' or \'apples are fruit\'. '. + 'To find out about something, say \'apple?\' or \'what are apples\'. '. + 'To correct me, you can use any of: \'no, apple is a fruit\', \'apple =~ s/company/fruit/\', or \'apple is also a fruit\'. '. + 'To make me forget a factoid, \'forget apple\'. '. + 'You can use \'|\' to separate several alternative answers.', + 'who' => 'If a definition contains $who, then it will be replaced by the name of the person who asked the question.', + 'reply' => 'If a definition starts with then when responding the initial prefix will be skipped. '. + 'e.g., \'apples are mm, apples\' will mean that \'what are apples\' will get the response \'mm, apples\'.', + 'action' => 'If a definition starts with then when responding the definition will be used as an action. '. + 'e.g., \'apples are eats one\' will mean that \'what are apples\' will get the response \'* bot eats one\'.', + 'alias' => 'If a definition starts with then it will be treated as a symlink to whatever follows. '. + 'e.g., \'crab apples are apples\' and \'apples are fruit\' will mean that \'what are crab apples\' will get the response \'apples are fruit\'.', + 'status' => 'Reports on how many factoids are in the database.', + 'tell' => 'Make me tell someone something. e.g., \'tell pikachu what apples are\' or \'tell fred about me\'.', + 'literal' => 'To find out exactly what is stored for an entry apples, you would say to me: literal apples', + 'remember' => 'If you are having trouble making me remember something (for example \'well, foo is bar\' '. + 'getting treated as \'foo\' is \'bar\'), then you can prefix your statement with \'remember:\' '. + '(following the \'no,\' if you are changing an entry). For example, \'remember: well, foo is bar\'. '. + 'Note that \'well, foo?\' is treated as \'what is foo\' not is \'what is well, foo\', so this is not always useful.', + 'no' => 'To correct an entry, prefix your statement with \'no,\'. '. + 'For example, \'no, I am good\' to correct your entry from \'is bad\' to \'is good\'. :-)', + }; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['autoLearn', 1, 1, ['*']], # in the auto* variables, '*' means 'all channels' + ['autoHelp', 1, 1, []], + ['autoEdit', 1, 1, []], + ['neverLearn', 1, 1, []], # the never* variables override the auto* variables + ['neverHelp', 1, 1, []], + ['neverEdit', 1, 1, []], + ['eagerToHelp', 1, 1, 1], # whether to even need the "?" on questions + ['autoIgnore', 1, 1, []], # list of nicks for which to always turn off auto* + ['teachers', 1, 1, []], # list of users who may teach, leave blank to allow anyone to teach + ['factoidPositions', 0, 0, {'is' => {}, 'are' => {}}], + ['friendBots', 1, 1, []], + ['prefixes', 1, 1, ['', 'I have heard that ', '', 'Maybe ', 'I seem to recall that ', '', 'iirc, ', '', + 'Was it not... er, someone, who said: ', '', 'Well, ', 'um... ', 'Oh, I know this one! ', + '', 'everyone knows that! ', '', 'hmm... I think ', 'well, duh. ']], + ['researchNotes', 0, 0, {}], + ['pruneDelay', 1, 1, 120], # how frequently to look through the research notes and remove expired items + ['queryTimeToLive', 1, 1, 600], # queries can be remembered up to ten minutes by default + ['dunnoTimeToLive', 1, 1, 604800], # DUNNO queries can be remembered up to a week by default + ['noIdeaDelay', 1, 1, 2], # how long to wait before admitting lack of knowledge + ['questions', 0, 0, 0], # how many questions there have been since the last load + ['edits', 0, 0, 0], # how many edits (learning, editing, forgetting) there have been since the last load + ['interbots', 0, 0, 0], # how many times we have spoken with other bots + ['maxInChannel', 1, 1, 200], # beyond this answers are /msged + ); +} + +# Schedule - called when bot connects to a server, to install any schedulers +# use $self->schedule($event, $delay, $times, $data) +# where $times is 1 for a single event, -1 for recurring events, +# and a positive number for an event that occurs that many times. +sub Schedule { + my $self = shift; + my ($event) = @_; + $self->schedule($event, \$self->{'pruneDelay'}, -1, 'pruneInfobot'); + $self->SUPER::Schedule($event); +} + +sub Unload { + # just to make sure... + untie(%{$factoids->{'is'}}); + untie(%{$factoids->{'are'}}); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*status[?\s]*$/osi) { + my $sum = $self->countFactoids(); + my $questions = $self->{'questions'} == 1 ? "$self->{'questions'} question" : "$self->{'questions'} questions"; + my $edits = $self->{'edits'} == 1 ? "$self->{'edits'} edit" : "$self->{'edits'} edits"; + my $interbots = $self->{'interbots'} == 1 ? "$self->{'interbots'} time" : "$self->{'interbots'} times"; + my $friends = @{$self->{'friendBots'}} == 1 ? (scalar(@{$self->{'friendBots'}}).' bot friend') : (scalar(@{$self->{'friendBots'}}).' bot friends'); + $self->targettedSay($event, "I have $sum factoids in my database and $friends to help me answer questions. ". + "Since the last reload, I've been asked $questions, performed $edits, and spoken with other bots $interbots.", 1); + } elsif ($event->{'channel'} eq '' and $message =~ /^:INFOBOT:DUNNO <(\S+)> (.*)$/) { + $self->ReceivedDunno($event, $1, $2) unless $event->{'from'} eq $event->{'nick'}; + } elsif ($event->{'channel'} eq '' and $message =~ /^:INFOBOT:QUERY <(\S+)> (.*)$/) { + $self->ReceivedQuery($event, $2, $1) unless $event->{'from'} eq $event->{'nick'}; + } elsif ($event->{'channel'} eq '' and $message =~ /^:INFOBOT:REPLY <(\S+)> (.+?) =(is|are)?=> (.*)$/) { + $self->ReceivedReply($event, $3, $2, $1, $4) unless $event->{'from'} eq $event->{'nick'}; + } elsif ($message =~ /^\s*literal\s+(.+?)\s*$/) { + $self->Literal($event, $1); + } elsif ($event->{level} < 10) { + # make this module a very low priority + return 10; + } elsif (not $self->DoFactoidCheck($event, $message, 1)) { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Baffled { + my $self = shift; + my ($event, $message) = @_; + return 10 unless $event->{level} >= 10; # make this module a very low priority + if (not $self->DoFactoidCheck($event, $message, 2)) { + return $self->SUPER::Heard(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Heard { + my $self = shift; + my ($event, $message) = @_; + return 10 unless $event->{level} >= 10; # make this module a very low priority + if (not $self->DoFactoidCheck($event, $message, 0)) { + return $self->SUPER::Heard(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub DoFactoidCheck { + my $self = shift; + my ($event, $message, $direct) = @_; + # $direct is one of: 0 = heard, 1 = told, 2 = baffled + + my $shortMessage; + if ($message =~ /^\s* (?:\w+[:.!\s]+\s+)? + (?:(?:well|and|or|yes|[uh]+m*|o+[oh]*[k]+(?:a+y+)?|still|well|so|a+h+|o+h+)[:,.!?\s]+|)* + (?:(?:geez?|boy|du+des?|golly|gosh|wow|whee|wo+ho+)[:,.!\s]+|)* + (?:(?:heya?|hello|hi)(?:\s+there)?(?:\s+peoples?|\s+kids?|\s+folks?)[:,!.?\s]+)* + (?:(?:geez?|boy|du+des?|golly|gosh|wow|whee|wo+ho+)[:,.!\s]+|)* + (?:tell\s+me[,\s]+)? + (?:(?:(?:stupid\s+)?q(?:uestion)?|basically)[:,.!\s]+)* + (?:tell\s+me[,\s]+)? + (?:(?:does\s+)?(?:any|ne)\s*(?:1|one|body)\s+know[,\s]+|)? + (.*) + \s*$/osix) { + $shortMessage = $1; + } + $self->debug("message: '$message'"); + $self->debug("shortMessage: '$shortMessage'"); + + if ($message =~ /^\s*tell\s+(\S+)\s+about\s+me(?:[,\s]+please)?[\s!?.]*$/osi) { + $self->GiveFactoid($event, + undef, # database + $event->{'from'}, # what + $direct, + $1); # who + } elsif ($message =~ /^\s*tell\s+(\S+)\s+about\s+(.+?)(?:[,\s]+please)?[\s!?.]*$/osi) { + $self->GiveFactoid($event, + undef, # database + $2, # what + $direct, + $1); # who + } elsif ($message =~ /^\s*tell\s+(\S+)\s+(?:what|who|where)\s+(?:am\s+I|I\s+am)(?:[,\s]+please)?[\s!?.]*$/osi) { + $self->GiveFactoid($event, + 'is', # database + $event->{'from'}, # what + $direct, + $1); # who + } elsif ($message =~ /^\s*tell\s+(\S+)\s+(?:what|who|where)\s+(is|are)\s+(.+?)(?:[,\s]+please)?[\s!?.]*$/osi) { + $self->GiveFactoid($event, + lc($2), # database + $3, # what + $direct, + $1); # who + } elsif ($message =~ /^\s*tell\s+(\S+)\s+(?:what|who|where)\s+(.+?)\s+(is|are)(?:[,\s]+please)?[\s!?.]*$/osi) { + $self->GiveFactoid($event, + lc($3), # database + $2, # what + $direct, + $1); # who + } elsif ($message =~ /^\s*(.+?)\s*=~\s*s?\/(.+?)\/(.*?)\/(i)?(g)?(i)?\s*$/osi) { + $self->EditFactoid($event, + $1, # subject + $2, # first part to remove + $3, # second part to remove + defined($5), # global? + defined($4) || defined($6), # case insensitive? + $direct); + } elsif ($message =~ /^\s*forget\s+(?:about\s+)?me\s*$/osi) { + $self->ForgetFactoid($event, $event->{'from'}, $direct); + } elsif ($message =~ /^\s*forget\s+(?:about\s+)?(.+?)\s*$/osi) { + $self->ForgetFactoid($event, $1, $direct); + } elsif ($shortMessage =~ /^(?:what|where|who) + (?:\s+the\s+hell|\s+on\s+earth|\s+the\s+fuck)? + \s+ (is|are) \s+ (.+?) [?!\s]* $/osix) { + $self->GiveFactoid($event, + lc($1), # is/are (optional) + $2, # subject + $direct); + } elsif ($shortMessage =~ /^(?:(?:where|how) + (?:\s+the\s+hell|\s+on\s+earth|\s+the\s+fuck)? + \s+ can \s+ (?:i|one|s?he|we) \s+ (?:find|learn|read) + (?:\s+about)? + | how\s+about + | what\'?s) + \s+ (.+?) [?!\s]* $/osix) { + $self->GiveFactoid($event, + undef, # is/are (optional) + $1, # subject + $direct); + } elsif ($shortMessage =~ /^(.+?) \s+ (is|are) \s+ (?:what|where|who) [?!\s]* $/osix) { + $self->GiveFactoid($event, + lc($2), # is/are (optional) + $1, # subject + $direct); + } elsif ($shortMessage =~ /^(?:what|where|who) + (?:\s+the\s+hell|\s+on\s+earth|\s+the\s+fuck)? \s+ + (?:am\s+I|I\s+am) [?\s]* $/osix) { + $self->GiveFactoid($event, + 'is', # am => is + $event->{'from'}, # subject + $direct); + } elsif ($shortMessage =~ /^(no\s*, (\s*\Q$event->{'nick'}\E\s*,)? \s+)? (?:remember\s*:\s+)? (.+?) \s+ (is|are) \s+ (also\s+)? (.*?[^?\s]) \s* $/six) { + # the "remember:" prefix can be used to delimit the start of the actual content, if necessary. + $self->SetFactoid($event, + defined($1) && + ($direct || defined($2)), + # replace existing answer? + $3, # subject + lc($4), # is/are + defined($5), # add to existing answer? + $6, # object + $direct || defined($2)); + } elsif ($shortMessage =~ /^(no\s*, (?:\s*\Q$event->{'nick'}\E\s*,)? \s+)? (?:remember\s*:\s+)? I \s+ am \s+ (also\s+)? (.+?) $/osix) { + # the "remember:" prefix can be used to delimit the start of the actual content, if necessary. + $self->SetFactoid($event, + defined($1), # replace existing answer? + $event->{'from'}, # subject + 'is', # I am = Foo is + defined($2), # add to existing answer? + $3, # object + $direct); + } elsif ((not $direct or $direct == 2) and $shortMessage =~ /^(.+?)\s+(is|are)[?\s]*(\?)?[?\s]*$/osi) { + $self->GiveFactoid($event, + lc($2), # is/are (optional) + $1, # subject + $direct) + if ($3 or ($direct == 2 and $self->{'eagerToHelp'})); + } elsif ((not $direct or $direct == 2) and $shortMessage =~ /^(.+?)[?!.\s]*(\?)?[?!.\s]*$/osi) { + $self->GiveFactoid($event, + undef, # is/are (optional) + $1, # subject + $direct) + if ($2 or ($direct == 2 and $self->{'eagerToHelp'})); + } else { + return 0; + } + return 1; +} + +sub SetFactoid { + my $self = shift; + my($event, $replace, $subject, $database, $add, $object, $direct, $fromBot) = @_; + if ($direct or $self->allowed($event, 'Learn')) { + + teacher: { + if (@{$self->{'teachers'}}) { + foreach my $user (@{$self->{'teachers'}}) { + if ($user eq $event->{'userName'}) { + last teacher; + } + } + return 0; + } + } + + # update the database + if (not $replace) { + $subject = $self->CanonicalizeFactoid($database, $subject); + } else { + my $oldSubject = $self->CanonicalizeFactoid($database, $subject); + if (defined($factoids->{$database}->{$oldSubject})) { + delete($factoids->{$database}->{$oldSubject}); + } + } + if ($replace or not defined($factoids->{$database}->{$subject})) { + $self->debug("Learning that $subject $database '$object'."); + $factoids->{$database}->{$subject} = $object; + } elsif (not $add) { + my @what = split(/\|/o, $factoids->{$database}->{$subject}); + local $" = '\' or \''; + if (not defined($fromBot)) { + if (@what == 1 and $what[0] eq $object) { + $self->targettedSay($event, 'Yep, that\'s what I thought. Thanks for confirming it.', $direct); + } else { + # XXX "that's one of the alternatives, sure..." + $self->targettedSay($event, "But $subject $database '@what'...", $direct); + } + } + return 0; # failed to update database + } else { + $self->debug("Learning that $subject $database also '$object'."); + $factoids->{$database}->{$subject} .= "|$object"; + } + if (not defined($fromBot)) { + $self->targettedSay($event, 'ok', $direct); + } + if (defined($self->{'researchNotes'}->{lc($subject)})) { + my @queue = @{$self->{'researchNotes'}->{lc($subject)}}; + foreach my $entry (@queue) { + my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry; + if ($typeE eq 'QUERY') { + if ((defined($targetE) and $event->{'from'} ne $targetE) or + ($event->{'from'} ne $eventE->{'from'} and + ($event->{'channel'} eq '' or $event->{'channel'} ne $eventE->{'channel'}))) { + my($how, $what, $propagated) = $self->GetFactoid($eventE, $databaseE, $subjectE, + $targetE, $directE, $visitedAliasesE, $event->{'from'}); + if (defined($how)) { + if (defined($targetE)) { + $self->debug("I now know what '$subject' $database, so telling $targetE, since $eventE->{'from'} told me to."); + } else { + $self->debug("I now know what '$subject' $database, so telling $eventE->{'from'} who wanted to know."); + } + $self->factoidSay($eventE, $how, $what, $directE, $targetE); + $entry->[1] = 'OLD'; + } else { + # either $propagated, or database doesn't match requested database, or internal error + $self->debug("I now know what '$subject' $database, but for some reason that ". + "didn't help me help $eventE->{'from'} who needed to know what '$subjectE' $databaseE."); + } + } + } elsif ($typeE eq 'DUNNO') { + my $who = defined($targetE) ? $targetE : $eventE->{'from'}; + $self->directSay($eventE, ":INFOBOT:REPLY <$who> $subject =$database=> $factoids->{$database}->{$subject}"); + $entry->[1] = 'OLD'; + } + } + } + $self->{'edits'}++; + return 1; + } else { + return 0; + } +} + +sub GiveFactoid { + my $self = shift; + my($event, $database, $subject, $direct, $target) = @_; + if ($direct or $self->allowed($event, 'Help')) { + if ($target =~ m/^$event->{'nick'}$/i) { + $self->targettedSay($event, 'Oh, yeah, great idea, get me to talk to myself.', $direct); + } else { + if (lc($subject) eq 'you') { + # first, skip some words that are handled by other commonly-used modules + # in particular, 'who are you' is handled by Greeting.bm + return; + } + $self->{'questions'}++; + my($how, $what, $propagated) = $self->GetFactoid($event, $database, $subject, $target, $direct); + if (not defined($how)) { + $self->scheduleNoIdea($event, $database, $subject, $direct, $propagated); + } else { + $self->debug("Telling $event->{'from'} about $subject."); + $self->factoidSay($event, $how, $what, $direct, $target); + } + } + } +} + +sub Literal { + my $self = shift; + my($event, $subject) = @_; + my $is = $self->CanonicalizeFactoid('is', $subject); + my $are = $self->CanonicalizeFactoid('are', $subject); + if (defined($is) or defined($are)) { + local $" = '\' or \''; + if (defined($factoids->{'is'}->{$is})) { + my @what = split(/\|/o, $factoids->{'is'}->{$is}); + $self->targettedSay($event, "$is is '@what'.", 1); + } + if (defined($factoids->{'are'}->{$are})) { + my @what = split(/\|/o, $factoids->{'are'}->{$is}); + $self->targettedSay($event, "$are are '@what'.", 1); + } + } else { + $self->targettedSay($event, "I have no record of anything called '$subject'.", 1); + } +} + +sub scheduleNoIdea { + my $self = shift; + my($event, $database, $subject, $direct, $propagated) = @_; + if (ref($propagated)) { + $self->schedule($event, \$self->{'noIdeaDelay'}, 1, 'noIdea', $database, $subject, $direct, $propagated); + } else { + $self->noIdea($event, $database, $subject, $direct); + } +} + +sub GetFactoid { + my $self = shift; + my($event, $originalDatabase, $subject, $target, $direct, $visitedAliases, $friend) = @_; + if (not defined($visitedAliases)) { + $visitedAliases = {}; + } + my $database; + ($database, $subject) = $self->FindFactoid($originalDatabase, $subject); + if (defined($factoids->{$database}->{$subject})) { + my @alternatives = split(/\|/o, $factoids->{$database}->{$subject}); + my $answer; + if (@alternatives) { + if (not defined($self->{'factoidPositions'}->{$database}->{$subject}) + or $self->{'factoidPositions'}->{$database}->{$subject} >= scalar(@alternatives)) { + $self->{'factoidPositions'}->{$database}->{$subject} = 0; + } + $answer = @alternatives[$self->{'factoidPositions'}->{$database}->{$subject}]; + $self->{'factoidPositions'}->{$database}->{$subject}++; + } else { + $answer = @alternatives[0]; + } + my $who = defined($target) ? $target : $event->{'from'}; + $answer =~ s/\$who/$who/go; + if ($answer =~ /^(.*)$/o) { + if ($visitedAliases->{$1}) { + return ('msg', "see $subject", 0); + } else { + $visitedAliases->{$subject}++; + my($how, $what, $propagated) = $self->GetFactoid($event, undef, $1, $target, $direct, $visitedAliases); + if (not defined($how)) { + return ('msg', "see $1", $propagated); + } else { + return ($how, $what, $propagated); + } + } + } elsif ($answer =~ /^/o) { + $answer =~ s/^\s*//o; + return ('me', $answer, 0); + } else { + if ($answer =~ /^/o) { + $answer =~ s/^\s*//o; + } else { + # pick a 'random' prefix + my $prefix = $self->{'prefixes'}->[$event->{'time'} % @{$self->{'prefixes'}}]; + if (lc($who) eq lc($subject)) { + $answer = "${prefix}you are $answer"; + } else { + $answer = "$prefix$subject $database $answer"; + } + if (defined($friend)) { + $answer = "$friend knew: $answer"; + } + } + return ('msg', $answer, 0); + } + } else { + # we have no idea what this is + return (undef, undef, $self->Research($event, $originalDatabase, $subject, $target, $direct, $visitedAliases)); + } +} + +sub CanonicalizeFactoid { + my $self = shift; + my($database, $subject) = @_; + if (not defined($factoids->{$database}->{$subject})) { + while (my $key = each %{$factoids->{$database}}) { + if (lc($key) eq lc($subject)) { + $subject = $key; + # can't return or 'each' iterator won't be reset XXX + } + } + } + return $subject; +} + +sub FindFactoid { + my $self = shift; + my($database, $subject) = @_; + if (not defined($database)) { + $database = 'is'; + $subject = $self->CanonicalizeFactoid('is', $subject); + if (not defined($factoids->{'is'}->{$subject})) { + $subject = $self->CanonicalizeFactoid('are', $subject); + if (defined($factoids->{'are'}->{$subject})) { + $database = 'are'; + } + } + } else { + $subject = $self->CanonicalizeFactoid($database, $subject); + } + return ($database, $subject); +} + +sub EditFactoid { + my $self = shift; + my($event, $subject, $search, $replace, $global, $caseInsensitive, $direct) = @_; + if ($direct or $self->allowed($event, 'Edit')) { + my $database; + ($database, $subject) = $self->FindFactoid($database, $subject); + if (not defined($factoids->{$database}->{$subject})) { + $self->targettedSay($event, "Er, I don't know about this $subject thingy...", $direct); + return; + } + $self->debug("Editing the $subject entry."); + my @output; + foreach my $factoid (split(/\|/o, $factoids->{$database}->{$subject})) { + $search = $self->sanitizeRegexp($search); + if ($global and $caseInsensitive) { + $factoid =~ s/$search/$replace/gi; + } elsif ($global) { + $factoid =~ s/$search/$replace/g; + } elsif ($caseInsensitive) { + $factoid =~ s/$search/$replace/i; + } else { + $factoid =~ s/$search/$replace/; + } + push(@output, $factoid); + } + $factoids->{$database}->{$subject} = join('|', @output); + $self->targettedSay($event, 'ok', $direct); + $self->{'edits'}++; + } +} + +sub ForgetFactoid { + my $self = shift; + my($event, $subject, $direct) = @_; + if ($direct or $self->allowed($event, 'Edit')) { + my $count = 0; + my $database; + foreach my $db ('is', 'are') { + ($database, $subject) = $self->FindFactoid($db, $subject); + if (defined($factoids->{$database}->{$subject})) { + delete($factoids->{$database}->{$subject}); + $count++; + } + } + if ($count) { + $self->targettedSay($event, "I've forgotten what I knew about '$subject'.", $direct); + $self->{'edits'}++; + } else { + $self->targettedSay($event, "I never knew anything about '$subject' in the first place!", $direct); + } + } +} + +# interbot communications +sub Research { + my $self = shift; + my($event, $database, $subject, $target, $direct, $visitedAliases) = @_; + if (not @{$self->{'friendBots'}}) { + # no bots to ask, bail out + return 0; + } + # now check that we need to ask the bots about it: + my $asked = 0; + if (not defined($self->{'researchNotes'}->{$subject})) { + $self->{'researchNotes'}->{$subject} = []; + } else { + entry: foreach my $entry (@{$self->{'researchNotes'}->{lc($subject)}}) { + my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry; + if ($typeE eq 'QUERY') { + $asked++; # at least one bot was already asked quite recently + if ((defined($targetE) and lc($targetE) eq lc($targetE)) or + (not defined($targetE) and lc($event->{'from'}) eq lc($eventE->{'from'}))) { + # already queued + return 1; + } + } + } + } + # remember to tell these people about $subject if we ever find out about it: + my $entry = [$event, 'QUERY', $database, $subject, $target, $direct, $visitedAliases, $event->{'time'}]; + push(@{$self->{'researchNotes'}->{lc($subject)}}, $entry); + my $who = defined($target) ? $target : $event->{'from'}; + if (not $asked) { + # not yet asked, so ask each bot about $subject + foreach my $bot (@{$self->{'friendBots'}}) { + next if $bot eq $event->{'nick'}; + local $event->{'from'} = $bot; + $self->directSay($event, ":INFOBOT:QUERY <$who> $subject"); + } + $self->{'interbots'}++; + return $entry; # return reference to entry so that we can check if it has been replied or not + } else { + return $asked; + } +} + +sub ReceivedReply { + my $self = shift; + my($event, $database, $subject, $target, $object) = @_; + $self->{'interbots'}++; + if (not $self->SetFactoid($event, 0, $subject, $database, 0, $object, 1, 1) and + defined($self->{'researchNotes'}->{lc($subject)})) { + # we didn't believe $event->{'from'}, but we might as well + # tell any users that were wondering. + foreach my $entry (@{$self->{'researchNotes'}->{lc($subject)}}) { + my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry; + if ($typeE eq 'QUERY') { + $self->factoidSay($eventE, 'msg', "According to $event->{'from'}, $subject $database '$object'.", $directE, $targetE); + } elsif ($typeE eq 'DUNNO') { + my $who = defined($targetE) ? $targetE : $eventE->{'from'}; + $self->directSay($eventE, ":INFOBOT:REPLY <$who> $subject =$database=> $object"); + } + $entry->[1] = 'OLD'; + } + } +} + +sub ReceivedQuery { + my $self = shift; + my($event, $subject, $target) = @_; + $self->{'interbots'}++; + if (not $self->tellBot($event, $subject, $target)) { + # in the spirit of embrace-and-extend, we're going to say that + # :INFOBOT:DUNNO means "I don't know, but if you ever find + # out, please tell me". + $self->directSay($event, ":INFOBOT:DUNNO <$event->{'nick'}> $subject"); + } +} + +sub ReceivedDunno { + my $self = shift; + my($event, $target, $subject) = @_; + $self->{'interbots'}++; + if (not $self->tellBot($event, $subject, $target)) { + # store the request + push(@{$self->{'researchNotes'}->{lc($subject)}}, [$event, 'DUNNO', undef, $1, $target, 0, {}, $event->{'time'}]); + } +} + +sub tellBot { + my $self = shift; + my($event, $subject, $target) = @_; + my $count = 0; + my $database; + foreach my $db ('is', 'are') { + ($database, $subject) = $self->FindFactoid($db, $subject); + if (defined($factoids->{$database}->{$subject})) { + $self->directSay($event, ":INFOBOT:REPLY <$target> $subject =$database=> $factoids->{$database}->{$subject}"); + $count++; + } + } + return $count; +} + +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + if ($data[0] eq 'pruneInfobot') { + my $now = $event->{'time'}; + foreach my $key (keys %{$self->{'researchNotes'}}) { + my @new; + foreach my $entry (@{$self->{'researchNotes'}->{$key}}) { + my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry; + if (($typeE eq 'QUERY' and ($now - $timeE) < $self->{'queryTimeToLive'}) or + ($typeE eq 'DUNNO' and ($now - $timeE) < $self->{'dunnoTimeToLive'})) { + push(@new, $entry); + } + } + if (@new) { + $self->{'researchNotes'}->{$key} = \@new; + } else { + delete($self->{'researchNotes'}->{$key}); + } + } + } elsif ($data[0] eq 'noIdea') { + my(undef, $database, $subject, $direct, $propagated) = @data; + my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$propagated; + # in theory, $eventE = $event, $databaseE = $database, + # $subjectE = $subject, $targetE depends on if this was + # triggered by a tell, $directE = $direct, $visitedAliasesE is + # opaque, and $timeE is opaque. + if ($typeE ne 'OLD') { + $self->noIdea($event, $database, $subject, $direct); + } + } else { + $self->SUPER::Scheduled($event, @data); + } +} + + +# internal helper routines + +sub factoidSay { + my $self = shift; + my($event, $how, $what, $direct, $target) = @_; + if (defined($target)) { + $self->targettedSay($event, "told $target", 1); + my $helper = $event->{'from'}; + local $event->{'from'} = $target; + if ($how eq 'me') { + $self->directEmote($event, $what); + } else { + if (length($what)) { + $self->directSay($event, "$helper wanted you to know: $what"); + } + } + } elsif ($how eq 'me') { + $self->emote($event, $what); + } else { + if ($event->{'channel'} eq '' or length($what) < $self->{'maxInChannel'}) { + $self->targettedSay($event, $what, 1); + } else { + if ($direct) { + $self->targettedSay($event, substr($what, 0, $self->{'maxInChannel'}) . '... (rest /msged)' , 1); + $self->directSay($event, $what); + } else { + $self->targettedSay($event, substr($what, 0, $self->{'maxInChannel'}) . '... (there is more; ask me in a /msg)' , 1); + } + } + } +} + +sub targettedSay { + my $self = shift; + my($event, $message, $direct) = @_; + if ($direct and length($message)) { + $self->say($event, "$event->{from}: $message"); + } +} + +sub countFactoids { + my $self = shift; + # don't want to use keys() as that would load the whole database index into memory. + my $sum = 0; + while (my $factoid = each %{$factoids->{'is'}}) { $sum++; } + while (my $factoid = each %{$factoids->{'are'}}) { $sum++; } + return $sum; +} + +sub allowed { + my $self = shift; + my($event, $type) = @_; + if ($event->{'channel'} ne '') { + foreach my $user (@{$self->{'autoIgnore'}}) { + if ($user eq $event->{'from'}) { + return 0; + } + } + foreach my $channel (@{$self->{"never$type"}}) { + if ($channel eq $event->{'channel'} or + $channel eq '*') { + return 0; + } + } + foreach my $channel (@{$self->{"auto$type"}}) { + if ($channel eq $event->{'channel'} or + $channel eq '*') { + return 1; + } + } + } + return 0; +} + +sub noIdea { + my $self = shift; + my($event, $database, $subject, $direct) = @_; + if (lc($subject) eq lc($event->{'from'})) { + $self->targettedSay($event, "Sorry, I've no idea who you are.", $direct); + } else { + if (not defined($database)) { + $database = 'might be'; + } + $self->targettedSay($event, "Sorry, I've no idea what '$subject' $database.", $direct); + } +} diff --git a/BotModules/Infobot.pl b/BotModules/Infobot.pl new file mode 100644 index 0000000..f70011b --- /dev/null +++ b/BotModules/Infobot.pl @@ -0,0 +1,69 @@ +#!/usr/bin/perl -w +###################################### +# Infobot Factoid Import/Export Tool # +###################################### + +use strict; +use AnyDBM_File; +use Fcntl; + +if (not @ARGV == 2) { + &use(); +} else { + my $command = shift @ARGV; + my $filename = shift @ARGV; + if ($command eq '-d') { + &dump($filename); + } elsif ($command eq '-i') { + &import($filename); + } else { + &use(); + } +} + +sub use { + print "\n"; + print " usage: $0 -d dbname\n"; + print " prints out an ascii flat file of the database listed.\n"; + print " dbname should be the basename of the db, e.g.\n"; + print " $0 -d ../factoids-is > is.fact\n"; + print " $0 -d ../factoids-are > are.fact\n"; + print "\n"; + print " $0 -i dbname\n"; + print " imports an ascii flat file into the database listed.\n"; + print " dbname should be the basename of the db, e.g.\n"; + print " $0 -i ../factoids-is < chemicals.fact\n"; + print " $0 -i ../factoids-is < is.fact\n"; + print " $0 -i ../factoids-are < are.fact\n"; + print "\n"; + exit(1); +} + +sub dump { + my %db; + tie(%db, 'AnyDBM_File', shift, O_RDONLY, 0666); + while (my ($key, $val) = each %db) { + chomp $val; + print "$key => $val\n"; + } +} + +sub import { + my %db; + tie(%db, 'AnyDBM_File', shift, O_WRONLY|O_CREAT, 0666); + while () { + chomp; + unless (m/\s*(.+?)\s+=(?:is=|are=)?>\s+(.+?)\s*$/o) { + m/\s*(.+?)\s+(?:is|are)?\s+(.+?)\s*$/o; + } + if (length($1) and length($2)) { + if (defined($db{$1})) { + if (not $db{$1} =~ m/^(|.*\|)\Q$2\E(|.*\|)$/s) { + $db{$1} .= "|$2"; + } + } else { + $db{$1} = $2; + } + } + } +} diff --git a/BotModules/Infobot.txt b/BotModules/Infobot.txt new file mode 100644 index 0000000..bd7ce99 --- /dev/null +++ b/BotModules/Infobot.txt @@ -0,0 +1,195 @@ +The Infobot Protocol +==================== + +Reverse engineered from infobot 0.45.3 by Ian Hickson. + + +QUERY +----- + +If a bot is asked something by a user and does not know the answer, it +may send queries to all the bots it knows. Queries must be in private +messages and should have the following form: + + :INFOBOT:QUERY subject + +...where "target" is the name of the user who sent the query in the +first place, and "subject" is the question that was asked. + +In reality, "target" may be any string of non-whitespace character, so +it could be used as an internal ID. + +A bot receiving a QUERY message must not try to contact the user given +by "target" (that string should be treated as opaque) and must not +make any assumptions about the "subject" string (it could contain +*anything*, including high bit characters and the works). + +It is an error for the "subject" string to contain either "=is=>" or +"=are=>". Receiving bots may ignore this error, however. + +Bot authors should carefully consider the potential for cascades +before writing bots that chain QUERY messages. (As in, send out QUERY +messages if they are unable to respond to a QUERY message themselves). +In general, this is not a recommended behaviour. + +Bot authors are urged to write protection into their bots to avoid +being affected by poorly written bots that cause cascades. + + +REPLY +----- + +Upon receiving a QUERY message, a bot may, if it has information on +"subject", opt to send a private message back to the originating bot +in the form of a REPLY message. Bots must not send unsolicited REPLY +messages. The form of the REPLY message is: + + :INFOBOT:REPLY subject =database=> object + +...where "target" is the string of the same name from the original +QUERY message, "subject" is the second string from the original QUERY +message, "database" is one of "is" or "are" depending on the whether +"subject" is determined to be singular or plural respectively, and +"object" is the string that should be assumed to be the answer to +"subject". The string may contain special formatting codes, these are +described below. + +Upon receiving a REPLY message, bots should first check that they are +expecting one. If they are, the user identified by the "target" string +should be contacted and given the information represented by the +"object" string. (Remember that the "target" string need not actually +be the nick of the original user; it could be an internal key that +indirectly identifies a user.) + +Bots should carefully check the integrity and authenticity of the +"target" string, and must check that "database" is one of "is" or +"are". The "subject" string ends at the first occurance of either +"=is=>" or "=are=>". It is *not* an error for the "object" string to +contain either of those substrings. + +Bots may opt to store the information given by a REPLY request so that +future questions may be answered without depending on other bots. + +It is suggested that bots credit which bot actually knew the +information when reporting back to the user. + + +DUNNO +----- + +(This is not part of the original infobot protocol. And is, as of +2002-02-05, only supported by the mozbot2 Infobot module.) + +Upon receiving a QUERY message, a bot may, if it has no information on +the "subject" in question, reply with a DUNNO message. This message +has basically the same form as the QUERY message: + + :INFOBOT:DUNNO subject + +The DUNNO message indicates that the bot is not aware of the answer to +the question, but would like to be informed of the answer, should the +first bot ever find out about it. The "target" string should, as with +the QUERY string, be considered opaque. + +Upon receiving a DUNNO message, there are several possible responses. +If the bot is aware of the answer to "subject", then it should treat +the DUNNO message as if it was a QUERY message (typically resulting in +a REPLY message). This can occur if, for example, another bot has sent +a REPLY to the original QUERY before this bot has had the chance to +send the DUNNO message. + +If the first bot still doesn't know the answer, however, it may store +the DUNNO request internally. If, at a future time, the bot is +informed (either directly by a user or through a REPLY message) about +the answer to "subject", then it may send a REPLY message to the bot +that sent the DUNNO request, informing the bot of the value it learnt. + + +SPECIAL STRINGS +--------------- + +The "object" string in the REPLY message may contain several special +flags. + + $who + If the string contains the string "$who" then, when the string is + given to the user, it should be replaced by the name of the user. + + | + Multiple alternative replies may be encoded in one reply, those + should be separated by a vertical bar. + + + If the string is prefixed by "" then the string should not + be prefixed by "subject is" or "subject are" as usual. + + + The string should be returned via a CTCP ACTION. + + + The string should be taken as the name of another entry to look up. + + +EXAMPLES +-------- + +In these examples, A, B and C are bots, and x, y and z are people. + +The first example shows a simple case of one bots asking two other +bots for help, one of which gives a reply and the other of which says +it has no idea. + + +-------- originator of private message + | + | +--- target of private message + | | + V V + z -> A: what is foo? + A -> z: I have no idea. + A -> B: :INFOBOT:QUERY foo + A -> C: :INFOBOT:QUERY foo + B -> A: :INFOBOT:REPLY foo =is=> bar + C -> A: :INFOBOT:DUNNO foo + A -> x: B knew: foo is bar + A -> C: :INFOBOT:REPLY foo =is=> bar + +Note how the DUNNO in this case comes after the REPLY and thus is +immediately answered. + +The next example uses . One bot knows the answer to the +question as an alias to another word, but when the original bot asks +about _that_ word, it is the second bot that can help. + + z -> A: what is foo? + A -> z: I have no idea. + A -> B: :INFOBOT:QUERY foo + A -> C: :INFOBOT:QUERY foo + B -> A: :INFOBOT:REPLY foo =is=> bar + C -> A: :INFOBOT:DUNNO foo + A -> B: :INFOBOT:QUERY bar + A -> C: :INFOBOT:QUERY bar + A -> C: :INFOBOT:REPLY foo =is=> bar + B -> A: :INFOBOT:DUNNO bar + C -> A: :INFOBOT:REPLY bar =is=> baz + A -> z: C knew: bar is baz + A -> B: :INFOBOT:REPLY bar =is=> baz + +Note how the credit actually goes to the second bot. A better bot +might remember all the bots involved and credit all of them. A better +bot might also remember what the original question was and reply "foo +is baz" instead of "bar is baz". + +Next we have some examples of special codes. If we have: + + foo is bar|baz|foo to you too|foos|$who + baz is foo + +...then the following are valid responses when asked about foo: + + foo is bar + baz is foo + foo to you too + * A foos + foo is z + +-- end -- diff --git a/BotModules/Insult.bm b/BotModules/Insult.bm new file mode 100644 index 0000000..92e2e0f --- /dev/null +++ b/BotModules/Insult.bm @@ -0,0 +1,136 @@ +################################ +# Insult Module # +################################ + +# This is basically a loose port of insultd, a random insult server, +# for self-flagellating maniacs, written on 1991-12-09 by +# garnett@colorado.edu. See http://insulthost.colorado.edu/ + +package BotModules::Insult; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +our @adjectives = qw( acidic antique contemptible culturally-unsound +despicable evil fermented festering foul fulminating humid impure +inept inferior industrial left-over low-quality malodorous off-color +penguin-molesting petrified pointy-nosed salty sausage-snorfling +tasteless tempestuous tepid tofu-nibbling unintelligent unoriginal +uninspiring weasel-smelling wretched spam-sucking egg-sucking decayed +halfbaked infected squishy porous pickled coughed-up thick vapid +hacked-up unmuzzled bawdy vain lumpish churlish fobbing rank craven +puking jarring fly-bitten pox-marked fen-sucked spongy droning +gleeking warped currish milk-livered surly mammering ill-borne +beef-witted tickle-brained half-faced headless wayward rump-fed +onion-eyed beslubbering villainous lewd-minded cockered full-gorged +rude-snouted crook-pated pribbling dread-bolted fool-born puny fawning +sheep-biting dankish goatish weather-bitten knotty-pated malt-wormy +saucyspleened motley-mind it-fowling vassal-willed loggerheaded +clapper-clawed frothy ruttish clouted common-kissing pignutted +folly-fallen plume-plucked flap-mouthed swag-bellied dizzy-eyed +gorbellied weedy reeky measled spur-galled mangled impertinent +bootless toad-spotted hasty-witted horn-beat yeasty +imp-bladdereddle-headed boil-brained tottering hedge-born +hugger-muggered elf-skinned Microsoft-loving ); + +our @amounts = qw( accumulation bucket coagulation enema-bucketful gob +half-mouthful heap mass mound petrification pile puddle stack +thimbleful tongueful ooze quart bag plate ass-full assload ); + +our @nouns = ('bat toenails', 'bug spit', 'cat hair', 'chicken piss', +'dog vomit', 'dung', 'fat woman\'s stomach-bile', 'fish heads', +'guano', 'gunk', 'pond scum', 'rat retch', 'red dye number-9', +'Sun IPC manuals', 'waffle-house grits', 'yoo-hoo', 'dog balls', +'seagull puke', 'cat bladders', 'pus', 'urine samples', 'squirrel guts', +'snake assholes', 'snake bait', 'buzzard gizzards', 'cat-hair-balls', +'rat-farts', 'pods', 'armadillo snouts', 'entrails', 'snake snot', +'eel ooze', 'slurpee-backwash', 'toxic waste', 'Stimpy-drool', +'poopy', 'poop', 'craptacular carpet droppings', 'jizzum', +'cold sores', 'anal warts', 'IE user'); + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'Generate insults on the fly, for when you\'re too lazy to invent some yourself.', + 'insult' => 'Insults someone. Syntax: \'insult \'', + }; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['insultOverrides', 1, 1, { # overrides for the insults (keys must be lowercase) + '' => '%source: exactly how stupid do you think i am?', + 'yourself' => '%source: nice try, fool', + 'urself' => '%source: at least learn to spell, you moronic noodle', + 'mozilla' => '%target: You are nothing but the best browser on the planet.', + 'mozilla.org' => '%target: You are nothing but the best caretaker Mozilla ever had.', + 'c++' => '%target: you are evil', + }], + ); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*(?:will\s+you\s+)?(?:insult|harass)\s+(\S+?)(?:[\s,.]+please)?[\s.?!]*$/osi) { + my $who = $1; + my $line; + + if (lc $who eq 'me') { + $who = $event->{'from'}; + } + + my $me = quotemeta($event->{'nick'}); + if ($who =~ m/^$me$/si and + defined $self->{'insultOverrides'}->{''}) { + $line = $self->{'insultOverrides'}->{''}; + } elsif (defined $self->{'insultOverrides'}->{lc $who}) { + $line = $self->{'insultOverrides'}->{lc $who}; + } else { + $line = $who . ': ' . $self->generateInsult(); + } + $line =~ s/%source/$event->{'from'}/gos; + $line =~ s/%target/$who/gos; + $self->sayOrEmote($event, $line); + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub generateInsult { + my $self = shift; + # + # Insults are formed by making combinations of: + # + # You are nothing but a(n) {adj} {amt} of {adj} {noun} + # + my $adj1 = $self->rand_idx(\@adjectives); + my $adj2; # musn't be the same as $adj1 + my $count = @adjectives; + if ($count > 1) { + my $index = int(rand($count)); + if ($adjectives[$index] eq $adj1) { + ++$index; + $index = 0 if $index >= $count; + } + $adj2 = $adjectives[$index]; + } else { + $adj2 = 'err... of... some'; + } + my $amnt = $self->rand_idx(\@amounts); + my $noun = $self->rand_idx(\@nouns); + my $an = $adj1 =~ m/^[aeiou]/ois ? 'an' : 'a'; + return "You are nothing but $an $adj1 $amnt of $adj2 $noun."; +} + +sub rand_idx { + my $self = shift; + my($array) = @_; + return $array->[int(rand(@$array))]; +} diff --git a/BotModules/Karma.bm b/BotModules/Karma.bm new file mode 100644 index 0000000..12e33b2 --- /dev/null +++ b/BotModules/Karma.bm @@ -0,0 +1,196 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Karma Module # +################################ + +package BotModules::Karma; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['scores', 1, 1, {}], # nick => total karma. + ['privateScores', 1, 1, {}], # nick => nick karma nick karma... + ['secondsDelayRequired', 1, 1, 20], + ['_lastspoken', 0, 0, {}], # nick => nick => time + ); +} + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'A karma tracker. If you have authenticated (using the \'auth\' command) then it will also keep track of your own setting of people\'s karma, as well as the total of everyone\'s settings. Use the \'rank\' command to find someone\'s karma rank.', + '++' => 'Increase someone\'s karma. Syntax: victim++', + '--' => 'Decrease someone\'s karma. Syntax: victim--', + 'rank' => 'Find someone\'s karma level. Omit the victim\'s name to get a complete listing of everyone\'s karma (long). Syntax: \'rank victim\' or just \'rank\'', + }; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^(\S+)\+\+$/os) { + $self->ChangeKarma($event, $1, 1); + } elsif ($message =~ /^(\S+)\-\-$/os) { + $self->ChangeKarma($event, $1, -1); + } elsif ($message =~ /^\s*(?:karma\s+)?ranks?[?\s]*$/os) { + $self->ReportKarmaRanks($event, $1); + } elsif ($message =~ /^\s*karma(?:\s+rank)?\s+(\S+)[?\s]*$/os or + $message =~ /^\s*(?:karma\s+)?rank\s+(\S+)[?\s]*$/os) { + $self->ReportKarma($event, $1); + } else { + return $self->SUPER::Told(@_); + } + return 0; # dealt with it... +} + +sub Heard { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^(\S*[^-+\s])\+\+$/os) { + $self->ChangeKarma($event, $1, 1); + } elsif ($message =~ /^(\S*[^-+\s])\-\-$/os) { + $self->ChangeKarma($event, $1, -1); + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub ChangeKarma { + my $self = shift; + my ($event, $who, $delta) = @_; + $self->debug("$who += $delta requested"); + if ((defined($self->{'_lastSpoken'}->{$event->{'user'}})) and + (defined($self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who})) and + (($event->{'time'} - $self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who}) <= $self->{'secondsDelayRequired'})) { + $self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who} = $self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who}+5; + my $delay = $self->{'secondsDelayRequired'} - ($event->{'time'} - $self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who}); + $self->directSay($event, "You will have to wait another $delay seconds before being able to change ${who}'s karma."); + } else { + if (not defined($self->{'_lastSpoken'}->{$event->{'user'}})) { + $self->{'_lastSpoken'}->{$event->{'user'}} = {}; + } + $self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who} = $event->{'time'}; + if (lc $event->{'from'} eq lc $who) { + if ($delta > 0) { + $delta = -$delta; + } + } + if ($event->{'channel'} ne '') { + $self->{'scores'}->{lc $who} += $delta; + if ($self->{'scores'}->{lc $who} == 0) { + delete($self->{'scores'}->{lc $who}); + } + } + my $nick = lc $event->{'userName'}; + if ($nick) { + if (not defined($self->{"privateScores"}->{$nick})) { + $self->{"privateScores"}->{$nick} = (lc($who) . ' ' . $delta); + } else { + my %privateScores = split(' ', $self->{"privateScores"}->{$nick}); + $privateScores{lc $who} += $delta; + if ($privateScores{lc $who} == 0) { + delete($privateScores{lc $who}); + } + my @privateScores = %privateScores; + local $" = ' '; + $self->{'privateScores'}->{$nick} = "@privateScores"; + } + } elsif ($event->{'channel'} eq '') { + $self->say($event, 'For private stats, you need to authenticate. Use the \'newuser\' and \'auth\' commands.'); + } + $self->saveConfig(); + } +} + +sub ReportKarma { + my $self = shift; + my ($event, $who) = @_; + if (not defined($self->{'scores'}->{lc $who})) { + $self->say($event, "$who has no karma."); + } else { + my $karma = $self->{'scores'}->{lc $who}; + my @order = sort { $self->{'scores'}->{$b} <=> $self->{'scores'}->{$a} } keys(%{$self->{'scores'}}); + my $rank = 0; + if (scalar(@order)) { + user: foreach my $user (@order) { + $rank++; + if (lc $user eq lc $who) { + last user; + } + } + } + $self->say($event, "$who has $karma points of karma (rank $rank)."); + } + if ($event->{'channel'} eq '') { + $nick = lc $event->{'userName'}; + if ($nick) { + if (not defined($self->{"privateScores"}->{$nick})) { + $self->say($event, "You have not given anyone any karma."); + } else { + my %privateScores = split(' ', $self->{"privateScores"}->{$nick}); + my $karma = $privateScores{lc $who}; + + if (not defined($karma)) { + $self->say($event, "You have not given $who any karma."); + } else { + $self->say($event, "You have given $who $karma points of karma."); + } + } + } else { + $self->say($event, 'For private stats, you need to authenticate. Use the \'newuser\' and \'auth\' commands.'); + } + } +} + +sub ReportKarmaRanks { + my $self = shift; + my ($event) = @_; + my @order = sort { $self->{'scores'}->{$b} <=> $self->{'scores'}->{$a} } keys(%{$self->{'scores'}}); + if (scalar(@order)) { + if ($event->{'channel'} ne '') { + my $top = $order[0]; + my $score = $self->{'scores'}->{$top}; + $self->say($event, "The person with the most karma is $top with $score points."); + } + $self->directSay($event, "Global rankings:"); + $self->ReportKarmaRanksList($event, \@order, $self->{'scores'}); + } + if ($event->{'channel'} eq '') { + $nick = lc $event->{'userName'}; + if ($nick) { + if (defined($self->{"privateScores"}->{$nick})) { + my %privateScores = split(' ', $self->{"privateScores"}->{$nick}); + @order = sort { $privateScores{$b} <=> $privateScores{$a} } keys(%privateScores); + if (scalar(@order)) { + $self->directSay($event, "Personal rankings:"); + $self->ReportKarmaRanksList($event, \@order, \%privateScores); + } else { + $self->say($event, "I seem to have lost track of the people to which you gave karma points."); + } + } else { + $self->say($event, "You have not given anyone karma."); + } + } else { + $self->say($event, 'For private stats, you need to authenticate. Use the \'newuser\' and \'auth\' commands.'); + } + } +} + +sub ReportKarmaRanksList { + my $self = shift; + my($event, $order, $scores) = @_; + my $rank = 1; + foreach my $entry (@$order) { + my $score = $scores->{$entry}; + $self->directSay($event, "$rank. $entry ($score)"); + $rank++; + } +} diff --git a/BotModules/KeepAlive.bm b/BotModules/KeepAlive.bm new file mode 100644 index 0000000..6cf0af1 --- /dev/null +++ b/BotModules/KeepAlive.bm @@ -0,0 +1,51 @@ +################################ +# KeepAlive Module # +################################ + +package BotModules::KeepAlive; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['delay', 1, 1, 20], + ['string', 1, 1, 'ping'], + ['target', 1, 1, '#spam'], + ); +} + +# Schedule - called when bot connects to a server, to install any schedulers +# use $self->schedule($event, $delay, $times, $data) +# where $times is 1 for a single event, -1 for recurring events, +# and a +ve number for an event that occurs that many times. +sub Schedule { + my $self = shift; + my ($event) = @_; + $self->schedule($event, \$self->{'delay'}, -1, 'keepalive'); + $self->SUPER::Schedule($event); +} + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'This is a simple keep-alive module, it regularly sends text out. This has been known to help with network lag.', + } if $self->isAdmin($event); + return {}; +} + +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + if ($data[0] eq 'keepalive') { + local $event->{'target'} = $self->{'target'}; + $self->say($event, $self->{'string'}); + } else { + $self->SUPER::Scheduled($event, @data); + } +} diff --git a/BotModules/KookBot.bm b/BotModules/KookBot.bm new file mode 100644 index 0000000..31fc6e1 --- /dev/null +++ b/BotModules/KookBot.bm @@ -0,0 +1,109 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# KookBot Module # +################################ +# +# Based on kookbot.pl by Keunwoo Lee +# http://www.cs.washington.edu/homes/klee/misc/kookbot.html +# +# Whacked by Axel Hecht + +package BotModules::KookBot; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'This is the KookBot module. See http://www.cs.washington.edu/homes/klee/misc/kookbot.html for details', + 'kook' => 'Requests that the bot kook around.', + }; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['sentences', 1, 1, 1], # how many sentences to say each time + ['good-adjectives', 1, 1, ['intelligent', 'open-minded', 'honest', 'clear', 'practical', 'flexible yet critical', 'harmonious', 'truthful', 'well-constructed', ]], + ['good-nouns', 1, 1, ['freedom', 'justice', 'straightforwardness', 'subtlety', 'strength', 'compassion', 'fairness', 'rational approach', 'democracy', 'realism', ]], + ['bad-adjectives', 1, 1, ['orthodox', 'malignant', 'malevolent', 'dangerous', 'fascist', 'foolish', 'closed-minded', 'annoying', 'unjust', 'long-winded', 'lacking in support', 'shameful', ]], + ['bad-nouns', 1, 1, ['oppression', 'tyranny', 'stupidity', 'ignorance', 'discrimination', 'indifference', 'propaganda', 'prejudice', ]], + ['tactics-agree', 1, 1, ['apply principles of', 'embrace', 'think along the same lines as', 'commune with the spirit of', 'would prefer', 'argue strenuously for', 'try to posit', 'show the validity in', ]], + ['tactics-object', 1, 1, ['object to', 'reject anything involved with', 'refuse to accept', 'argue strenuously against', 'completely disagree with', 'rebut', 'take issue with']], + ['productions', 1, 1, [ + # OK, so here's the key: + # \0 = good_adjective + # \1 = good_noun + # \2 = bad_adjective + # \3 = bad_noun + # \4 = tactics_agree + # \5 = tactics_object + 'You \4 the \2 \3 to \1.', + 'True \0 \1 proceeds from examining \1, not \3.', + 'One must consider \1 versus \3.', + 'I can only imagine that you \4 \3.', + 'You \4 \2 \3. I \5 that.', + 'The argument you \4 would result in \3.', + 'Think about the \3, \2 and \2, and how it compares with \0 \1.', + 'I ask you to be \0, not \2. You \5 any appearance of \1.', + 'Is this \0? I think it is obvious that your statement is \2 and \2.', + 'But there is a \0 \1, and your argument would \5 it.', + 'Can there be any doubt? I \4 \0, \0 \1, and you obviously do not.', + 'You \5 the fact that your evidence is shallow, the result of \2 propaganda and \3.', + 'Yet your argument tries to \5 everything that is \0.', + 'It is only the \0 evidence that you \5, and it is because you \5 \1.', + 'I \5 your arguments only. There is no personal attack here.', + ]], + ); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + my $dokook = undef; + if ((($event->{'level'} == 1) and ($self->isAdmin($event))) or + (($event->{'level'} == 3) and ($event->{'God_channel_rights'}) and + ($event->{'KookBot_channel'} eq $event->{'God_channel'}))) { + if ($message =~ /^\s*kook\s+(\S+)\s*$/osi) { + $dokook = $1; + } + } + if (($message =~ /^\s*kook\s*$/osi) or defined($dokook)) { + my @output; + for (my $i = 0; $i < $self->{'sentences'}; $i++) { + my $line = $self->rand_idx('productions'); + $line =~ s/\\0/$self->rand_idx('good-adjectives')/goe; + $line =~ s/\\1/$self->rand_idx('good-nouns')/goe; + $line =~ s/\\2/$self->rand_idx('bad-adjectives')/goe; + $line =~ s/\\3/$self->rand_idx('bad-nouns')/goe; + $line =~ s/\\4/$self->rand_idx('tactics-agree')/goe; + $line =~ s/\\5/$self->rand_idx('tactics-object')/goe; + push(@output, $line); + } + local $event->{'target'} = $event->{'target'}; + if (defined($dokook)) { + $event->{'target'} = $dokook; + } + local $" = ' '; + $self->say($event, "@output"); + } else { + if (($event->{'level'} == 1) and ($message =~ /^\s*kook\s+(\S+)\s*$/osi)) { + $event->{'God_channel'} = lc($1); + $event->{'KookBot_channel'} = lc($1); + } + my $result = $self->SUPER::Told(@_); + return $result < (3 * defined($event->{'KookBot_channel'})) ? 3 : $result; + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub rand_idx { + my $self = shift; + my($array) = @_; + return $self->{$array}->[int(rand(@{$self->{$array}}))]; +} diff --git a/BotModules/List.bm b/BotModules/List.bm new file mode 100644 index 0000000..8298df2 --- /dev/null +++ b/BotModules/List.bm @@ -0,0 +1,179 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# List Module # +################################ + +package BotModules::List; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# XXX Wipe entire list command + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['lists', 1, 1, {}], # user => 'list name|item 1|item 2||list name|item1|item 2' + ['preferredLineLength', 1, 1, 80], # the usual + ['maxItemsInChannel', 1, 1, 20], # max number of items to print in the channel (above this and direct messages are used) + ); +} + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'A personal list tracker. Store your lists here. You must be authenticated to use this (see \'newuser\'). Use the \'add\' command to add items to a list.', + 'add' => 'Add an item to a personal list. List names shouldn\'t contain the word \'to\' otherwise things will be too ambiguous. Syntax: \'add to list\', e.g. \'add bug 5693 to critical bug list\'.', + 'remove' => 'Remove an item from a personal list. Syntax: \'remove from list\', e.g. \'remove bug 5693 from critical bug list\'.', + 'list' => 'List the items in your list. Syntax: \'list items in list\', e.g. \'list items in critical bug list\' or just \'critical bug list\'.', + 'lists' => 'Tells you what lists you have set up.', + }; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*add\s+(\S(?:.*\S)?)\s+to\s+(?:my\s+)?(\S(?:.*\S)?)\s+list[\s!.]*$/osi and $message !~ /\|/o and $event->{'userName'}) { + $self->AddItem($event, $1, $2); + } elsif ($message =~ /^\s*remove\s+(\S(?:.*\S)?)\s+from\s+(?:my\s+)?(\S(?:.*\S)?)\s+list[\s!.]*$/osi and $message !~ /\|/o and $event->{'userName'}) { + $self->RemoveItem($event, $1, $2); + } elsif ($message =~ /^\s* (?:examine \s+ | + list \s+ items \s+ in \s+ | + what (?:\s+is|'s) \s+ (?:in\s+)? ) + (?: my \s+ | the \s+ )? + ( \S (?:.*\S)? ) + \s+ list [\s!?.]* $/osix + and $message !~ /\|/o and $event->{'userName'}) { + $self->ListItems($event, $1); + } elsif ($message =~ /^\s*lists[?\s.!]*$/osi and $event->{'userName'}) { + $self->ListLists($event, $1); + } else { + return $self->SUPER::Told(@_); + } + return 0; # dealt with it... +} + +sub Baffled { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*(\S(?:.*\S)?)\s+list[\s!?.]*$/osi and $message !~ /\|/o and $event->{'userName'}) { + $self->ListItems($event, $1); + } else { + return $self->SUPER::Baffled(@_); + } + return 0; # dealt with it... +} + +sub Heard { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*add\s+(\S(?:.*\S)?)\s+to\s+(?:my\s+)?(\S(?:.*\S)?)\s+list[\s!.]*$/osi and $message !~ /\|/o and $event->{'userName'}) { + $self->AddItem($event, $1, $2); + } elsif ($message =~ /^\s*remove\s+(\S(?:.*\S)?)\s+from\s+(?:my\s+)?(\S(?:.*\S)?)\s+list[\s!.]*$/osi and $message !~ /\|/o and $event->{'userName'}) { + $self->RemoveItem($event, $1, $2); + } else { + return $self->SUPER::Told(@_); + } + return 0; # dealt with it... +} + +sub AddItem { + my $self = shift; + my ($event, $what, $list) = @_; + my @lists = split(/\|\|/o, $self->{'lists'}->{$event->{'userName'}}); + local $" = '\', \''; + my %lists; + foreach my $sublist (@lists) { + my @items = split(/\|/o, $sublist); + $lists{shift @items} = \@items; + } + push(@{$lists{lc $list}}, $what); + local $" = '|'; + my $compoundLists = ''; + foreach my $list (keys(%lists)) { + if ($compoundLists ne '') { + $compoundLists .= '||'; + } + $compoundLists .= "$list|@{$lists{$list}}"; + } + $self->{'lists'}->{$event->{'userName'}} = $compoundLists; + $self->saveConfig(); + $self->say($event, "$event->{'from'}: stored '$what' in '$list' list"); +} + +sub RemoveItem { + my $self = shift; + my ($event, $what, $list) = @_; + my @lists = split(/\|\|/o, $self->{'lists'}->{$event->{'userName'}}); + local $" = '\', \''; + my %lists; + my $removed = 0; + foreach my $sublist (@lists) { + my @items = split(/\|/o, $sublist); + if (lc $list eq $items[0]) { + my $listName = shift @items; + foreach my $item (@items) { + if (lc $what ne lc $item) { + push(@{$lists{$listName}}, $item); + } else { + $removed++; + } + } + } else { + $lists{shift @items} = \@items; + } + } + local $" = '|'; + my $compoundLists = ''; + foreach my $list (keys(%lists)) { + if ($compoundLists ne '') { + $compoundLists .= '||'; + } + $compoundLists .= "$list|@{$lists{$list}}"; + } + $self->{'lists'}->{$event->{'userName'}} = $compoundLists; + $self->saveConfig(); + if ($removed) { + $self->say($event, "$event->{'from'}: removed '$what' from '$list' list"); + } else { + $self->say($event, "$event->{'from'}: could not find '$what' in '$list' list"); + } +} + +sub ListItems { + my $self = shift; + my ($event, $list) = @_; + my @lists = split(/\|\|/o, $self->{'lists'}->{$event->{'userName'}}); + my %lists; + foreach my $list (@lists) { + my @items = split(/\|/o, $list); + $lists{lc shift @items} = \@items; + } + if (defined(@{$lists{lc $list}})) { + my $size = scalar(@{$lists{lc $list}}); + if ($size > $self->{'maxItemsInChannel'}) { + $self->channelSay($event, "$event->{'from'}: Your $list list contains $size items, which I am /msg'ing you."); + $self->directSay($event, $self->prettyPrint($self->{'preferredLineLength'}, "Your $list list contains: ", '', ', ', @{$lists{lc $list}})); + } else { + $self->say($event, $self->prettyPrint($self->{'preferredLineLength'}, "Your $list list contains: ", $event->{'channel'} eq '' ? '' : "$event->{'from'}: ", ', ', @{$lists{lc $list}})); + } + } else { + $self->say($event, "You don't have a $list list, sorry."); + } +} + +sub ListLists { + my $self = shift; + my ($event) = @_; + my @lists = split(/\|\|/o, $self->{'lists'}->{$event->{'userName'}}); + my @listNames; + foreach my $list (@lists) { + my @items = split(/\|/o, $list); + push(@listNames, $items[0]); + } + $self->say($event, $self->prettyPrint($self->{'preferredLineLength'}, "Your lists are: ", $event->{'channel'} eq '' ? '' : "$event->{'from'}: ", ', ', @listNames)); +} diff --git a/BotModules/MagicEightBall.bm b/BotModules/MagicEightBall.bm new file mode 100644 index 0000000..f382325 --- /dev/null +++ b/BotModules/MagicEightBall.bm @@ -0,0 +1,77 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Magic Eight Ball # +################################ + +package BotModules::MagicEightBall; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'The all knowing magic eight ball, in electronic form. Ask a question and the answer shall be provided.', + $self->{'prefix'}.'ball' => "Ask the Magic Eight Ball a question. Syntax: '$self->{'prefix'}ball: will it happen?'", + }; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['prefix', 1, 1, '!8'], # the prefix to put before the 'ball' command + ['responses-positive', 1, 1, ['It is possible.', 'Yes!', 'Of course.', 'Naturally.', 'Obviously.', + 'One would be wise to think so.', 'The outlook is good.', 'It shall be.', + 'The answer is certainly yes.', 'It is so.']], + ['responses-negative', 1, 1, ['In your dreams.', 'No.', 'No chance.', 'Unlikely.', 'About as likely as pigs flying.', + 'You\'re kidding, right?', 'The outlook is poor.', 'I doubt it very much.', + 'The answer is a resounding no.', 'NO!', 'NO.']], + ['responses-unknown', 1, 1, ['Maybe...', 'The outlook is hazy, please ask again later.', 'No clue.', + 'What are you asking me for?', '_I_ don\'t know.', 'Come again?', + 'You know the answer better than I.', 'The answer is def-- oooh! shiny thing!']], + ); +} + +sub Told { + my $self = shift; + return ($self->CheckTheBall(@_) and $self->SUPER::Told(@_)); +} + +sub Heard { + my $self = shift; + return ($self->CheckTheBall(@_) and $self->SUPER::Told(@_)); +} + +sub CheckTheBall { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ m/$self->{'prefix'}ball[\s:,]+(\S.+\w.+)$/si) { + + # -- #buncs was here -- + # !8ball: are you a fish? + # Kam: About as likely as pigs flying. + # !8ball: is the world flat? + # Kam: The answer is a resounding no. + # !8ball: is the world round? + # Kam: _I_ don't know. + # !8ball: is the world spherical? + # Kam: The answer is certainly yes. + # how DOES it do that? :) + # it's gooood :-) + + # trim the fat from the question + $message =~ s/\W//gos; + # pick a reply category that will always be the same for this exact question + my $response = $self->{['responses-positive', 'responses-negative', 'responses-unknown']->[(length($message) % 3)]}; + # pick a specific reply that will be different to recent ones + $response = $response->[$event->{'time'} % @$response]; + $self->say($event, "$event->{'from'}: $response"); + } else { + return 1; + } + return 0; +} diff --git a/BotModules/MiniLogger.bm b/BotModules/MiniLogger.bm new file mode 100644 index 0000000..084c883 --- /dev/null +++ b/BotModules/MiniLogger.bm @@ -0,0 +1,155 @@ +################################ +# MiniLogger Module # +################################ + +package BotModules::MiniLogger; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +sub Help { + my $self = shift; + my ($event) = @_; + my %help = ( + '' => 'This module keeps a log of the last few comments that match some patterns. For example, it can be used to remember URIs that have recently been mentioned.', + ); + foreach (keys %{$self->{'patterns'}}) { + $help{$_} = 'Returns any recent comment that matched the pattern /'.$self->sanitizeRegexp($self->{'patterns'}->{$_})."/. To narrow the search down even more, you can include a search string after the $_, as in '$_ goats'. To restrict the search to a particular channel, append \'in \' at the end."; + } + if ($self->isAdmin($event)) { + $help{''} .= ' To add a new pattern, use the following syntax: vars MiniLogger patterns \'+|name|pattern\''; + $help{'flush'} = 'Deletes any logs for patterns or channels that are no longer relevant, makes sure all the logs are no longer than the \'bufferSize\' length. Syntax: \'flush minilogs\'.'; + } + return \%help; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['log', 0, 0, {}], # log -> channel -> patternName -> [ text] + ['bufferSize', 1, 1, 20], # number of comments to remember, per channel/pattern combination + ['patterns', 1, 1, {'links'=>'"]+>?'}], # list of patternNames and patterns (regexp) + ['blockedPatterns', 1, 1, []], # list of patterns (regexp) to ignore + ); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if (($message =~ /^\s*([a-zA-Z0-9]+)(?:\s+(.+?))?(?:\s+in\s+(.+?))?\s*$/osi) and ($self->{'patterns'}->{$1})) { + $self->Report($event, $3, $1, $2); # event, channel, log, pattern + } elsif ($self->isAdmin($event)) { + if ($message =~ /^\s*flush\s+minilogs\s*$/osi) { + $self->FlushMinilogs($event); + } else { + return $self->SUPER::Told(@_); + } + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Log { + my $self = shift; + my ($event) = @_; + if (($event->{'firsttype'} eq 'Told') or ($event->{'firsttype'} eq 'Heard')) { + $self->DoLog($event, "<$event->{'from'}> $event->{'data'}"); + } elsif (($event->{'firsttype'} eq 'Felt') or ($event->{'firsttype'} eq 'Saw')) { + $self->DoLog($event, "* $event->{'from'} $event->{'data'}"); + } +} + +sub DoLog { + my $self = shift; + my ($event, $message) = @_; + if ($event->{'channel'} ne '') { + # don't log private messages + foreach my $pattern (keys %{$self->{'patterns'}}) { + my $regexp = $self->sanitizeRegexp($self->{'patterns'}->{$pattern}); + if ($message =~ /$regexp/s) { + # wohay, we have a candidate! + # now check for possible blockers... + unless ($self->isBlocked($message)) { + $self->debug("LOGGING: $message"); + push(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}}, $message); + if (@{$self->{'log'}->{$event->{'channel'}}->{$pattern}} > $self->{'bufferSize'}) { + shift(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}}); + } + } + } + } + } +} + +sub isBlocked { + my $self = shift; + my ($message) = @_; + foreach my $blockedPattern (@{$self->{'blockedPatterns'}}) { + my $regexp = $self->sanitizeRegexp($blockedPattern); + if ($message =~ /$regexp/s) { + return 1; + } + } + return 0; +} + +sub Report { + my $self = shift; + my ($event, $channel, $log, $pattern) = @_; + my @channels = $channel ? lc($channel) : @{$self->{'channels'}}; + my $count; + $pattern = $self->sanitizeRegexp($pattern); + foreach $channel (@channels) { + foreach my $match (@{$self->{'log'}->{$channel}->{$log}}) { + if ((!$pattern) or ($match =~ /$pattern/s)) { + $self->directSay($event, $match); + $count++; + } + } + } + unless ($count) { + $self->directSay($event, 'No matches, sorry.'); + } + $self->channelSay($event, "$event->{'from'}: minilog matches /msg'ed"); +} + +sub FlushMinilogs { + my $self = shift; + my ($event) = @_; + # remove dead channels + my %channels = map { lc($_) => 1 } @{$self->{'channels'}}; + foreach my $channel (keys %{$self->{'log'}}) { + if ($channels{$channel}) { + # remove dead logs + foreach my $pattern (keys %{$self->{'log'}->{$channel}}) { + if ($self->{'patterns'}) { + # remove any newly blocked patterns + my @newpatterns; + foreach my $match (@{$self->{'log'}->{$channel}->{$pattern}}) { + unless ($self->isBlocked($match)) { + push (@newpatterns, $match); + } + } + # remove excess logs + if (@newpatterns) { + @{$self->{'log'}->{$channel}->{$pattern}} = (@newpatterns[ + @newpatterns - $self->{'bufferSize'} < 0 ? 0 : @newpatterns - $self->{'bufferSize'}, + $#newpatterns] + ); + } else { + @{$self->{'log'}->{$channel}->{$pattern}} = (); + } + } else { + delete($self->{'log'}->{$channel}->{$pattern}); + } + } + } else { + delete($self->{'log'}->{$channel}); + } + } + $self->say($event, 'Minilogs flushed.'); +} diff --git a/BotModules/Parrot.bm b/BotModules/Parrot.bm new file mode 100644 index 0000000..af3a367 --- /dev/null +++ b/BotModules/Parrot.bm @@ -0,0 +1,66 @@ +################################ +# Parrot Module # +################################ + +package BotModules::Parrot; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +sub Help { + my $self = shift; + my ($event) = @_; + if ($self->isAdmin($event)) { + return { + '' => 'This module allows you to make the bot do stuff.', + 'say' => 'Makes the bot say something. The can be a person or channel. Syntax: say ', + 'do' => 'Makes the bot do (/me) something. The can be a person or channel. Syntax: do ', + 'invite' => 'Makes the bot invite (/invite) somebody to a channel. Syntax: invite ', + 'announce' => 'Makes the bot announce something to every channel in which this module is enabled. Syntax: announce ', + }; + } else { + return $self->SUPER::Help($event); + } +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ((($event->{'level'} == 1) and ($self->isAdmin($event))) or + (($event->{'level'} == 3) and ($event->{'God_channel_rights'}) and ($event->{'Parrot_channel'} eq $event->{'God_channel'}))) { + if ($message =~ /^\s*say\s+(\S+)\s+(.*)$/osi) { + local $event->{'target'} = $1; + $self->say($event, $2); + } elsif ($message =~ /^\s*do\s+(\S+)\s+(.*)$/osi) { + local $event->{'target'} = $1; + $self->emote($event, $2); + } elsif ($message =~ /^\s*announce\s+(.*)$/osi) { + $self->announce($event, $1); + } elsif ($message =~ /^\s* invite \s+ + (\S+) \s+ + (?: (?:in|to|into) \s+ + (?:channel \s+)? )? + (\S+) \s*$/osix) { + $self->invite($event, $1, $2); + } else { + return $self->SUPER::Told(@_); + } + } else { + if (($event->{'level'} == 1) and (($message =~ /^\s*say\s+(\S+)\s+(.*)$/osi) or ($message =~ /^\s*do\s+(\S+)\s+(.*)$/osi))) { + $event->{'God_channel'} = lc($1); + $event->{'Parrot_channel'} = lc($1); + } + my $result = $self->SUPER::Told(@_); + return $result < (3 * defined($event->{'Parrot_channel'})) ? 3 : $result; + + # Note: We go through some contortions here because if the parent + # returns 3 or more, some other module sets God_channel, and + # the command is either not 'say' or 'do' (or the God_channel happens + # to be different to the channel we are looking at) then it is theoretically + # possible that God_channel_rights could be set, but not for the channel + # we care about. Or something..... ;-) + + } + return 0; # we've dealt with it, no need to do anything else. +} + diff --git a/BotModules/Quiz.bm b/BotModules/Quiz.bm new file mode 100644 index 0000000..1d56ce9 --- /dev/null +++ b/BotModules/Quiz.bm @@ -0,0 +1,571 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Quiz Module # +################################ +# some of these ideas are stolen from moxquizz (an eggdrop module) +# see http://www.meta-x.de/moxquizz/ + +package BotModules::Quiz; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# XXX high score table +# XXX do something with level +# XXX make bot able to self-abort if no-one is taking part +# XXX implement feature so that users that can be quiz admins in certain channels +# XXX accept user submission +# XXX README for database format (for now see http://www.meta-x.de/moxquizz/README.database) +# XXX pause doesn't stop count of how long answer takes to answer +# XXX different quiz formats, e.g. university challenge, weakest link (maybe implement by inheritance?) +# XXX stats, e.g. number of questions skipped +# XXX category filtering + +sub Help { + my $self = shift; + my($event) = @_; + my $help = { + '' => "Runs quizzes. Start a quiz with the $self->{'prefix'}ask command.", + $self->{'prefix'}.'ask' => 'Starts a quiz.', + $self->{'prefix'}.'pause' => "Pauses the current quiz. Resume with $self->{'prefix'}resume.", + $self->{'prefix'}.'resume' => 'Resumes the current quiz.', + $self->{'prefix'}.'repeat' => 'Repeats the current question.', + $self->{'prefix'}.'endquiz' => 'Ends the current quiz.', + $self->{'prefix'}.'next' => 'Jump to the next question (at least half of the active participants have to say this for the question to be skipped).', + $self->{'prefix'}.'score' => 'Show the current scores for the round.', + }; + if ($self->isAdmin($event)) { + $help->{'reload'} = 'To just reload the quiz data files instead of the whole module, use: reload Quiz Data'; + } + return $help; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['questionSets', 1, 1, ['trivia.en']], # the list of files to read (from the Quiz/ directory) + ['questions', 0, 0, []], # the list of questions (hashes) + ['categories', 0, 0, {}], # hash of arrays whose values are indexes into questions + ['questionsPerRound', 1, 1, -1], # how many questions per round (-1 = infinite) + ['currentQuestion', 1, 0, {}], # the active question (per-channel hash) + ['questionIndex', 1, 0, 0], # where to start when picking the next question + ['skipMargin', 1, 1, 10], # maximum number of questions to skip at a time + ['remainingQuestions', 1, 0, {}], # how many more questions this round (per-channel hash) + ['questionsTime', 1, 0, {}], # when the question was asked + ['quizTime', 1, 0, {}], # when the quiz was started + ['paused', 1, 0, {}], # if the game is paused + ['totalScores', 1, 1, {}], # user => score + ['quizScores', 1, 0, {}], # channel => "user score" + ['skip', 1, 0, {}], # channel => "user 1" + ['players', 1, 0, {}], # channel => "user last time" + ['tip', 1, 0, {}], # which tip should next be given on this channel + ['tipDelay', 1, 1, 10], # seconds to wait before giving a tip + ['timeout', 1, 1, 120], # seconds to wait before giving up + ['skipFractionRequired', 1, 1, 0.5], # fraction of players that must say !skip to skip + ['askDelay', 1, 1, 2], # how long to wait between answer and question + ['prefix', 1, 1, '!'], # the prefix to have at the start of commands + ); +} + +sub Schedule { + my $self = shift; + my($event) = @_; + $self->reloadData($event); + my $fakeEvent = {%$event}; + foreach my $channel (keys %{$self->{'currentQuestion'}}) { + $fakeEvent->{'channel'} = $channel; + $fakeEvent->{'target'} = $channel; + $self->debug("Restarting quiz in $channel... (qid $self->{'questionsTime'}->{$channel})"); + $self->schedule($fakeEvent, \$self->{'tipDelay'}, 1, 'tip', $self->{'questionsTime'}->{$channel}); + $self->schedule($fakeEvent, \$self->{'timeout'}, 1, 'timeout', $self->{'questionsTime'}->{$channel}); + if ($self->{'questionsTime'}->{$event->{'channel'}} == 0) { + $self->schedule($event, \$self->{'askDelay'}, 1, 'ask'); + } + } + $self->SUPER::Schedule($event); +} + +sub Told { + my $self = shift; + my($event, $message) = @_; + if ($message =~ /^\s*reload\s+quiz\s+data\s*$/osi and $self->isAdmin($event)) { + my $count = $self->reloadData($event); + $self->say($event, "$count questions loaded"); + } elsif ($message =~ /^\s*status[?\s]*$/osi) { + my $questions = @{$self->{'questions'}}; + my $quizzes = keys %{$self->{'currentQuestion'}}; + $self->say($event, "$event->{'from'}: I have $questions questions and am running $quizzes quizzes.", 1); # XXX 1 quizzes + } elsif (not $self->DoQuizCheck($event, $message, 1)) { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Baffled { + my $self = shift; + my($event, $message) = @_; + if (not $self->quizAnswer($event, $message)) { + return $self->SUPER::Baffled(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Heard { + my $self = shift; + my($event, $message) = @_; + if (not $self->DoQuizCheck($event, $message, 0) and + not $self->quizAnswer($event, $message)) { + return $self->SUPER::Heard(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub DoQuizCheck { + my $self = shift; + my($event, $message, $direct) = @_; + if ($message =~ /^\s*\Q$self->{'prefix'}\Eask\s*$/si) { + $self->quizStart($event); + } elsif ($message =~ /^\s*\Q$self->{'prefix'}\Epause\s*$/si) { + $self->quizPause($event); + } elsif ($message =~ /^\s*\Q$self->{'prefix'}\E(?:resume|unpause)\s*$/si) { + $self->quizResume($event); + } elsif ($message =~ /^\s*\Q$self->{'prefix'}\Erepeat\s*$/si) { + $self->quizRepeat($event); + } elsif ($message =~ /^\s*\Q$self->{'prefix'}\E(?:end|stop|strivia|exit)(?:quiz)?\s*$/si) { + $self->quizEnd($event); + } elsif ($message =~ /^\s*\Q$self->{'prefix'}\E(?:dunno|skip|next)\s*$/si) { + $self->quizSkip($event); + } elsif ($message =~ /^\s*\Q$self->{'prefix'}\E(?:scores)\s*$/si) { + $self->quizScores($event); + } else { + return 0; + } + return 1; +} + +sub reloadData { + my $self = shift; + my($event) = @_; + $self->{'questions'} = []; + $self->{'categories'} = {}; + $self->debug('Loading quiz data...'); + foreach my $set (@{$self->{'questionSets'}}) { + if ($set =~ m/^[a-zA-Z0-9-][a-zA-Z0-9.-]*$/os) { + local *FILE; + if (not open(FILE, "debug(" * $set (Not loaded; $!)"); + next; + } + $self->debug(" * $set"); + my $category; + my $question = {'tip' => []}; + while (defined($_ = )) { + chomp; + next if m/^\#/os; # skip comment lines + next if m/^\s*$/os; # skip blank lines + if (m/^Category:\s*(.*?)\s*$/os) { + # Category? (should always be on top!) + $category = $1; + if (not defined($self->{'categories'}->{$category})) { + $self->{'categories'}->{$category} = []; + } + } elsif (m/^Question:\s*(.*?)\s*$/os) { + # Question (should always stand after Category) + $question = {'question' => $1, 'tip' => []}; + if (defined($category)) { + $question->{'category'} = $category; + undef($category); + } + push(@{$self->{'questions'}}, $question); + push(@{$self->{'categories'}->{$category}}, $#{$self->{'questions'}}); + } elsif (m/^Answer:\s*(?:(.*?)\#(.*?)\#(.*?)|(.*?))\s*$/os) { + # Answer (will be matched if no regexp is provided) + if (defined($1)) { + $question->{'answer-long'} = "$1$2$3"; + $question->{'answer-short'} = $2; + } else { + $question->{'answer-long'} = $4; + $question->{'answer-short'} = $4; + } + } elsif (m/^Regexp:\s*(.*?)\s*$/os) { + # Regexp? (use UNIX-style expressions) + $question->{'answer-regexp'} = $1; + } elsif (m/^Author:\s*(.*?)\s*$/os) { + # Author? (the brain behind this question) + $question->{'author'} = $1; + } elsif (m/^Level:\s*(.*?)\s*$/os) { + # Level? [baby|easy|normal|hard|extreme] (difficulty) + $question->{'level'} = $1; + } elsif (m/^Comment:\s*(.*?)\s*$/os) { + # Comment? (comment line) + $question->{'comment'} = $1; + } elsif (m/^Score:\s*(.*?)\s*$/os) { + # Score? [#] (credits for answering this question) + $question->{'score'} = $1; + } elsif (m/^Tip:\s*(.*?)\s*$/os) { + # Tip* (provide one or more hints) + push(@{$question->{'tip'}}, $1); + } elsif (m/^TipCycle:\s*(.*?)\s*$/os) { + # TipCycle? [#] (Specify number of generated tips) + $question->{'tip-cycle'} = $1; + } else { + # XXX error handling + } + } + close(FILE); + } # else XXX invalid filename, ignore it + } + # if no more questions, abort running quizes. + if (not @{$self->{'questions'}}) { + foreach my $channel (keys %{$self->{'currentQuestion'}}) { + local $event->{'channel'} = $channel; + $self->say($event, 'There are no more questions.'); + $self->quizEnd($event); + } + } + return scalar(@{$self->{'questions'}}); +} + + +# game implementation + +sub Scheduled { + my $self = shift; + my($event, @data) = @_; + if ($data[0] eq 'tip') { + if ($self->{'questionsTime'}->{$event->{'channel'}} == $data[1] and + defined($self->{'currentQuestion'}->{$event->{'channel'}})) { + # $self->debug('time for a tip'); + if ($self->{'paused'}->{$event->{'channel'}} or + $self->quizTip($event)) { + $self->schedule($event, \$self->{'tipDelay'}, 1, @data); + } + } + } elsif ($data[0] eq 'timeout') { + if ($self->{'questionsTime'}->{$event->{'channel'}} == $data[1] and + defined($self->{'currentQuestion'}->{$event->{'channel'}})) { + if ($self->{'paused'}->{$event->{'channel'}}) { + $self->schedule($event, \$self->{'timeout'}, 1, @data); + } else { + my $answer = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'}; + $self->say($event, "Too late! The answer was: $answer"); + $self->quizQuestion($event); + } + } + } elsif ($data[0] eq 'ask') { + if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { + $self->quizQuestion($event); + } + } else { + $self->SUPER::Scheduled($event, @data); + } +} + +sub quizStart { # called by user + my $self = shift; + my($event) = @_; + if ($event->{'channel'} ne '' and + not defined($self->{'currentQuestion'}->{$event->{'channel'}})) { + if (@{$self->{'questions'}} == 0) { + # if no questions, complain. + $self->say($event, 'I cannot run a quiz with no questions!'); + } else { + # no game in progress, start one + $self->{'remainingQuestions'}->{$event->{'channel'}} = $self->{'questionsPerRound'}; + $self->{'paused'}->{$event->{'channel'}} = 0; + $self->{'quizTime'}->{$event->{'channel'}} = $event->{'time'}; + $self->{'quizScores'}->{$event->{'channel'}} = ''; + $self->{'players'}->{$event->{'channel'}} = ''; + $self->quizQuestion($event); + } + } +} + +sub quizQuestion { # called from quizStart or delayed from quizAnswer + my $self = shift; + my($event) = @_; + if ($event->{'channel'} ne '' and # in channel + not $self->{'paused'}->{$event->{'channel'}}) { # quiz not paused + if ($self->{'remainingQuestions'}->{$event->{'channel'}} != 0) { + $self->{'remainingQuestions'}->{$event->{'channel'}}--; + my $category = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'category'}; + my $try = 0; + my $questionCount = scalar keys %{$self->{'questions'}}; + while ($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'category'} eq $category + and $try++ < $questionCount) { + $self->{'currentQuestion'}->{$event->{'channel'}} = $self->pickQuestion($event); + } + $self->{'questionsTime'}->{$event->{'channel'}} = $event->{'time'}; + $self->{'tip'}->{$event->{'channel'}} = 0; + $self->{'skip'}->{$event->{'channel'}} = ''; + $self->schedule($event, \$self->{'tipDelay'}, 1, 'tip', $self->{'questionsTime'}->{$event->{'channel'}}); + $self->schedule($event, \$self->{'timeout'}, 1, 'timeout', $self->{'questionsTime'}->{$event->{'channel'}}); + $self->say($event, "Question: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'question'}"); + $self->debug("Question: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'question'}"); + $self->debug("Answer: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'}"); + $self->saveConfig(); + } else { + $self->quizEnd($event); + } + } +} + +sub quizAnswer { # called by user + my $self = shift; + my($event, $message) = @_; + if ($event->{'channel'} ne '' and # in channel + defined($self->{'currentQuestion'}->{$event->{'channel'}}) and # in quiz + $self->{'questionsTime'}->{$event->{'channel'}} and # not answered + not $self->{'paused'}->{$event->{'channel'}}) { # quiz not paused + $self->stringHash(\$self->{'players'}->{$event->{'channel'}}, $event->{'from'}, $event->{'time'}); + if (lc($message) eq lc($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'}) or + (defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-short'}) and + lc($message) eq lc($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-short'})) or + (defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-regexp'}) and + $message =~ /$self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-regexp'}/si)) { + # they got it right + my $who = $event->{'from'}; + my $answer = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'}; + my $score = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'score'}; + if (not defined($score)) { + $score = 1; # use difficulty XXX + } + my $time = $event->{'time'} - $self->{'questionsTime'}->{$event->{'channel'}}; + my $total = $self->score($event, $who, $score); + $self->debug("Answered by: $who"); + $self->say($event, "$who got the right answer in $time seconds (+$score points giving $total). The answer was: $answer"); + $self->saveConfig(); + $self->{'questionsTime'}->{$event->{'channel'}} = 0; + $self->schedule($event, \$self->{'askDelay'}, 1, 'ask'); + } + } +} + +sub quizTip { # called by timer, only during game + my $self = shift; + my($event) = @_; + my $tip; + if (defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tips'}) and + $self->{'tip'}->{$event->{'channel'}} < @{$self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tips'}}) { + $tip = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tips'}->[$self->{'tip'}->{$event->{'channel'}}]; + } else { + if (not defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tips'}) and + (not defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tipCycle'}) or + $self->{'tip'}->{$event->{'channel'}} < $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tipCycle'})) { + $tip = $self->generateTip($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'}, + $self->{'tip'}->{$event->{'channel'}}, + $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tipCycle'}); + } + } + if (defined($tip)) { + $self->{'tip'}->{$event->{'channel'}} += 1; + $self->say($event, "Hint: $tip..."); + $self->saveConfig(); + return 1; + } else { + return 0; + } +} + +sub quizPause { # called by user + my $self = shift; + my($event) = @_; + if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress + if (not $self->{'paused'}->{$event->{'channel'}}) { # not paused + # pause game + $self->{'paused'}->{$event->{'channel'}} = 1; + $self->saveConfig(); + $self->say($event, "Quiz paused. Use $self->{'prefix'}resume to continue."); + } else { + $self->say($event, "Quiz already paused. Use $self->{'prefix'}resume to continue."); + } + } else { + $self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one."); + } +} + +sub quizResume { # called by user + my $self = shift; + my($event) = @_; + if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress + if ($self->{'paused'}->{$event->{'channel'}}) { # paused + # unpause game + $self->{'paused'}->{$event->{'channel'}} = 0; + $self->saveConfig(); + $self->say($event, "Quiz resumed. Question: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'question'}"); + } else { + $self->say($event, "Quiz already in progress. Use $self->{'prefix'}repeat to be told the question again, and $self->{'prefix'}pause to pause the quiz."); + } + } else { + $self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one."); + } +} + +sub quizRepeat { # called by user + my $self = shift; + my($event) = @_; + if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress + $self->say($event, "Question: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'question'}"); + } else { + $self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one."); + } +} + +sub quizEnd { # called by question and user + my $self = shift; + my($event) = @_; + if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { + # get the scores for each player that player in the game + my @scores = $self->getScores($event, sub { + my($event, $score) = @_; + # XXX this means that a user has to be there till the end + # of the game to get points added to his high score table. + # XXX it also means a user can get better simply by + # playing more games. + $self->{'totalScores'}->{$score->[1]} += $score->[2]; + }); + # print them + if (@scores) { + local $" = ', '; + $self->say($event, "Quiz Ended. Scores: @scores"); + } else { + $self->say($event, 'Quiz Ended. No questions were answered.'); + } + delete($self->{'currentQuestion'}->{$event->{'channel'}}); + $self->saveConfig(); + } +} + +sub quizScores { # called by user + my $self = shift; + my($event) = @_; + if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { + # get the scores for each player that player in the game + my @scores = $self->getScores($event, sub {}); + # get other stats + my $remaining = ''; + if ($self->{'remainingQuestions'}->{$event->{'channel'}} > 0) { + $remaining = " There are $self->{'remainingQuestions'}->{$event->{'channel'}} more questions to go."; + } + # print them + if (@scores) { + local $" = ', '; + $self->say($event, "Current Scores: @scores$remaining"); + } else { + $self->say($event, "No questions have been answered yet.$remaining"); + } + } else { + $self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one."); + } +} + +sub quizSkip { # called by user + my $self = shift; + my($event) = @_; + if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress + if (not $self->{'paused'}->{$event->{'channel'}}) { # not paused + if ($self->{'questionsTime'}->{$event->{'channel'}}) { # question asked and not answered + # XXX should only let players skip (at the moment even someone who has not tried to answer any question can skip) + # Get number of users who have said !skip (and set current user) + my(undef, $skipCount) = $self->stringHash(\$self->{'skip'}->{$event->{'channel'}}, $event->{'from'}, 1); + # Get number of users who are playing + my $playerCount = $self->getActivePlayers($event); + if ($skipCount >= $playerCount * $self->{'skipFractionRequired'}) { + my $answer = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'}; + $self->say($event, "$skipCount players wanted to skip. Moving to next question. The answer was: $answer"); + $self->quizQuestion($event); + } + } # else drop it + } else { + $self->say($event, "Quiz paused. Use $self->{'prefix'}resume to continue the quiz."); + } + } else { + $self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one."); + } +} + +sub pickQuestion { + my $self = shift; + my($event) = @_; + $self->{'questionIndex'} += 1 + $event->{'time'} % $self->{'skipMargin'}; + $self->{'questionIndex'} %= @{$self->{'questions'}}; + return $self->{'questionIndex'}; +} + +sub score { + my $self = shift; + my($event, $who, $score) = @_; + if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { + my($score, undef) = $self->stringHash(\$self->{'quizScores'}->{$event->{'channel'}}, $who, $score, 1); + $self->saveConfig(); + return $score; + } +} + +sub getScores { + my $self = shift; + my($event, $perUser) = @_; + my @scores; + foreach my $player ($self->getActivePlayers($event)) { + my($score, undef) = $self->stringHash(\$self->{'quizScores'}->{$event->{'channel'}}, $player); + if (defined($score)) { + push(@scores, ["$player: $score", $player, $score]); + } + } + # sort the scores by number + @scores = sort {$a->[2] <=> $b->[2]} @scores; + foreach my $score (@scores) { + &$perUser($event, $score); + $score = $score->[0]; + } + return @scores; +} + +sub generateTip { + my $self = shift; + my($answer, $tipID, $maxTips) = @_; + if (length($answer) > $tipID+1) { + return substr($answer, 0, $tipID+1); + } else { + return undef; + } +} + +sub getActivePlayers { + my $self = shift; + my($event) = @_; + my @players; + if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress + my $start = $self->{'quizTime'}->{$event->{'channel'}}; + my %players = split(' ', $self->{'players'}->{$event->{'channel'}}); + foreach my $player (keys %players) { + if ($players{$player} > $start) { + push(@players, $player); + } + } + } + return @players; +} + +sub stringHash { + my $self = shift; + my($string, $key, $value, $multiple) = @_; + my %hash = split(' ', $$string); + my @hash; + if (defined($value)) { + if (defined($multiple)) { + $hash{$key} = $hash{$key} * $multiple + $value; + } else { + $hash{$key} = $value; + } + local $" = ' '; + @hash = %hash; + $$string = "@hash"; + } else { + @hash = %hash; + } + return ($hash{$key}, scalar(@hash) / 2); +} diff --git a/BotModules/Quotes.bm b/BotModules/Quotes.bm new file mode 100644 index 0000000..0ddaac5 --- /dev/null +++ b/BotModules/Quotes.bm @@ -0,0 +1,651 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Quotes Module # +################################ +# Based on a request from Nortis http://www.blomstereng.org/ + +# XXX need to support multiple quote servers: +# !discworld + +package BotModules::Quotes; +use vars qw(@ISA); +@ISA = qw(BotModules); +use Fcntl; +use DBI; +1; + +# This uses a number of MySQL-specific features. + +sub Help { + my $self = shift; + my ($event) = @_; + my $help = { + '' => 'A module to manage quotes.', + 'quote' => 'Search for a quote, or return a random one. To search for a quote, you must specify search parameters, see the help entries for id, text, author, note, match. Otherwise, a random quote is returned.', + 'match' => 'If there are multiple matches, you can specify which match you want by appending the match number to your search terms, for example \'quote author=blake 4\' will return the fourth quote whose author is \'blake\'. The default is 1.', + 'id' => 'To search for a quote by its numeric ID, append the ID to the \'quote\' command. For example, \'quote 42\'. If you specify other search parameters, this will return the relevant match from that list, see the help entry for \'match\'.', + 'text' => 'To search for a quote by text, append \'text="foo"\' to the \'quote\' command. For example, \'quote text="meaning of life"\' or \'quote text=life\'. You could also just say \'quote hello world\' or \'quote hello world 2\' (to get the second match).', + 'author' => 'To search for a quote by author or attribution, append \'author="foo"\' to the \'quote\' command. For example, \'quote author="Douglas Adams"\' or \'quote author=asimov\'.', + 'note' => 'To search for a quote by text in its note, append \'note="foo"\' to the \'quote\' command. For example, \'quote note=""\' or \'quote author=asimov\'.', + 'quotelast' => 'Returns the last quote added. Append a numer to return the nth but last quote added, as in \'lastquote 2\'.', + 'status' => 'Prints some information about the status of the quotes database.', + }; + if ($self->canAdd($event)) { + $help->{'addquote'} = 'Add a quote to the database. The format is \'addquote quote - author (note)\'. The \'(note)\' part may be omitted. The author may not.'; + } + if ($self->canDelete($event)) { + $help->{'delquote'} = 'Delete a quote from the database. The format is \'delquote id\'.'; + } + if ($self->canEdit($event)) { + $help->{'editquote'} = 'Edit a quote in the database. The format is \'editquote id quote - author (note)\' which will update the quote with that ID, using the new text, author, etc, in the same way as for \'addquote\'.'; + } + if ($self->isAdmin($event)) { + $help->{'setupquotes'} = 'Configure the quotes database connection. Format: \'setupquotes dbhost.example.com:dbport dbname dbuser dbpass\'. Port is optional (default 3306). You can also just say \'setupquotes\' to check on the configuration. See also \'help quote-defaults\'.'; + $help->{'quote-defaults'} = 'To get the default configuration, use \'setupquotes mozbotquotes.damowmow.com:3306 mozbotquotes mozbotquotes mozbotquotes\'.'; + } + return $help; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['prefix', 1, 1, '!'], # the prefix to put before the undirected quote commands + ['dbhost', 1, 1, 'mozbotquotes.damowmow.com'], + ['dbport', 1, 1, '3306'], + ['dbname', 1, 1, 'mozbotquotes'], + ['dbuser', 1, 1, 'mozbotquotes'], + ['dbpass', 1, 1, 'mozbotquotes'], + ['tableName', 1, 1, 'quotes'], + ['usersAdd', 1, 1, []], + ['usersDelete', 1, 1, []], + ['usersEdit', 1, 1, []], + ); +} + +# call this at the top of any function that uses tableName +sub sanitiseTableName { + my $self = shift; + $self->{tableName} =~ s/[^a-zA-Z]//gos; + if (length($self->{tableName}) < 1) { + $self->{tableName} = 'quotes'; + } + $self->saveConfig(); +} + +sub canAdd { + my $self = shift; + return $self->checkRights('Add', @_); +} + +sub canDelete { + my $self = shift; + return $self->checkRights('Delete', @_); +} + +sub canEdit { + my $self = shift; + return $self->checkRights('Edit', @_); +} + +sub checkRights { + my $self = shift; + my ($right, $event) = @_; + return 1 if $self->isAdmin($event); + foreach my $user (@{$self->{"users$right"}}) { + return 1 if $user eq $event->{userName}; + } + return 0; +} + +sub Schedule { + my $self = shift; + my ($event) = @_; + unless ($self->dbconnect()) { + $self->say($event, "Failed to connect to quotes database: $self->{dberror}"); + $self->say($event, 'Use the \'setupquotes\' command to configure the database.'); + } + $self->SUPER::Schedule($event); +} + +sub dbconnect { + my $self = shift; + eval { + $self->{dbhandle} = + DBI->connect("DBI:mysql:$self->{dbname}:$self->{dbhost}:$self->{dbport}", + $self->{dbuser}, $self->{dbpass}, + {RaiseError => 1, PrintError => 1, AutoCommit => 1, Taint => 0}); + }; + if (not $self->{dbhandle}) { + $self->{dberror} = $@; + $self->debug("Failed to connect to quotes database: $self->{dberror}"); + return 0; + } + return 1; +} + +sub dbdisconnect { + my $self = shift; + my ($event) = @_; + if ($self->{dbhandle}) { + $self->{dbhandle}->disconnect(); + $self->{dbhandle} = undef; + } +} + +sub Unload { + my $self = shift; + my ($event) = @_; + $self->dbdisconnect($event); +} + +sub dbcheckconfig { + my $self = shift; + my ($event) = @_; + + $self->sanitiseTableName(); + + # count tables + my $tables = $self->{dbhandle}->selectall_arrayref('SHOW TABLES'); + my $wantedTable = undef; + $tables = [] unless defined $tables; + foreach (@$tables) { + $_ = $_->[0]; + } + if (@$tables == 1) { + # if only one, assume that's the one we want to use + $wantedTable = $tables->[0]; + } else { + # otherwise, assume the name is 'quotes' + $wantedTable = $self->{tableName} || 'quotes'; + } + + # check table exists + $self->{dbtables} = $tables; + foreach my $table (@$tables) { + if (lc $table eq lc $wantedTable) { + $self->{tableName} = $table; + $self->saveConfig(); + return 1; + } + } + return 0; +} + +sub dbcreatetables { + my $self = shift; + my ($event) = @_; + + $self->sanitiseTableName(); + + # create table + eval { + $self->{dbhandle}->do("CREATE TABLE IF NOT EXISTS $self->{tableName} ( + id INTEGER UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, + quote TEXT NOT NULL DEFAULT '', + author VARCHAR(100) NOT NULL DEFAULT 'Unknown', + date DATETIME NOT NULL DEFAULT 0, + note TEXT NULL DEFAULT NULL, + shown INTEGER UNSIGNED NOT NULL DEFAULT 0, + age INTEGER UNSIGNED NOT NULL DEFAULT 1, + INDEX (author), INDEX(shown), INDEX(age) + )"); + }; + if ($@) { + $self->{dberror} = $@; + $self->debug("Failed to create quotes table: $self->{dberror}"); + return 0; + } + return 1; +} + +sub verifyConnection { + my $self = shift; + my ($event) = @_; + if ($self->dbconnect()) { + if (not $self->dbcheckconfig($event)) { + if (@{$self->{dbtables}}) { + local $" = '\', \''; + $self->say($event, "Connected, but I there were several tables and I wasn't sure which to use. The tables in this database are: '@{$self->{dbtables}}'"); + $self->say($event, "To make me create a new table (called '$self->{tableName}') use 'setupquotes table'. To make me use a particular table from the list above, use 'setupquotes use table $self->{dbtables}->[0]' (or whatever table you want to use)."); + } else { + $self->say($event, "Connected, but I couldn't find a quotes table in the database. If you want me to create a table (named '$self->{tableName}') for you, use 'setupquotes tables'. To create one with a specific name, e.g. 'mozQuotes', use 'setupquotes tables mozQuotes'."); + } + } else { + $self->say($event, "Connected (using table '$self->{tableName}')."); + } + } else { + $self->say($event, "Failed to connect to quotes database: $self->{dberror}"); + } +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*set\s*up\s*quotes?(?:\s+(.*?))?\s*$/osi and $self->isAdmin($event)) { + my $data = $1; + if ($data =~ m/^(\S+?)(?::(\S+))?\s+(\S+)\s+(\S+)\s+(\S+)$/osi) { + $self->dbdisconnect($event); + $self->{'dbhost'} = $1; + $self->{'dbport'} = $2 || 3306; + $self->{'dbname'} = $3; + $self->{'dbuser'} = $4; + $self->{'dbpass'} = $5; + $self->saveConfig(); + $self->say($event, "Ok, trying to connect..."); + $self->verifyConnection($event); + } elsif ($data =~ m/^tables?(?:\s+(\S+))?$/osi) { + if ($self->{dbhandle}) { + if ($1) { + $self->{tableName} = $1; + $self->sanitiseTableName(); + } + if ($self->dbcreatetables($event)) { + $self->say($event, "Connected (using table '$self->{tableName}')."); + } else { + $self->say($event, "Failed to create the table ('$self->{dberror}') -- make sure you have the right permissions set up."); + } + } else { + $self->say($event, 'I haven\'t yet successfully connected to a database. Please select a MySQL server to connect to, e.g. \'setupquotes mozbotquotes.damowmow.com:3306 mozbotquotes mozbotquotes mozbotquotes\''); + } + } elsif ($data =~ m/^use\s*tables?\s+(\S+)$/osi) { + $self->{tableName} = $1; + $self->sanitiseTableName(); + if ($self->{dbhandle}) { + if (not $self->dbcheckconfig($event)) { + if (@{$self->{dbtables}}) { + local $" = '\', \''; + $self->say($event, "The table you requested, '$self->{tableName}', doesn't exist in this database. The tables in this database are: '@{$self->{dbtables}}'"); + $self->say($event, "To make me create this new table (called '$self->{tableName}') use 'setupquotes table'. To make me use one of the tables from the list above, use 'setupquotes use table $self->{dbtables}->[0]' (or whatever table you want to use)."); + } else { + $self->say($event, "The table you requested, '$self->{tableName}', doesn't exist in this database. In fact this database has no tables at all. If you want me to create a table (called '$self->{tableName}') for you, use 'setupquotes tables'."); + } + } else { + $self->say($event, "Connected (using table '$self->{tableName}')."); + } + } else { + $self->say($event, 'Noted. However, I haven\'t yet successfully connected to a database, so this is not enough to complete configuration.'); + $self->say($event, 'Please select a MySQL server to connect to, e.g. \'setupquotes mozbotquotes.damowmow.com:3306 mozbotquotes mozbotquotes mozbotquotes\''); + } + } elsif ($data =~ m/^\s*$/osi) { + $self->dbdisconnect($event); + $self->say($event, "Checking connection..."); + $self->verifyConnection($event); + } else { + $self->say($event, 'The format is: \'setupquotes host.domain.tld:port database username password\' (\':port\' is optional, defaults to 3306) or just \'setupquotes\' to check the configuration.'); + } + } elsif ($message =~ /^\s*quote(?:\s+(.+?))?\s*$/osi) { + $self->getQuote($event, $1); + } elsif ($message =~ /^\s*(?:quotelast|last\s*quote)(?:\s+(.+?))?\s*$/osi) { + $self->getLastQuote($event, $1); + } elsif ($message =~ /^\s*add\s*quote(?:\s+(.+?))?\s*$/osi) { + $self->addQuote($event, $1); + } elsif ($message =~ /^\s*(?:delete|del|remove|rem)?\s*quote(?:\s+(.+?))?\s*$/osi) { + $self->deleteQuote($event, $1); + } elsif ($message =~ /^\s*edit\s*quote(?:\s+(.+?))?\s*$/osi) { + $self->editQuote($event, $1); + } elsif ($message =~ /^\s*(?:quotes?\s*)?status\s*$/osi) { + $self->printStatus($event); + } elsif ($self->checkBangCommands(@_)) { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Heard { + my $self = shift; + if ($self->checkBangCommands(@_)) { + return $self->SUPER::Heard(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub checkBangCommands { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^$self->{prefix}quote(?:\s+(.+?))?\s*$/si) { + $self->getQuote($event, $1); + } elsif ($message =~ /^$self->{prefix}(?:quotelast|lastquote)(?:\s+(.+?))?\s*$/si) { + $self->getLastQuote($event, $1); + } elsif ($message =~ /^$self->{prefix}addquote(?:\s+(.+?))?\s*$/si) { + $self->addQuote($event, $1); + } elsif ($message =~ /^$self->{prefix}delquote(?:\s+(.+?))?\s*$/si) { + $self->deleteQuote($event, $1); + } elsif ($message =~ /^$self->{prefix}editquote(?:\s+(.+?))?\s*$/si) { + $self->editQuote($event, $1); + } else { + return 1; # nope + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub markRead { + my $self = shift; + my ($id) = @_; + eval { + $self->{dbhandle}->do("UPDATE $self->{tableName} SET shown = shown + 1 WHERE id = ?", undef, $id); + $self->{dbhandle}->do("UPDATE $self->{tableName} SET age = age + 1"); + }; + # ignore errors (don't have to worry about timeouts, this is only + # ever done after recent db access) +} + +sub getQuote { + my $self = shift; + my ($event, $data) = @_; + if (not $self->{dbhandle}) { + $self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry."); + return; + } + if (defined $data) { + if ($data =~ m/^\s*([0-9]+)\s*$/os) { + $self->getQuoteById($event, $1); + } else { + $self->searchQuote($event, $data); + } + } else { + $self->randomQuote($event); + } +} + +sub randomQuoteInternal { + my $self = shift; + my ($event) = @_; + my($id, $quote, $author, $note); + return 0 unless $self->attempt($event, sub { ($id, $quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT id, quote, author, note, shown/age AS freq FROM $self->{tableName} ORDER BY freq, RAND() LIMIT 1", undef); }, 'read from the database for some reason', 'read a random quote from'); + if (defined $quote) { + $self->markRead($id); + $note = defined $note ? " ($note)" : ''; + $self->say($event, "Quote $id: $quote - $author$note"); + return 0; + } + return 1; # try again +} + +sub randomQuote { + my $self = shift; + my ($event) = @_; + $self->sanitiseTableName(); + if ($self->randomQuoteInternal($event)) { + # no quotes? + # weird... let's see if reconnecting helps + if ($self->dbconnect()) { + if ($self->randomQuoteInternal($event)) { + # there must really be no quotes + $self->say($event, "$event->{from}: There are no quotes in the database yet."); + } # else ok + } else { + $self->say($event, "$event->{from}: I'm sorry, I can't reach the database right now."); + $self->tellAdmin($event, "While trying to get a random quote from the database, I found no quotes, so I tried reconnecting to the database, but it said '$self->{dberror}'!"); + } + } # else ok +} + +sub getQuoteById { + my $self = shift; + my ($event, $id, $action) = @_; + $self->sanitiseTableName(); + my($quote, $author, $note); + return unless $self->attempt($event, sub { + ($quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT quote, author, note FROM $self->{tableName} WHERE id=?", undef, $id); + }, 'read from the database for some reason', 'read a quote from'); + if (defined $quote) { + $self->markRead($id); + $note = defined $note ? " ($note)" : ''; + $action = defined $action ? "$action: " : ''; + $self->say($event, "\u${action}Quote $id: $quote - $author$note"); + } elsif (defined $action) { + return 0; + } else { + $self->say($event, "$event->{from}: There is no quote with ID $id as far as I can tell."); + } + return 1; +} + +sub searchQuote { + my $self = shift; + my ($event, $data) = @_; + # [author=""] [text=""] [note=""] [text] [n] + my (@columns, @values); + my $skip = 0; + while (length $data) { + if ($data =~ s/^\s*text="([^"]*)"(?:\s|\z)//osi or + $data =~ s/^\s*text='([^']*)'(?:\s|\z)//osi or + $data =~ s/^\s*text=(\S+)(?:\s|\z)//osi) { + push(@columns, 'quote LIKE ?'); + push(@values, "%$1%"); + } elsif ($data =~ s/^\s*author="([^"]*)"(?:\s|\z)//osi or + $data =~ s/^\s*author='([^']*)'(?:\s|\z)//osi or + $data =~ s/^\s*author=(\S+)(?:\s|\z)//osi) { + push(@columns, 'author LIKE ?'); + push(@values, "%$1%"); + } elsif ($data =~ s/^\s*note="([^"]*)"(?:\s|\z)//osi or + $data =~ s/^\s*note='([^']*)'(?:\s|\z)//osi or + $data =~ s/^\s*note=(\S+)(?:\s|\z)//osi) { + push(@columns, 'note LIKE ?'); + push(@values, "%$1%"); + } elsif ($data =~ s/^\s*(\w+)="([^"]*)"(?:\s|\z)//osi or + $data =~ s/^\s*(\w+)='([^']*)'(?:\s|\z)//osi or + $data =~ s/^\s*(\w+)=(\S+)(?:\s|\z)//osi) { + $self->say($event, "$event->{from}: I don't know how to search for '$1'. The valid search types are 'author', 'note', and 'text'. See the help entry for 'quote' for more information on the quote searching syntax."); + return; + } elsif ($data =~ s/^\s*([0-9]+)\s*$//osi) { + $skip = $1 - 1; + } elsif ($data =~ s/^\s*"([^"]+)"(?:\s|\z)//osi or + $data =~ s/^\s*'([^']+)'(?:\s|\z)//osi or + $data =~ s/^\s*(\S+)(?:\s|\z)//osi) { + push(@columns, 'quote LIKE ?'); + push(@values, "%$1%"); + } else { + # wtf + $self->say($event, "$event->{from}: I didn't quite understand what you were looking for ('$data'?). See the help entry for 'quote' for more information on the quote searching syntax."); + return; + } + } + + $self->sanitiseTableName(); + my($id, $count, $quote, $author, $note); + return unless $self->attempt($event, sub { + local $" = ' AND '; + ($count) = $self->{dbhandle}->selectrow_array("SELECT COUNT(*) FROM $self->{tableName} WHERE @columns", undef, @values); + ($id, $quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT id, quote, author, note FROM $self->{tableName} WHERE @columns LIMIT $skip,1", undef, @values); + }, 'read from the database for some reason', 'search for a quote in'); + if (defined $quote) { + $self->markRead($id); + $note = defined $note ? " ($note)" : ''; + my $n = $skip + 1; + $count = "about $n" if $count < $n; # sanitise output in case of race condition + my $match = $count == 1 ? 'only match' : "match $n of $count"; + $self->say($event, "Quote $id ($match): $quote - $author$note"); + } else { + $self->say($event, "$event->{from}: No matching quotes found."); + } +} + +sub getLastQuote { + my $self = shift; + my ($event, $data) = @_; + if (not $self->{dbhandle}) { + $self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry."); + return; + } + if ($data !~ m/^\s*([0-9]+)?\s*$/os) { + $self->say($event, "$event->{from}: The syntax is 'lastquote 2', where 2 is the number of the quote to show (counting from the end). You can omit the number to get the last quote added."); + return; + } + my $skip = ($1 || 1) - 1; + $self->sanitiseTableName(); + my($id, $quote, $author, $note); + return unless $self->attempt($event, sub { + ($id, $quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT id, quote, author, note FROM $self->{tableName} ORDER BY id DESC LIMIT $skip,1", undef); + }, 'read from the database for some reason', 'read the last few quotes from the database'); + if (defined $quote) { + $self->markRead($id); + $note = defined $note ? " ($note)" : ''; + $self->say($event, "Quote $id: $quote - $author$note"); + } else { + $self->say($event, "$event->{from}: There are no quotes in the database yet."); + } +} + +sub addQuote { + my $self = shift; + my ($event, $data) = @_; + if (not $self->canAdd($event)) { + $self->say($event, "$event->{from}: You are not allowed to add quotes, sorry."); + return; + } + if (not $self->{dbhandle}) { + $self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry."); + return; + } + # quote - author (note) + if ($data =~ m/^ (.+\S) + \s* - \s* + (.+?) + (?:\s+\((.+)\))? + $/osx) { + my $quote = $1; + my $author = $2; + my $note = $3; + # insert data + $self->sanitiseTableName(); + return unless $self->attempt($event, sub { + $self->{dbhandle}->do("INSERT INTO $self->{tableName} SET + quote = ?, author = ?, date = NOW(), note = ?", + undef, $quote, $author, $note); + my $id = $self->{dbhandle}->{mysql_insertid}; + if (not $self->getQuoteById($event, $id, 'inserted')) { + $self->say($event, "$event->{from}: Your quote disappeared after I inserted it into the database. You may wish to speak to the other people who have access to the quotes database about this... :-)"); + } + }, 'seem to add that quote to the database.', 'add a quote to'); + } else { + $self->say($event, "$event->{from}: The syntax for adding a quote is 'quote - author' or 'quote - author (note)'."); + } +} + +sub deleteQuote { + my $self = shift; + my ($event, $data) = @_; + if (not $self->canDelete($event)) { + $self->say($event, "$event->{from}: You are not allowed to delete quotes, sorry."); + return; + } + if (not $self->{dbhandle}) { + $self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry."); + return; + } + if ($data !~ m/^\s*([0-9]+)\s*$/os) { + $self->say($event, "$event->{from}: The syntax is 'delquote 5', where 5 is the id of the quote to delete."); + return; + } + my $id = $1; + $self->sanitiseTableName(); + my($quote, $author, $note); + return unless $self->attempt($event, sub { + ($quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT quote, author, note FROM $self->{tableName} WHERE ID=?", undef, $id); + }, 'read from the database for some reason', 'read a quote to delete from'); + if (defined $quote) { + return unless $self->attempt($event, sub { + $self->{dbhandle}->do("DELETE FROM $self->{tableName} WHERE ID=?", undef, $id); + }, 'delete from the database. Maybe I don\'t have enough privileges on the database server', 'delete from'); + $note = defined $note ? " ($note)" : ''; + $self->say($event, "Deleted: Quote $id: $quote - $author$note"); + } else { + $self->say($event, "$event->{from}: There is no quote with ID $id as far as I can tell."); + } +} + +sub editQuote { + my $self = shift; + my ($event, $data) = @_; + if (not $self->canEdit($event)) { + $self->say($event, "$event->{from}: You are not allowed to edit quotes, sorry."); + return; + } + if (not $self->{dbhandle}) { + $self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry."); + return; + } + if ($data =~ m/^ ([0-9]+) \s+ + (.+\S) + \s* - \s* + (.+?) + (?:\s+\((.+)\))? + $/osx) { + my $id = $1; + my $quote = $2; + my $author = $3; + my $note = $4; + # insert data + $self->sanitiseTableName(); + return unless $self->attempt($event, sub { + $self->{dbhandle}->do("UPDATE $self->{tableName} SET + quote = ?, author = ?, note = ? + WHERE id = ?", + undef, $quote, $author, $note, $id); + if (not $self->getQuoteById($event, $id, 'edited')) { + $self->say($event, "$event->{from}: I couldn't find a quote with ID $id."); + } + }, 'seem to edit that quote', 'edit a quote in'); + } else { + $self->say($event, "$event->{from}: The syntax for editing a quote is 'id quote - author' or 'id quote - author (note)', much like for adding a quote but with the id of the quote to edit at the start."); + } +} + +sub printStatus { + my $self = shift; + my ($event) = @_; + if (not $self->{dbhandle}) { + $self->say($event, "$event->{from}: No connection could be established to the quotes datbase."); + return; + } + $self->sanitiseTableName(); + my ($quotes, $sources, $shown, $id) = @_; + return unless $self->attempt($event, sub { + ($quotes, $sources, $shown) = $self->{dbhandle}->selectrow_array("SELECT COUNT(*), COUNT(DISTINCT author), SUM(shown) FROM $self->{tableName}"); + ($id) = $self->{dbhandle}->selectrow_array("SELECT id, shown/age AS freq FROM $self->{tableName} ORDER BY freq, shown LIMIT 1"); + }, 'connect to the quotes database', 'obtain statistics of'); + if ($quotes) { + my $s1 = $quotes == 1 ? '' : 's'; + my $s2 = $sources == 1 ? '' : 's'; + my $s3 = $shown == 1 ? '' : 's'; + $self->say($event, "$event->{from}: The database contains $quotes quote$s1 attributed to $sources source$s2. I have shown these quotes $shown time$s3 in total. The most popular quote (relatively speaking) is quote ID $id."); + } else { + $self->say($event, "$event->{from}: The database contains 0 quotes."); + } +} + +sub attempt { + my $self = shift; + my($event, $sub, $action1, $action2) = @_; + eval { &$sub }; + if ($@) { + chomp $@; + my $error = $@; + # A common error is: + # "DBD::mysql::db selectrow_array failed: MySQL server has + # gone away at (eval 34) line 357." + # ...so we try to reconnect and do it again + if ($self->dbconnect()) { + eval { &$sub }; + if ($@) { + chomp $@; + $self->say($event, "$event->{from}: I'm sorry, I can't $action1."); + if ($@ eq $error) { + $self->tellAdmin($event, "While trying to $action2 the database, I got '$@'. I tried reconnecting but that didn't help."); + } else { + $self->tellAdmin($event, "While trying to $action2 the database, I got '$error'. Then I tried reconnecting and it worked but when I tried to $action2 the database a second time, it said '$@'."); + } + return 0; + } + } else { + $self->say($event, "$event->{from}: I'm sorry, I can't $action1."); + $self->tellAdmin($event, "While trying to $action2 the database, I got '$error', so I tried reconnecting to the database but I got '$self->{dberror}'. Help!"); + return 0; + } + } + return 1; +} diff --git a/BotModules/RDF.bm b/BotModules/RDF.bm new file mode 100644 index 0000000..35629bc --- /dev/null +++ b/BotModules/RDF.bm @@ -0,0 +1,268 @@ +################################ +# RDF Module # +################################ +# this is really an RSS module, not an RDF module. +# but oh well. + +package BotModules::RDF; +use XML::RSS; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['sites', 1, 1, {}], + ['updateDelay', 1, 1, 600], + ['preferredLineLength', 1, 1, 80], + ['maxInChannel', 1, 1, 5], + ['maxLines', 1, 1, 20], + ['trimTitles', 1, 1, '0'], + ['data', 0, 0, {}], # data -> uri -> (title, link, last, items -> uri) + ['mutes', 1, 1, {}], # uri -> "channel channel channel" + ); +} + +# Schedule - called when bot connects to a server, to install any schedulers +# use $self->schedule($event, $delay, $times, $data) +# where $times is 1 for a single event, -1 for recurring events, +# and a +ve number for an event that occurs that many times. +sub Schedule { + my $self = shift; + my ($event) = @_; + $self->schedule($event, \$self->{'updateDelay'}, -1, 'rdf'); + $self->SUPER::Schedule($event); +} + +sub Help { + my $self = shift; + my ($event) = @_; + my %commands; + if ($self->isAdmin($event)) { + $commands{''} = "The RDF module monitors various websites. Add new RDF channels to the 'sites' hash. Duplicates with different nicknames are fine. For example, \"vars $self->{'_name'} sites '+|slashdot|http://...'\" and \"vars $self->{'_name'} sites '+|/.|http://...'\" is fine. To remove a site from the RDF 'sites' hash, use this syntax \"vars $self->{_name} sites '-slashdot'"; + $commands{'mute'} = 'Disable reporting of a site in a channel. (Only does something if the given site exists.) Syntax: mute in '; + $commands{'unmute'} = 'Enable reporting of a site in a channel. By default, sites are reported in all channels that the module is active in. Syntax: unmute in '; + } else { + $commands{''} = 'The RDF module monitors various websites.'; + } + foreach my $site (keys(%{$self->{'sites'}})) { + if ($self->{'data'}->{$self->{'sites'}->{$site}}) { + $commands{$site} = "Reports the headlines listed in $self->{'data'}->{$self->{'sites'}->{$site}}->{'title'}"; + + # -- #mozilla was here -- + # anyway, $self->{'data'}->{$self->{'sites'}->{$site}}->{'title'} is + # another nice piece of perl (embedded in a quoted string in this case) + # yeah, that's a bit more familiar + # Oooh, nice one + # Reminds me of Java, a bit :-) + # Without all the casting about from Object to Hashtable + # all this, BTW, is from the RDF module (the one that mozbot uses to + # report changes in mozillazine and so on) + # I still tend to comment these things a bit just for maintainability + # by others who might not wish to do mental gymnastics :) + # :-) + + } else { + $commands{$site} = "Reports the headlines listed in $self->{'sites'}->{$site}"; + } + + } + return \%commands; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + foreach my $site (keys(%{$self->{'sites'}})) { + if ($message =~ /^\s*(\Q$site\E)\s*$/si) { + $self->GetSite($event, $1, 'request'); + return 0; # dealt with it... + } + } + if ($self->isAdmin($event)) { + if ($message =~ /^\s*mute\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) { + my $site = $1 eq 'RDF' ? '' : $self->{'sites'}->{$1}; + my $siteName = $site eq '' ? 'all sites' : $site; + if (defined($site)) { + $self->{'mutes'}->{$site} .= " $2"; + $self->saveConfig(); + $self->say($event, "$event->{'from'}: RDF notifications for $siteName muted in channel $2."); + } else { + # can't say this, other modules might recognise it: $self->say($event, "$event->{'from'}: I don't know about any '$1' site..."); + } + } elsif ($message =~ /^\s*unmute\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) { + my $site = $1 eq 'RDF' ? '' : $self->{'sites'}->{$1}; + my $siteName = $site eq '' ? 'all sites' : $site; + if (defined($site)) { + my %mutedChannels = map { lc($_) => 1 } split(/ /o, $self->{'mutes'}->{$site}); + delete($mutedChannels{lc($2)}); # get rid of any mentions of that channel + $self->{'mutes'}->{$site} = join(' ', keys(%mutedChannels)); + $self->saveConfig(); + $self->say($event, "$event->{'from'}: RDF notifications for $siteName resumed in channel $2."); + } else { + # can't say this, other modules might recognise it: $self->say($event, "$event->{'from'}: I don't know about any '$1' site..."); + } + } else { + return $self->SUPER::Told(@_); + } + } else { + return $self->SUPER::Told(@_); + } + return 0; +} + +sub GetSite { + my $self = shift; + my ($event, $site, $intent) = @_; + if (defined($self->{'sites'}->{$site})) { + my $uri = $self->{'sites'}->{$site}; + $self->getURI($event, $uri, $intent); + } else { + # XXX + } +} + +sub GotURI { + my $self = shift; + my ($event, $uri, $output, $intent) = @_; + + $self->{'data'}->{$uri}->{'ready'} = defined($self->{'data'}->{$uri}); + + if ($output) { + + # last update stamp + my $last = $event->{'time'}; + $self->{'data'}->{$uri}->{'last'} = $last; + + # Parse It + my $rss = XML::RSS->new(); + eval { $rss->parse($output) }; + if ($@) { + $self->debug("$uri is not a valid RSS file"); + if ($intent eq 'request') { + $self->say($event, "$event->{'from'}: Dude, the file is not valid RSS! ($uri)"); + } + return; + } + + # Set Link and Title + $self->{data}->{$uri}->{'link'} = $rss->{'channel'}->{'link'}; + $self->{data}->{$uri}->{'title'} = $rss->{'channel'}->{'title'}; + + foreach my $item (@{$rss->{'items'}}) { + unless (($item->{title} =~ /^last update/osi) || + (defined($self->{'data'}->{$uri}->{'items'}->{$item->{'title'}}))) { + $self->{'data'}->{$uri}->{'items'}->{$item->{'title'}} = $last; + } + } + + $self->ReportDiffs($event, $uri, $intent); + if ($intent eq 'request') { + $self->ReportAll($event, $uri); + } + + } else { + + if ($intent eq 'request') { + $self->say($event, "$event->{'from'}: Dude, the file was empty! ($uri)"); + } + + } + +} + +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + if ($data[0] eq 'rdf') { + my %sites = map { $_ => 1 } values(%{$self->{'sites'}}); + foreach (keys(%sites)) { + $self->getURI($event, $_, 'update'); + } + } else { + $self->SUPER::Scheduled($event, @data); + } +} + +sub ReportDiffs { + my $self = shift; + my ($event, $uri, $request) = @_; + return unless $self->{'data'}->{$uri}->{'ready'}; + my $last = $self->{'data'}->{$uri}->{'last'}; + my @output; + foreach (keys(%{$self->{'data'}->{$uri}->{'items'}})) { + push(@output, $_) if ($self->{'data'}->{$uri}->{'items'}->{$_} == $last); + } + + # -- #mrt was here -- + # Friday's security advisories -- The first stable + # Xen release -- Linux Gazette #95 + # KDE Under The Microscope -- Additional OpenSSL info + # wtf + # Just appeared in jbisbee.com - + # http://www.jbisbee.com/ : PoCo::RSS::Aggregator + # why is it repeating the same thing over and over + # PoCo::RSSAggregator & XML::RSS::Feed Uploaded to + # CPAN -- More PoCo::RSSAggregator + # mozbot: shutup please + # Ok, threw away 2558 messages. + + # Ahem. So now we limit the diff reporting code to maxInChannel + # items at a time... + + if (@output and @output < $self->{'maxInChannel'}) { + my %mutedChannels = (); + if (defined($self->{'mutes'}->{$uri})) { + %mutedChannels = map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{$uri}); + } + if (defined($self->{'mutes'}->{''})) { + %mutedChannels = (%mutedChannels, map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{''})); + } + if ($request eq 'request') { + $mutedChannels{$event->{'channel'}} = 1; + } + foreach (@{$self->{'channels'}}) { + unless ($mutedChannels{$_}) { + local $event->{'target'} = $_; + $self->say($event, "Just appeared in $self->{'data'}->{$uri}->{'title'} - $self->{'data'}->{$uri}->{'link'} :"); + foreach (@output) { + $self->say($event, " " . $_); + } + } + } + } +} + +sub ReportAll { + my $self = shift; + my ($event, $uri) = @_; + my @output; + foreach (keys(%{$self->{'data'}->{$uri}->{'items'}})) { + push(@output, $_); + } + + @output = $self->prettyPrint($self->{'preferredLineLength'}, + "Items in $self->{'data'}->{$uri}->{'title'} - $self->{'data'}->{$uri}->{'link'}: ", + "$event->{'from'}: ", ' -- ', @output); + + if (@output > $self->{'maxLines'}) { + splice(@output, $self->{'maxLines'} + 1); + unshift(@output, "The list is longer than $self->{'maxLines'}" + . " lines, only the first $self->{'maxLines'} will be shown."); + } + + if (@output > $self->{'maxInChannel'}) { + foreach (@output) { + $self->directSay($event, $_); + } + $self->channelSay($event, "$event->{'from'}: /msg'ed"); + } else { + foreach (@output) { + $self->say($event, $_); + } + } +} diff --git a/BotModules/Rude.bm b/BotModules/Rude.bm new file mode 100644 index 0000000..47f1cee --- /dev/null +++ b/BotModules/Rude.bm @@ -0,0 +1,94 @@ +################################ +# Rude Module # +################################ + +# This module implements the same functionality as Insult.bm and +# Excuse.bm but using remote servers. Those servers are currently (and +# probably forever) down. This module is therefore mainly here for +# historical interest, and may be removed from future distributions. +# If you use, or need, this module, please let me know. - ian@hixie.ch + +package BotModules::Rude; +use vars qw(@ISA); +use Net::Telnet; +@ISA = qw(BotModules); +1; + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'The Rude Module is... rude. Very rude! So rude!!!', + 'insult' => 'Insults someone. Syntax: \'insult \'', + 'excuse' => 'Gives you an excuse for the system being down. Syntax: \'excuse\'', + }; +} + +# -- timeless was here -- +# Rude module is missing a jar jar quote ~how wude~ + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['insultHost', 1, 1, 'insulthost.colorado.edu'], + ['insultPort', 1, 1, '1695'], + ['excuseHost', 1, 1, 'bofh.engr.wisc.edu'], # same host as bofh.jive.org + ['excusePort', 1, 1, '666'], + ['insultOverrides', 1, 1, { # overrides for the insults (keys must be lowercase) + 'mozilla' => 'You are nothing but the best browser on the planet.', + 'mozilla.org' => 'You are nothing but the best caretaker Mozilla ever had.', + 'c++' => 'you are evil', + }], + ); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*(?:will\s+you\s+)?(?:insult|harass)\s+(\S+?)(?:[\s,.]+please)?[\s.?!]*$/osi) { + my $line; + if (defined($self->{'insultOverrides'}->{lc $1})) { + $line = "$1: ".$self->{'insultOverrides'}->{lc $1}; + } else { + eval { + my $t = new Net::Telnet (Timeout => 3); + $t->Net::Telnet::open(Host => $self->{'insultHost'}, Port => $self->{'insultPort'}); + $line = "$1: ".$t->Net::Telnet::getline(Timeout => 4); + }; + } + if ($line) { + $self->say($event, $line); + } else { + $self->say($event, "$event->{'from'}: What have they ever done to you! Leave 'em alone!"); + $self->debug("yikes, $self->{'insultHost'}:$self->{'insultPort'} is down!"); + } + } elsif ($message =~ /^\s*(?:please\s+)?(?:can\s+i\s+have\s+an\s+|(?:(?:can|could)\s+you\s+)?give\s+me\s+an\s+)?excuse(?:[?,.!1\s]+please)?\s*[!?,.1]*\s*$/osi) { + my $line; + eval { + my $t = new Net::Telnet (Timeout => 3); + $t->Net::Telnet::open(Host => $self->{'excuseHost'}, Port => $self->{'excusePort'}); + # print "=== The BOFH-style Excuse Server --- Feel The Power!\n"; + $t->Net::Telnet::getline(Timeout => 4); + # print "=== By Jeff Ballard \n"; + $t->Net::Telnet::getline(Timeout => 4); + # print "=== See http://www.cs.wisc.edu/~ballard/bofh/ for more info.\n"; + $t->Net::Telnet::getline(Timeout => 4); + # print "Your excuse is: $excuses[$j]"; + $line = $t->Net::Telnet::getline(Timeout => 4); + }; + if ($line) { + # $line =~ s/^.*?Your excuse is: //gosi; + # $self->say($event, "$event->{'from'}: '$line'"); + $self->say($event, "$line"); + } else { + $self->say($event, "$event->{'from'}: Don't ask *me* for an excuse! Sheesh!"); + $self->debug("yikes, $self->{'excuseHost'}:$self->{'excusePort'} is down!"); + } + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} diff --git a/BotModules/Seen.bm b/BotModules/Seen.bm new file mode 100644 index 0000000..2126e96 --- /dev/null +++ b/BotModules/Seen.bm @@ -0,0 +1,290 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Seen Module # +################################ + +package BotModules::Seen; +use vars qw(@ISA); +@ISA = qw(BotModules); +use AnyDBM_File; +use Fcntl; +1; + +# SpottedNickChange would be a nice one to do if you +# can solve the problem of working out which channel +# to say stuff in... + +# database for seen data +our $seen = {'times' => {}, 'states' => {}}; +# the times that the relevant nicks were last seen active +tie(%{$seen->{'times'}}, 'AnyDBM_File', 'seen-times', O_RDWR|O_CREAT, 0666); +# what the relevant nicks were last seen doing +tie(%{$seen->{'states'}}, 'AnyDBM_File', 'seen-states', O_RDWR|O_CREAT, 0666); + +sub Help { + my $self = shift; + my ($event) = @_; + my %commands = { + 'seen' => 'Says how long it\'s been since the last time someone was seen. Syntax: seen victim', + }; + if ($self->isAdmin($event)) { + $commands{'mute'} = 'Stop responding to !seen in a channel unless told directly. Syntax: mute seen in '; + $commands{'unmute'} = 'Start responding to !seen in a channel. Syntax: unmute seen in '; + } + return \%commands; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['overrides', 1, 1, {'therapist' => 'Look, dude, I\'m feeling fine, mm\'k?'}], # canned responses + ['maxLines', 1, 1, 5], + ['directOnlyChannels', 1, 1, []], #list of channels where we're only observing and not responding to !seen unless told. + ); +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + my $now = $event->{'time'}; + $self->{'_lastSpoken'}->{$event->{'user'}} = $now; + if ($event->{'channel'} ne '') { + my $channel = $event->{'channel'}; + $seen->{'times'}->{lc $event->{'from'}} = $now; + $seen->{'states'}->{lc $event->{'from'}} = "saying '$message' to me in $channel."; + } + if ($self->isAdmin($event) and $message =~ /^\s*(un)?mute\s+seen\s+in\s+(\S+)\s*$/osi){ + my $mute = !defined($1); + my $channel = lc $2; + $channel =~ s/^\#?/\#/; # Add # character if needed. + $self->MuteOrUnmuteChannel($event, $mute, $channel); + }elsif ($message =~ /^\s*!?seen\s+(\S+?)[\s?.!]*$/osi) { + $self->DoSeen($event, $1); + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Heard { + my $self = shift; + my ($event, $message) = @_; + if ($event->{'channel'} ne '') { + my $channel = $event->{'channel'}; + $seen->{'times'}->{lc $event->{'from'}} = $event->{'time'}; + $seen->{'states'}->{lc $event->{'from'}} = "saying '$message' in $channel."; + } + if (!(grep {$event->{'channel'} eq $_} @{$self->{'directOnlyChannels'}}) and $message =~ /^\s*!seen\s+(\S+)\s*$/osi) { + $self->DoSeen($event, $1); + } else { + return $self->SUPER::Heard(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Felt { + my $self = shift; + my ($event, $message) = @_; + if ($event->{'channel'} ne '') { + my $nick = $event->{'from'}; + my $channel = $event->{'channel'}; + $seen->{'times'}->{lc $event->{'from'}} = $event->{'time'}; + $seen->{'states'}->{lc $event->{'from'}} = "saying '* $nick $message' in $channel."; + } else { + return $self->SUPER::Felt(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub Saw { + my $self = shift; + my ($event, $message) = @_; + if ($event->{'channel'} ne '') { + my $nick = $event->{'from'}; + my $channel = $event->{'channel'}; + $seen->{'times'}->{lc $event->{'from'}} = $event->{'time'}; + $seen->{'states'}->{lc $event->{'from'}} = "saying '* $nick $message' in $channel."; + } else { + return $self->SUPER::Felt(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +# SpottedNickChange - Called when someone changes nick +sub SpottedNickChange { + my $self = shift; + my ($event, $from, $to) = @_; + $seen->{'times'}->{lc $event->{'from'}} = $event->{'time'}; + $seen->{'states'}->{lc $event->{'from'}} = "changing nick to $to."; + return $self->SUPER::SpottedNickChange(@_); +} + +sub DoSeen { + my $self = shift; + my ($event, $who) = @_; + my $pattern; + if (lc $who eq lc $event->{'from'}) { + $self->say($event, 'You\'re right here, duh!'); + } elsif (lc $who eq lc $event->{'nick'}) { + $self->say($event, 'I\'m right here, duh!'); + } elsif (defined($self->{'overrides'}->{$who})) { + $self->say($event, $self->{'overrides'}->{$who}); + } else { + my $regexp; + my @nicksToList = (); + if ($who =~ m!^/(\S+)/$!) { # shouldn't allow mix and match or blank RE or spaces. + $regexp = $1; + my $re = $self->sanitizeRegexp($regexp); # security + safety first! + $re = qr/$re/i; #precompile for performance + if ('' =~ $re){ # will match everything, throw error. + $self->say($event, 'That pattern matches everything, please be more specific.'); + return; + } + @nicksToList = grep {$_ =~ $re} (keys %{$seen->{'times'}}); + $pattern = 1; + } else { + if ($who =~ /\*/){ # no point going through the motions if there's no wildcard. + $regexp = quotemeta(lc $who); + $regexp =~ s/\\\*/\\S*/g; # replace the escaped * from quotemeta with a \S* (XXX wanted: the ? wildcard) + my $re = qr/^$regexp$/; + if ('' =~ $re){ # will match everything, throw error. + $self->say($event, 'That pattern matches everything, please be more specific.'); + return; + } + @nicksToList = grep {$_ =~ $re} (keys %{$seen->{'times'}}); + } else { + @nicksToList = (lc $who) if defined($seen->{'times'}{lc $who}); # short circuit for the majority of uses + } + $pattern = 0; + } + if (@nicksToList > $self->{'maxLines'}) { # if it's more than the set threshold, don't flood :) + $self->say($event,"There are more than $self->{'maxLines'} nicks matching that wildcard, please be more specific."); + } elsif (@nicksToList > 0) { + foreach my $nick (@nicksToList) { + my $seconds = $seen->{'times'}->{$nick}; + $seconds = $event->{'time'} - $seconds; + my $time = ''; + + if ($seconds > 90) { + my $minutes = int $seconds / 60; + $seconds %= 60; + if ($minutes > 90) { + my $hours = int $minutes / 60; + $minutes %= 60; + if ($hours > 36) { + my $days = int $hours / 24; + $hours %= 24; + if ($days > 10) { + my $weeks = int $days / 7; + $days %= 7; + if ($weeks > 10) { + # good god, nice connection + } + if ($weeks != 0) { + if ($time ne '') { + $time .= ', '; + } + if ($weeks == 1) { + $time .= "$weeks week"; + } else { + $time .= "$weeks weeks"; + } + } + } + if ($days != 0) { + if ($time ne '') { + $time .= ', '; + } + if ($days == 1) { + $time .= "$days day"; + } else { + $time .= "$days days"; + } + } + } + if ($hours != 0) { + if ($time ne '') { + $time .= ', '; + } + if ($hours == 1) { + $time .= "$hours hour"; + } else { + $time .= "$hours hours"; + } + } + } + if ($minutes != 0) { + if ($time ne '') { + $time .= ', '; + } + if ($minutes == 1) { + $time .= "$minutes minute"; + } else { + $time .= "$minutes minutes"; + } + } + } + if ($seconds == 0) { + if ($time eq '') { + $time .= 'right about now'; + } else { + $time .= ' ago'; + } + } else { + if ($time ne '') { + $time .= ' and '; + } + if ($seconds == 1) { + $time .= 'a second ago'; + } elsif ($seconds == 2) { + $time .= 'a couple of seconds ago'; + } else { + $time .= "$seconds seconds ago"; + } + } + my $what = $seen->{'states'}->{$nick}; + $self->say($event, "$nick was last seen $time, $what"); + } + } else { + my $n = ''; + if ($who =~ /^[aeiou]/o) { + $n = 'n'; + } + if ($pattern == 1) { + $self->say($event, "I've never seen anyone matching the pattern '$who', sorry."); + } else { + $self->say($event, "I've never seen a$n '$who', sorry."); + } + } + } +} + +sub Unload { + untie(%{$seen->{'times'}}); + untie(%{$seen->{'states'}}); +} + +sub MuteOrUnmuteChannel { + my $self = shift; + my ($event, $mute, $channel) = @_; + if ($mute){ + if (grep {$_ eq $channel} @{$self->{'directOnlyChannels'}}){ + $self->say($event,"I'm already ignoring !seen in $channel."); + } else{ + push @{$self->{'directOnlyChannels'}}, $channel; + $self->say($event, "I won't respond to !seen in $channel anymore unless told directly."); + $self->saveConfig(); + } + } else { + if (grep {$_ eq $channel} @{$self->{'directOnlyChannels'}}){ + @{$self->{'directOnlyChannels'}} = map {$_ ne $channel} @{$self->{'directOnlyChannels'}}; + $self->say($event,"I'll start responding to !seen in $channel now."); + $self->saveConfig(); + } else{ + $self->say($event, "I'm already responding to !seen in $channel."); + } + } +} diff --git a/BotModules/ServicesLogin.bm b/BotModules/ServicesLogin.bm new file mode 100644 index 0000000..fa137f8 --- /dev/null +++ b/BotModules/ServicesLogin.bm @@ -0,0 +1,88 @@ +################################ +# Services Login Module # +################################ + +package BotModules::ServicesLogin; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# This module allows your mozbot to login to Network Services such as +# Nickserv, K9, Q on Quakenet, or X on Undernet. +# +# It works in two ways: +# * it logs in when the bot connects to IRC +# * it reauthenticates at regular intervals, to assure that mozbot is +# logged in at all times +# +# This module was originally written by Mohamed Elzakzoki +# . + + +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['loginCommand', 1, 1, undef], + ['servicesNick', 1, 1, undef], + ['delay', 1, 1, 900], # defaults to every 15 minutes + ); +} + +sub Schedule { + my $self = shift; + my ($event) = @_; + unless ($self->login($event)) { + $self->tellAdmin($event, 'To make me log in to a particular service, use the \'setupServicesLogin\' command, as in \'setupServicesLogin x@services.undernet.org login foobot p455w0rd\'. Type \'help setupServicesLogin\' for more information.'); + } + $self->schedule($event, \$self->{'delay'}, -1, 'login'); + $self->SUPER::Schedule($event); +} + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'The ServicesLogin module logs mozbot into services such as X on Undernet, Q on Quakenet, or NickServ or K9 on other networks. To setup the ServicesLogin command, use the setupServicesLogin command. See \'help setupServicesLogin\'.', + 'setupServicesLogin' => 'The syntax of this command is \'setupServicesLogin \'. If the services nick is \'q@cserve.quakenet.org\', and the login command is \'auth mozbot mypass\', then you would type \'setupServicesLogin q@cserve.quakenet.org auth mozbot mypass\'. This will then cause mozbot to do: /msg q@cserve.quakenet.org auth mozbot mypass', + } if $self->isAdmin($event); + return {}; +} + +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + if ($data[0] eq 'login') { + $self->login($event); + } else { + $self->SUPER::Scheduled($event, @data); + } +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*setup\s*services\s*login\s+(\S+)\s+(.+?)\s*$/osi) { + $self->{'servicesNick'} = $1; + $self->{'loginCommand'} = $2; + $self->saveConfig(); + $self->say($event, "Ok, I'll contact $self->{'servicesNick'} regularly from now on."); + $self->login($event); + } else { + return $self->SUPER::Told(@_); + } + return 0; # we've dealt with it, no need to do anything else. +} + +sub login { + my $self = shift; + my ($event) = @_; + if (defined $self->{'servicesNick'} and + defined $self->{'loginCommand'}) { + local $event->{'target'} = $self->{'servicesNick'}; + $self->privsay($event, $self->{'loginCommand'}); + return 1; + } + return 0; +} diff --git a/BotModules/Sheriff.bm b/BotModules/Sheriff.bm new file mode 100644 index 0000000..549293a --- /dev/null +++ b/BotModules/Sheriff.bm @@ -0,0 +1,140 @@ +################################ +# Sheriff Module # +################################ + +package BotModules::Sheriff; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable? ] + ['tree', 1, 1, 'SeaMonkey'], + ['baseURI', 1, 1, 'http://tinderbox.mozilla.org/'], + ['_sheriff', 1, 0, undef], # the undef actually means "don't touch", of course + ['updateDelay', 1, 1, 360], + # XXX implement per-channel muting of the update notification + ); +} + +# Schedule - called when bot connects to a server, to install any schedulers +# use $self->schedule($event, $delay, $times, $data) +# where $times is 1 for a single event, -1 for recurring events, +# and a +ve number for an event that occurs that many times. +sub Schedule { + my $self = shift; + my ($event) = @_; + $self->schedule($event, \$self->{'updateDelay'}, -1, 'sheriff'); + $self->SUPER::Schedule($event); +} + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'The Sheriff module keeps track of the current sheriff.', + 'sheriff' => 'Display the current sheriff. Syntax: sheriff [tree]', + }; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*(?:who's\s+|whose\s+|whos\s+|who\s+is\s+the\s+|who\s+is\s+|who\s+)?sheriff(?:\s+(?:of\s+)?(.*?))?(?:[\s,]+today)?[.?!1]*\s*$/osi) { + $self->GetSheriff($event, $1 || $self->{'tree'}, 'requested'); + } else { + return $self->SUPER::Told(@_); + } + return 0; # dealt with it... +} + +sub GetSheriff { + my $self = shift; + my ($event, $tree, $requested) = @_; + my $url = "$self->{'baseURI'}$tree/sheriff.pl"; + $self->getURI($event, $url, $tree, $requested); +} + +sub GotURI { + my $self = shift; + my ($event, $uri, $output, $tree, $requested) = @_; + # someone please pretty up the logic here... XXX + if ($output) { + # magicness + { no warnings; # this can go _very_ wrong easily + # sheriff.pl is created using the following lines: + # $m =~ s/\'/\\\'/g; + # print SHERIFF "\$current_sheriff = '$m';\n1;"; + $output =~ s/^\$current_sheriff = '//gosi; # strip front + $output =~ s/';\n1;$//gosi; # strip back + $output =~ s/\\\'/\'/gosi; # dequote quotes + # heuristics + $output =~ s///gos; + $output =~ s/\n|\r|//gosi; + $output =~ s/">/, /gosi; + $output =~ s/
|<\/?p><\/?div>/ /gosi; + $output =~ s/<\/?(?:b|strong)>/*/gosi; + $output =~ s/<\/?(?:u|em)>/_/gosi; + $output =~ s/<\/?(?:q)>/"/gosi; + $output =~ s/<\/?(?:i|dfn|cite)>/\//gosi; + } + if (defined($output)) { + if ($tree eq $self->{'tree'}) { + if ((defined($self->{'_sheriff'})) and ($self->{'_sheriff'} ne '')) { # not first time + if ($output ne $self->{'_sheriff'}) { # changed. + $self->announce($event, "Sheriff change: $output"); + if (($requested) and (not ($event->{'channel'}))) { + $self->directSay($event, "$output"); + } + } elsif ($requested) { + $self->say($event, "$event->{'from'}: $output"); + } + } else { # first time + $self->say($event, "$event->{'from'}: $output") if ($requested); + } + $self->{'_sheriff'} = $output; # update internal cache + } else { # not default tree + if ($requested) { + $self->say($event, "$event->{'from'}: $output"); + } # else EH!? + } + } else { + # something went very wrong + $self->say($event, "$event->{'from'}: I have no idea -- the '$tree' tree probably doesn't have a sheriff.") if ($requested); + if ($tree eq $self->{'tree'}) { + if (defined($self->{'_sheriff'})) { + # only do it once + $self->tellAdmin($event, "Oh dear lord what happened to the '$tree' sheriff line on the tinderbox page!!"); + $self->{'_sheriff'} = undef; + } + } + } + } else { + if ($tree eq $self->{'tree'}) { + $self->say($event, "$event->{'from'}: Call an admin, I couldn't find the Sheriff page. Sorry!") if ($requested); + if (defined($self->{'_sheriff'})) { + # only do it once + $self->tellAdmin($event, "Looks like either I am badly configured or tinderbox is down - '$tree' came up blank when I went looking for the Sheriff."); + $self->{'_sheriff'} = undef; + } + } else { + if ($requested) { + $self->say($event, "$event->{'from'}: Are you sure there is a tree called '$tree'? I couldn't find one..."); + } # else EH!? + } + } +} + +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + if ($data[0] eq 'sheriff') { + $self->GetSheriff($event, $self->{'tree'}, 0); + } else { + $self->SUPER::Scheduled($event, @data); + } +} diff --git a/BotModules/Spell.bm b/BotModules/Spell.bm new file mode 100644 index 0000000..7284718 --- /dev/null +++ b/BotModules/Spell.bm @@ -0,0 +1,119 @@ +# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- +################################ +# Spell Checker Module # +################################ + +package BotModules::Spell; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# XXX Ideally we should move to using www.dict.org + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'This module checks for spelling errors.', + 'sp' => 'If you aren\'t sure of the spelling of a word, append \'(sp)\' to the word, and it will be checked for you. '. + 'For example: \'My speling (sp?) is awful!\'' + }; +} + +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($self->checkSpelling($event, $message)) { + # we checked the spelling, abort + return 0; + } + return $self->SUPER::Heard(@_); +} + +sub Heard { + my $self = shift; + my ($event, $text) = @_; + $self->checkSpelling($event, $text); + return $self->SUPER::Heard(@_); +} + +sub checkSpelling { + my $self = shift; + my ($event, $text) = @_; + while ($text =~ s/^.*? # take everything up to the first word to check + \b # look for a word break + (\w+) # take the word to spell + \s* # look for whitespace following it + \(sp\??\) # followed by (sp) or (sp?) + //isox) { # and remove everything up to here so we can do another check in a minute + my $word = $1; + # XXX escape $word + $self->getURI($event, "http://www.merriam-webster.com/dictionary/$word", 'word', $1); # XXX should be configurable! + return 1; + } + return 0; +} + +sub GotURI { + my $self = shift; + my ($event, $query, $result, $command, $word) = @_; + if ($command ne 'word') { + return $self->SUPER::GorURI(@_); + } else { + my $reply; + # Determine if page is error or not + if (!length($result)) { + $self->debug("Waah, failed utterly to get a response for '$word' from the dictionary server."); + $reply = "The dictionary service is not accessible right now, sorry."; + } elsif ($result =~ / # Match + The\ word\ you've\ entered\ # literal string + isn't\ in\ the\ dictionary\. # (not very smart), + .*? # anything (non-greedy), + 
                         # PRE tag,
+                       (.*?)                         # our suggestions,
+                       <\/PRE>                       # PRE tag
+                       /osx
+                       
+                || $result =~ /                        # Match
+                       The\ word\ you've\ entered\   # literal string
+                       isn't\ in\ the\ dictionary\.  # (not very smart),
+                       .*?                           # anything (non-greedy),
+                                                # OL tag,
+                       (.*?)                         # our suggestions,
+                       <\/ol>                       # OL tag
+                       /osx
+                 # XXX this is hardcoded to m-w.com!
+        ) {
+            # Strip line numbering and anchor tags
+            my $suggestions = $1;
+            $suggestions =~ s/\s+[\d]+\.\s+//go;
+            $suggestions =~ s/(.*?)<\/a>/$1 /go;
+            $suggestions =~ s/
  • (.*?)<\/li>/$1 /go;
+
+            # get them in list format
+            my @suggestions = split(' ', $suggestions);
+
+            # Comma delimit suggestions
+            local $" = ', ';
+            if (@suggestions > 7) {
+                # lots of suggestions!
+                # 7 is not arbitrary, it's supposed to be the number
+                # of items people can remember at once.
+                @suggestions = @suggestions[0..6];
+                $reply = "Suggestions for '$word': @suggestions[0..6]...";
+            } elsif (@suggestions) {
+                # just a few suggestions
+                $reply = "Suggestions for '$word': @suggestions";
+            } else {
+                # eh? Weird. Some problem on the server probably.
+                $self->debug("Didn't get any suggestions for '$word'!");
+                $reply = "I have no idea what '$word' is supposed to be, sorry.";
+            }
+        } else {
+            # horrah!
+            $reply = "'$word' seems to be the correct spelling.";
+        }
+        $self->say($event, $reply);
+        return 0;
+    }
+}
diff --git a/BotModules/Stocks.bm b/BotModules/Stocks.bm
new file mode 100644
index 0000000..0f614d7
--- /dev/null
+++ b/BotModules/Stocks.bm
@@ -0,0 +1,54 @@
+# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
+################################
+# Stocks Module                #
+################################
+
+package BotModules::Stocks;
+use vars qw(@ISA);
+@ISA = qw(BotModules);
+1;
+
+# XXX Per-channel configurable notification of stock changes
+# XXX Non-US markets
+
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    return {
+        '' => 'This module gets stock quotes. Ask me a ticker symbol, I will retrieve the quote.',
+        'stock' => 'Call this command with a ticker symbol to get the current stock price and change. Syntax: stock FBAR',
+    };
+}
+
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    if ($message =~ /^\s*stocks?\s+(.+?)\s*$/osi) {
+        $self->getURI($event, "http://download.finance.yahoo.com/d/quotes.csv?f=sl1d1t1c1ohgv&e=.csv&s=$1", $1);
+    } else {
+        return $self->SUPER::Told(@_);
+    }
+    return 0; # we've dealt with it, no need to do anything else.
+}
+
+sub GotURI {
+     my $self = shift;
+     my ($event, $uri, $output, $stock) = @_;
+     $self->debug($output);
+     my $message = "$event->{'from'}: ";
+     # The data currently listed in this format are: ticker symbol, last price, date, time, change, open price, daily high, daily low, and volume.
+     #  -- http://help.yahoo.com/help/us/fin/quote/quote-05.html
+     my @stockValues = split(',', $output);
+     foreach my $part (@stockValues) {
+          $part =~ s/"//gos; # remove all quotes. Bit of a hack, but... XXX
+     }
+     if ($stockValues[4] > 0) {
+         $stockValues[4] = 'up ' . (0+$stockValues[4]);
+     } elsif ($stockValues[4] < 0) {
+         $stockValues[4] = 'down ' . (0-$stockValues[4]);
+     } else {
+         $stockValues[4] = 'no change';
+     }
+     $message .= "Stock quote for $stockValues[0]: $stockValues[1], $stockValues[4] (low: $stockValues[7], high: $stockValues[6])";
+     $self->say($event, $message);
+}
diff --git a/BotModules/Tinderbox.bm b/BotModules/Tinderbox.bm
new file mode 100644
index 0000000..f52dcd2
--- /dev/null
+++ b/BotModules/Tinderbox.bm
@@ -0,0 +1,508 @@
+# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
+################################
+# Tinderbox Module             #
+################################
+
+package BotModules::Tinderbox;
+use vars qw(@ISA);
+@ISA = qw(BotModules);
+1;
+
+# RegisterConfig - Called when initialised, should call registerVariables
+sub RegisterConfig {
+    my $self = shift;
+    $self->SUPER::RegisterConfig(@_);
+    $self->registerVariables(
+      # [ name, save?, settable? ]
+        ['trees', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports', 'MozillaTest', 'Grendel']], 
+        ['treesAnnounced', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports']], 
+        ['treesDefault', 1, 1, ['SeaMonkey']], 
+        ['treeStates', 0, 0, {}], # ->tree->(current, previous, lastupdate)
+        ['lasttreesStates', 0, 0, []], # copy of trees in last test
+        ['tinderboxStates', 0, 0, {}], # ->tree->build->(current, previous, lastupdate)
+        ['updateDelay', 1, 1, 120],
+        ['useNotice', 1, 1, 1], # set to 1 to use notice and 0 to use a normal message
+        ['_lastupdate', 0, 0, 0],
+        ['preferredLineLength', 1, 1, 100], 
+        ['mutes', 1, 1, {}],  # tree -> "channel channel channel"
+        ['states', 1, 1, {'success' => 'Success', 'testfailed' => 'Test Failed', 'busted' => 'Burning', }],
+        ['maxInChannel', 1, 1, 5], # maximum number of lines to report in a channel
+        ['tinderboxURI', 1, 1, "http://tinderbox.mozilla.org/"], # base URL for Tinderbox
+        ['isTinderbox2', 1, 1, 0], # whether this is tinderbox2 or not
+    );
+}
+
+# Schedule - called when bot connects to a server, to install any schedulers
+# use $self->schedule($event, $delay, $times, $data)
+# where $times is 1 for a single event, -1 for recurring events,
+# and a +ve number for an event that occurs that many times.
+sub Schedule {
+    my $self = shift;
+    my ($event) = @_;
+    $self->schedule($event, \$self->{'updateDelay'}, -1, 'tinderbox');
+    $self->SUPER::Schedule($event);
+}
+
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    my %commands = (
+        '' => 'The Tinderbox module monitors who the state of the tinderboxen.',
+        'qt' => 'Quick trees, same as \'trees terse\'. You can give it a  argument if you like, for example \'qt seamonkey\'.',
+        'builds' => 'Gives the status of all the builds in all the trees that match a particular pattern. Syntax: \'builds \'. For example: \'builds Mac\'.',
+        'trees' => 'Reports on the current state of the tinderboxen. Syntax: \'trees  \' where  is any number of: '.
+                   'all (show all trees and all builds), main (show only main trees), burning (show only burning builds), '.
+                   'long, medium, short, terse (how much detail to include), and  is the name of the tree to show (or a regexp matching it).',
+    );
+    if ($self->isAdmin($event)) {
+        $commands{'mute'} = 'Disable reporting of a tree in a channel. (Only does something if the given tree exists.) Syntax: mute tinderbox  in ';
+        $commands{'unmute'} = 'Enable reporting of a tree in a channel. By default, trees are reported in all channels that the module is active in. Syntax: unmute tinderbox  in ';
+    }
+    return \%commands;
+}
+
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    if ($message =~ /^\s*trees?(?:\s+(.*?))?\s*(?:[, ]\s*please)?\?*\s*$/osi) {
+
+        # initial setup
+        my $trees = -1; # 0=default; 1=all; 'x'=pattern match
+        my $builds = -1; # 0=all; 1=horked and test failed; 2=horked only
+        my $verbosity = -1; # 1=terse; 2; 3; 4=verbose
+
+        # parse parameters
+        if (defined($1)) {
+            foreach (split(/\s+/, $1)) {
+                   if (/^all$/osi) { $trees = '1' if $trees < 0; $builds = 0 if $builds < 0; }
+                elsif (/^main$/osi) { $trees = '0'; }
+                elsif (/^burning$/osi) { $builds = 2; }
+                elsif (/^long$/osi) { $verbosity = 4; }
+                elsif (/^medium$/osi) { $verbosity = 3; }
+                elsif (/^short$/osi) { $verbosity = 2; }
+                elsif (/^terse$/osi) { $verbosity = 1; }
+                else { $trees = $_; }
+            }
+        }
+
+        # defaults
+        $trees = '0' if $trees < 0;
+        $builds = 1 if $builds < 0;
+        $verbosity = 2 if $verbosity < 0;
+
+        # go
+        $self->GetTrees($event, 1, $trees, $builds, $verbosity);
+
+    } elsif ($message =~ /^\s*builds?\s+(.*?)\s*\?*\s*$/osi) {
+        $self->GetTrees($event, 2, $1);
+    } elsif ($message =~ /^\s*qt(?:\s+(.+?))?\s*$/osi) {       
+        $self->GetTrees($event, 1, defined($1) ? $1 : 0, 1, 1);
+    } elsif ($self->isAdmin($event)) {
+        if ($message =~ /^\s*mute tinderbox\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
+            my $tree = $1 eq 'Tinderbox' ? '' : $1;
+            my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
+            if (($tree eq '') or (grep $_ eq $tree, @{$self->{'trees'}})) {
+                $self->{'mutes'}->{$tree} .= " $2";
+                $self->saveConfig();
+                $self->say($event, "$event->{'from'}: Tinderbox notifications for $treeName muted in channel $2.");
+            } else {
+                $self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
+            }
+        } elsif ($message =~ /^\s*unmute tinderbox\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
+            my $tree = $1 eq 'Tinderbox' ? '' : $1;
+            my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
+            if (($tree eq '') or (grep $_ eq $tree, @{$self->{'trees'}})) {
+                my %mutedChannels = map { lc($_) => 1 } split(/ /o, $self->{'mutes'}->{$1});
+                delete($mutedChannels{lc($2)}); # get rid of any mentions of that channel
+                $self->{'mutes'}->{$1} = join(' ', keys(%mutedChannels));
+                $self->saveConfig();
+                $self->say($event, "$event->{'from'}: Tinderbox notifications for trees named $1 resumed in channel $2.");
+            } else {
+                $self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
+            }
+        } else {
+            return $self->SUPER::Told(@_);
+        }
+    } else {
+        return $self->SUPER::Told(@_);
+    }
+    return 0; # dealt with it...
+}
+
+sub GetTrees {
+    my $self = shift;
+    my ($event, $requested, @mode) = @_;
+    my @trees = @{$self->{'trees'}};
+    if ($self->{'isTinderbox2'}) {
+        foreach (@trees) {
+            my $uri = $self->{'tinderboxURI'} . $_ . "/quickparse.html";
+            $self->getURI($event, $uri, $requested, @mode);
+        }
+    } else {
+        local $" = ','; # XXX %-escape this 
+        my $uri = $self->{'tinderboxURI'} . "showbuilds.cgi?quickparse=1&tree=@trees";
+        $self->getURI($event, $uri, $requested, @mode);
+    }
+}
+
+sub GotURI {
+    my $self = shift;
+    my ($event, $uri, $output, $requested, @mode) = @_;
+    if ($output) {
+        my $now = $event->{'time'};
+        $self->{'_lastupdate'} = $now;
+        my @lines = split(/\n/os, $output);
+
+        # loop through quickparse output
+        foreach my $line (@lines) {
+            my ($type, $tree, $build, $state) = split(/\|/os, $line);
+            if ($type eq 'State') {
+                $self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
+                if (defined($self->{'treeStates'}->{$tree}->{'current'})) {
+                    $self->{'treeStates'}->{$tree}->{'previous'} = $self->{'treeStates'}->{$tree}->{'current'};
+                }
+                $self->{'treeStates'}->{$tree}->{'current'} = $state;
+                $self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
+            } elsif ($type eq 'Build') {
+                $self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} = $now;
+                if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'current'})) {
+                    $self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};
+                }
+                $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'} = $state;
+                $self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
+            } # else unsupported type XXX
+        }
+        
+        #If a Tinderbox tree is configured without Bonsai, it lacks a state line and doesn't
+        # appear properly in the trees output (even though machine state changes work.)
+        # Work around this by setting a default state of Unknown to trees w/o a state line.
+        my $state = "unknown";
+        foreach my $tree (keys(%{$self->{'tinderboxStates'}})) {
+            if (!defined($self->{'treeStates'}->{$tree})) {
+                $self->{'treeStates'}->{$tree}->{'current'} = $state;
+                $self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
+                if (defined($self->{'treeStates'}->{$tree}->{'current'})) {
+                    $self->{'treeStates'}->{$tree}->{'previous'} = $self->{'treeStates'}->{$tree}->{'current'};
+                }
+                $self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
+            }
+            #Update timestamps on trees we're 'managing' state on.
+            if (($self->{'treeStates'}->{$tree}->{'current'} eq $state) and 
+                ($self->{'treeStates'}->{$tree}->{'lastupdate'} < $now)) {
+                $self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
+            }
+        }
+        
+        $self->CheckForUpdates($event, $requested);
+        if ($requested == 1) {
+            $self->ReportState($event, @mode);
+        } elsif ($requested == 2) {
+            $self->ReportBuild($event, @mode);
+        }
+        # update list of active trees
+        @{$self->{'lasttreesState'}} = @{$self->{'trees'}};
+    } else {
+        if ($requested) {
+            $self->say($event, "$event->{'from'}: I can't access tinderbox right now, sorry.");
+        }
+        $self->debug('failed to get tinderbox data');
+    }
+}
+
+
+sub Scheduled {
+    my $self = shift;
+    my ($event, @data) = @_;
+    if ($data[0] eq 'tinderbox') {
+        $self->GetTrees($event, 0);
+    } else {
+        $self->SUPER::Scheduled($event, @data);
+    }
+}
+
+sub CheckForUpdates {
+    my $self = shift;
+    my ($event, $avoidTarget) = @_;
+    my $a; # disclaimer: I was asleep when I wrote the next line. I've no longer any idea what it does.
+    my @trees = map { $a = $_; grep { $_ eq $a } @{$self->{'lasttreesState'}}; } @{$self->{'treesAnnounced'}};
+    # After staring at it for a few minutes, I think what it does is get a list of the trees that should
+    # be announced, AND that have already been found to exist. But I'm not 100% sure.
+    foreach my $tree (@trees) {
+        my @newTrees;
+        my @newBuilds;
+        my @lostBuilds;
+        my @lostTrees;
+        my @changes;
+
+        # check trees
+        if (defined($self->{'treeStates'}->{$tree})) {
+            if ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) {
+                if (defined($self->{'treeStates'}->{$tree}->{'previous'})) {
+                    if ($self->{'treeStates'}->{$tree}->{'previous'} ne $self->{'treeStates'}->{$tree}->{'current'}) {
+                        push(@changes, "$tree has changed state from $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'previous'}} to $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}.");
+                    }
+                } else {
+                    push(@newTrees, "New tree added to tinderbox: $tree (state: $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}).");
+                }
+            } else {
+                # tree has dissappeared!
+                delete($self->{'treeStates'}->{$tree});
+                push(@lostTrees, "Eek!!! Tree '$tree' has been removed from tinderbox!");
+            }
+        } # else tree doesn't exist
+
+        # check builds
+        if (defined($self->{'tinderboxStates'}->{$tree})) {
+            foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {                
+                if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {
+                    if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'})) {
+                        if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} ne $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}) {
+                            push(@changes, "$tree: '$build' has changed state from $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'}} to $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}.");
+                        }
+                    } else {
+                        push(@newBuilds, "$tree: Build '$build' added to tinderbox. (Status: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}).");
+                    }
+                } else {
+                    # build has dissappeared!
+                    delete($self->{'tinderboxStates'}->{$tree}->{$build});
+                    push(@lostBuilds, "$tree: Build '$build' has dropped from tinderbox.");
+                }
+            }
+        } # else tree doesn't exist
+
+        # sort out which channels to talk to
+        my %mutedChannels = ();
+        if (defined($self->{'mutes'}->{$tree})) {
+            %mutedChannels = map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{$tree});
+        }
+        if (defined($self->{'mutes'}->{''})) {
+            %mutedChannels = (%mutedChannels, map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{''}));
+        }
+        if (($avoidTarget) and ($event->{'target'} eq $event->{'channel'})) {
+            $mutedChannels{$event->{'channel'}} = 1;
+        }
+
+        # speak!
+        my @output = (@newTrees, @lostTrees, @newBuilds, @lostBuilds);
+        foreach (@{$self->{'channels'}}) {
+            unless ($mutedChannels{$_}) {
+                local $event->{'target'} = $_;
+                foreach (@changes) {
+                    $self->sayOrNotice($event, $_);
+                }
+                if (@output < $self->{'maxInChannel'}) {
+                    foreach (@output) {
+                        $self->sayOrNotice($event, $_);
+                    }
+                } else {
+                    $self->sayOrNotice($event, "Many tree changes just occured. Check tinderbox to see what they were.");
+                }
+            }
+        }
+    }
+}
+
+sub ReportState {
+    my $self = shift;
+    my ($event, $trees, $builds, $verbosity) = @_;
+
+    # $trees: 0=default; 1=all; 'x'=pattern match
+    # $builds: 0=all; 1=horked and test failed; 2=horked only
+    # $verbosity: 1=terse; 2; 3; 4=verbose
+
+    # the complete output 
+    my @lines;
+
+    # work out which trees we want
+    my @trees;
+    if ($trees eq '0') {
+        @trees = @{$self->{'treesDefault'}};
+    } elsif ($trees eq '1') {
+        @trees = @{$self->{'trees'}};
+    } else {
+        my $pattern = $self->sanitizeRegexp($trees);
+        foreach my $tree (keys %{$self->{'treeStates'}}) {
+            push(@trees, $tree) if $tree =~ /$pattern/si;
+        }
+    }
+
+    if (@trees) {
+
+        foreach my $tree (@trees) {
+            if ((defined($self->{'treeStates'}->{$tree})) and ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'})) {
+ 
+                # setup
+                my @output;
+                my ($redShort) = ($self->{'states'}->{'bustedShort'} or split(//osi, $self->{'states'}->{'busted'}));
+                my $red = 0; 
+                my ($orangeShort) = ($self->{'states'}->{'testfailedShort'} or split(//osi, $self->{'states'}->{'testfailed'}));
+                my $orange = 0; 
+                my ($greenShort) = ($self->{'states'}->{'successShort'} or split(//osi, $self->{'states'}->{'success'}));
+                my $green = 0;
+
+                # foreach build
+                if (defined($self->{'tinderboxStates'}->{$tree})) {
+                    foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
+                        if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {
+
+                            my $state = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};
+
+                            # count results
+                            if ($state eq 'success') {
+                                $green++;
+                            } elsif ($state eq 'testfailed') {
+                                $orange++;
+                            } else {
+                                $red++;
+                            }
+
+                            # make sure we should list this build
+                            if ($state eq 'success') {
+                                next if $builds >= 1;
+                            } elsif ($state eq 'testfailed') {
+                                next if $builds >= 2;
+                            }
+
+                            if ($verbosity == 1) {
+                                my($minibuild) = split(/\s/osi, $build);
+                                my $ministate = $self->{'states'}->{$state.'Short'};
+                                if (not $ministate) {
+                                   ($ministate) = split(//osi, $self->{'states'}->{$state});
+                                }
+                                push(@output, "$minibuild: $ministate;");
+                            } elsif (($verbosity == 2) || ($verbosity == 3)) {
+                                my($minibuild) = $verbosity == 2 ? split(/\s/osi, $build) : ($build);
+                                my $ministate = $self->{'states'}->{$state.'Medium'};
+                                if (not $ministate) {
+                                   $ministate = $self->{'states'}->{$state};
+                                }
+                                push(@output, "$minibuild ($ministate),"); 
+                            } else {
+                                push(@output, "[$build: $self->{'states'}->{$state}]")
+                            }
+
+                        } # else build is dead
+                    } # (foreach build)
+                } # else tree is dead
+
+                # pretty print it
+                my @newoutput;
+                if ($verbosity == 1) {
+                    if (@output == 0) {
+                        unless ($red + $green + $orange) {
+                            push(@output, "(none)");
+                        } elsif ($builds <= 1) {
+                            push(@output, "(all green)");
+                        } else {
+                            push(@output, "(none red)");
+                        }
+                    }
+                    my $ministate = $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}.'Short'};
+                    if (not $ministate) {
+                        ($ministate) = split(//osi, $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}});
+                    }
+                    @newoutput = $self->wordWrap($self->{'preferredLineLength'}, 
+                        "$tree <$ministate> $redShort:${red} $orangeShort:${orange} $greenShort:${green} ",
+                        '  ', ' ', @output);
+                    $newoutput[0] =~ s/^  //o;
+                    $newoutput[$#newoutput] =~ s/;$//o;
+                    push(@lines, @newoutput);
+                } elsif (($verbosity == 2) || ($verbosity == 3)) {
+                    unless ($red+$orange+$green) {
+                        push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: no tinderboxen for this tree.");
+                    } elsif (($red) or ($orange)) {
+                        if (@output == 0) {
+                            # can only happen if $red is 0 and $builds is 1.
+                            push(@output, "all tinderboxen compile");
+                        }
+                        my @newoutput = $self->wordWrap($self->{'preferredLineLength'}, 
+                            "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ", 
+                            '  ', ' ', @output);
+                        $newoutput[0] =~ s/^  //o;
+                        $newoutput[$#newoutput] =~ s/,$//o;
+                        # if (length(@newoutput[$#newoutput]) < $self->{'preferredLineLength'} - 33) {
+                        #     $newoutput[$#newoutput] .= "     Summary: $red red, $orange orange, $green green";
+                        # } else {
+                        #     push(@newoutput, "  Summary: $red red, $orange orange, $green green");
+                        # }
+                        push(@lines, @newoutput);
+                    } else {
+                        push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: all $green tinderboxen green!");
+                    }
+                } else {
+                    if (@output == 0) {
+                        unless ($red + $green + $orange) {
+                            push(@output, "no tinderboxen for this tree.");
+                        } elsif ($builds <= 1) {
+                            push(@output, "all tinderboxen for this tree are green!");
+                        } else {
+                            push(@output, "all tinderboxen for this tree compile successfully.");
+                        }
+                    }
+                    @newoutput = $self->wordWrap($self->{'preferredLineLength'}, 
+                        "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ", 
+                        '  ', ' ', @output);
+                    $newoutput[0] =~ s/^  //o;
+                    push(@lines, @newoutput);
+                }
+
+            } # else tree is dead
+
+        } # (foreach tree)
+
+    } else { # no tree selected
+        @lines = ("No tree matches the pattern '$trees', sorry!");
+    }
+
+    $self->Report($event, 'tree status', @lines);
+}
+
+sub ReportBuild {
+    my $self = shift;
+    my ($event, $pattern) = @_;
+
+    # the complete output 
+    my @output;
+
+    foreach my $tree (@{$self->{'trees'}}) {
+        if ((defined($self->{'treeStates'}->{$tree})) and 
+            ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) and
+            (defined($self->{'tinderboxStates'}->{$tree}))) {
+            foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
+                if (($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) and 
+                    ($build =~ /\Q$pattern\E/is)) {
+                    push(@output, "[$build: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}]")
+                }
+            }
+        }
+    }
+
+    @output = ('There are no matching builds.') unless @output;
+    @output = $self->prettyPrint($self->{'preferredLineLength'}, undef, "$event->{'from'}: ", '  ', @output);
+
+    $self->Report($event, 'tree status', @output);
+}
+
+sub Report {
+    my $self = shift;
+    my ($event, $what, @output) = @_;
+    if (scalar(@output) > $self->{'maxInChannel'}) {
+        foreach (@output) {
+            $self->directSay($event, $_);
+        }
+        $self->channelSay($event, "$event->{'from'}: $what /msg'ed");
+    } else {
+        foreach (@output) {
+            $self->say($event, $_);
+        }
+    }
+}
+
+sub sayOrNotice {
+    my $self = shift;
+    if ($self->{'useNotice'}) {
+        $self->notice(@_);
+    } else {
+        $self->say(@_);
+    }
+}
diff --git a/BotModules/Translate.bm b/BotModules/Translate.bm
new file mode 100644
index 0000000..8e12e1a
--- /dev/null
+++ b/BotModules/Translate.bm
@@ -0,0 +1,179 @@
+################################
+# Translate Module             #
+################################
+
+package BotModules::Translate;
+use vars qw(@ISA);
+use WWW::Babelfish;
+
+# Ah, the previous line looks so innocent. Yet it hides horrible
+# evil. Yes, this module requires the following:
+#
+#    WWW::Babelfish
+#      libwww (a bundle)
+#        URI
+#          MIME-Base64
+#        HTML::Parser
+#          HTML-Tagset
+#        libnet (you probably already have this)
+#        Digest::MD5
+#      IO::String
+
+@ISA = qw(BotModules);
+1;
+
+# -- #mozilla was here! --
+# *** Signoff: techbot_Hixie (~techbot_Hixie@129.59.231.42) has left IRC [Leaving]
+#  oops, i killed your techbot
+
+# RegisterConfig - Called when initialised, should call registerVariables
+sub RegisterConfig {
+    my $self = shift;
+    $self->SUPER::RegisterConfig(@_);
+    $self->registerVariables(
+      # [ name, save?, settable? ]
+        ['supportedservices', 1, 1, {
+                                     'Babelfish' => '', #Original WWW::Babelfish Service
+                                     'Yahoo' => '', #Available since WWW::Babelfish 0.14
+                                     'Google' => '', #Available since WWW::Babelfish 0.12
+                                     }],
+        ['languages', 1, 1, {
+                             'en' => 'English',
+                             'fr' => 'French',
+                             'de' => 'German',
+                             'it' => 'Italian',
+                             'es' => 'Spanish',
+                             'ar' => 'Arabic',
+                             'zh' => 'Chinese-simp',
+                             'zt' => 'Chinese-trad',
+                             'zh-CN' => 'Chinese (Simp)', #Google-only
+                             'nl' => 'Dutch',
+                             'el' => 'Greek',
+                             'ja' => 'Japanese',
+                             'pt' => 'Portuguese',
+                             'ru' => 'Russian',
+                            }], # short code => Babelfish Language Name
+        ['defaultLanguage', 1, 1, 'en'],
+        ['defaultservice', 1, 1, 'Babelfish'],
+    );
+}
+
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    my @languages = keys(%{$self->{'languages'}});
+    my @services =  keys(%{$self->{'supportedservices'}});
+    local $";
+    $" = '|';
+    return {
+        '' => 'Translate text between languages using Babelfish or Google.',
+        'translate' => "Syntax: \'translate [using (@services)] [from (@languages)] [to (@languages)] sentence\'",
+        'x' => 'Same as translate.',
+        'languages' => "Returns list of available languages to translate. Syntax: languages [(@services)]"
+    };
+}
+
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    if ($message =~ /^\s*(?:translate|x)\s+(.*?)\s*$/osi) {
+        $self->Translate($event, $1);
+    } elsif ($message =~ /^\s*languages?(?:\s+(.*?))?\s*(?:[, ]\s*please)?\?*\s*$/osi) {
+        $self->GetLanguages($event, $1);
+    } else {
+        return $self->SUPER::Told(@_);
+    }
+    return 0; # dealt with it...
+}
+
+sub translate_do {
+    my $self = shift;
+    my ($event, $service, $lang1, $lang2, $words) = @_;
+    my $translate_babelfish = new WWW::Babelfish('service' => $service);
+    my $result = $translate_babelfish->translate(
+        'source' => $self->{'languages'}->{$lang1},
+        'destination' => $self->{'languages'}->{$lang2},
+        'text' => $words,
+    );
+    if ($result !~ /^ *$/os) {
+        return "$event->{'from'}: $result";
+    } else {
+        my $error = $translate_babelfish->error;
+        if ($error =~ /^ *$/os) {
+            return "$event->{'from'}: I'm afraid I cannot translate that from $self->{'languages'}->{$lang1} to $self->{'languages'}->{$lang2}.";
+        } else {
+            return "$event->{'from'}: $error";
+        }
+    }
+}
+
+# ChildCompleted - Called when a child process has quit
+sub ChildCompleted {
+    my $self = shift;
+    my ($event, $type, $output, @data) = @_;
+    if ($type eq 'babelfish') {
+        $self->say($event, $output);
+    } else {
+        $self->SUPER::ChildCompleted($event, $type, $output, @data);
+    }
+}
+
+sub GetLanguages {
+    my $self = shift;
+    my ($event, $rest) = @_;
+    my @services =  keys(%{$self->{'supportedservices'}});
+    my $service = $self->{'defaultservice'};
+    $service = $rest if ($rest);
+
+    my $languages_babelfish = new WWW::Babelfish('service' => $service);
+    $self->say($event,"$event->{'from'}: Available Translation Languages (for $service): " . join(", ", $languages_babelfish->languages)."");
+
+}
+
+sub Translate {
+    my $self = shift;
+    my ($event, $rest) = @_;
+    my ($service, $lang1, $lang2, $words) = (
+        $self->{'defaultservice'},
+        $self->{'defaultLanguage'},
+        $self->{'defaultLanguage'},
+    );
+
+    my @services =  keys(%{$self->{'supportedservices'}});
+    my @languages = keys(%{$self->{'languages'}});
+    local $";
+    $" = '|';
+
+    
+    #check service syntax
+    if ($rest =~ /^\s*using\s+(@services)\s+(.+)$/os) {
+        $service = $1 if defined($1);
+        $rest = $2;
+    }
+
+    # check syntax
+    if ($rest =~ /^\s*from\s+(@languages)\s+to\s+(@languages)\s+(.+)$/os) {
+        $lang1 = $1;
+        $lang2 = $2;
+        $words = $3;
+    } elsif ($rest =~ /^\s*to\s+(@languages)\s+from\s+(@languages)\s+(.+)$/os) {
+        $lang2 = $1;
+        $lang1 = $2;
+        $words = $3;
+    } elsif ($rest =~ /^\s*(from|to)\s+(@languages)\s+(.+)$/os) {
+        $lang1 = $2 if $1 eq 'from';
+        $lang2 = $2 if $1 eq 'to';
+        $words = $3;
+    } else {
+        $self->say($event, "$event->{'from'}: Noooo... That\'s not the right syntax at all! Try something like \'translate [using (@services)] [from (@languages)] [to (@languages)] sentence\'");
+        return;
+    }
+
+    # translate
+    if ($lang1 eq $lang2) {
+        $self->say($event, "$event->{'from'}: Erm, well, translating from one language to the same language... doesn't change anything!");
+    } else {
+        $self->spawnChild($event, \&translate_do, [$self, $event, $service, $lang1, $lang2, $words], 'babelfish', []);
+    }
+}
+
diff --git a/BotModules/UUIDGen.bm b/BotModules/UUIDGen.bm
new file mode 100644
index 0000000..98461b0
--- /dev/null
+++ b/BotModules/UUIDGen.bm
@@ -0,0 +1,68 @@
+################################
+# UUIDGen Module               #
+################################
+
+# "uuidgen" should be installed on the path somewhere.
+# you can get the source of uuidgen from CVS, see:
+# http://lxr.mozilla.org/mozilla/source/webtools/mozbot/uuidgen/
+
+package BotModules::UUIDGen;
+use vars qw(@ISA);
+@ISA = qw(BotModules);
+1;
+
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    return {
+        '' => 'This module is an interface to the uuidgen application.',
+        'uuid' => 'Generates a UUID.',
+        'cid'  => 'Generates a UUID but outputs format suitable for components (CID).',
+    };
+}
+
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    if ($message =~ /^\s*uuid(?:[\s,!?]+please)?[\s,!?]*\s*$/osi) {
+        $self->spawnChild($event, 'uuidgen', [], 'UUID', []);
+    } elsif ($message =~ /^\s*cid(?:[\s,!?]+please)?[\s,!?]*\s*$/osi) {
+        $self->spawnChild($event, 'uuidgen', [], 'CID', []);
+    } else {
+        return $self->SUPER::Told(@_);
+    }
+    return 0; # we've dealt with it, no need to do anything else.
+}
+
+# ChildCompleted - Called when a child process has quit
+sub ChildCompleted {
+    my $self = shift;
+    my ($event, $type, $output, @data) = @_;
+    if ($type eq 'UUID') {
+        chop($output);
+        $output .= " (/msg $nicks[$nick] cid for CID form)";
+        $self->say($event, $output);
+    } elsif ($type eq 'CID') {
+        # remove newline
+        chop($output);
+        my @split = split(/-/, $output);
+        $output = "{0x$split[0], 0x$split[1], 0x$split[2], {";
+
+        my @rest = $split[3] =~ m/(..)(..)/;
+        push(@rest, $split[4] =~ m/(..)(..)(..)(..)(..)(..)/);
+
+        foreach (@rest) {
+            $output .= "0x$_, ";
+        }
+
+        # remove the space and comma
+        chop($output);
+        chop($output);
+
+        $output .= "}}\n";
+        $self->say($event, $output);
+    } else {
+        return $self->SUPER::ChildCompleted(@_);
+    }
+}
+
diff --git a/BotModules/WWW.bm b/BotModules/WWW.bm
new file mode 100644
index 0000000..ffbdf01
--- /dev/null
+++ b/BotModules/WWW.bm
@@ -0,0 +1,136 @@
+################################
+# WWW Module                   #
+################################
+
+package BotModules::WWW;
+use vars qw(@ISA);
+# Need HTML::Entities for decode_entities() in wwwtitle
+use HTML::Entities;
+@ISA = qw(BotModules);
+1;
+
+# RegisterConfig - Called when initialised, should call registerVariables
+sub RegisterConfig {
+    my $self = shift;
+    $self->SUPER::RegisterConfig(@_);
+    # $self->registerVariables(
+    #   # [ name, save?, settable? ]
+    #     ['x', 1, 1, 0], 
+    # );
+}
+
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    return {
+        '' => 'The WWW module provides a web interface.',
+        'wwwsize' => 'Reports on the size of a webpage. Syntax: \'wwwsize http://...\'',
+        'wwwlint' => 'Reports on whether the webpage contains any obvious (I mean _really_ obvious) no-nos like  or document.all. Syntax: \'wwwlint http://...\'',
+        'wwwdoctype' => 'Reports on the doctype of a webpage. (Warning: Does not check that the doctype is not commented out!) Syntax: \'wwwdoctype http://...\'',
+        'wwwtitle' => 'Tries to heuristically determine a web page\'s title. Syntax: \'wwwtitle http://...\'',
+    };
+}
+
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    if ($message =~ /^\s*wwwsize\s+(.+?)\s*$/osi) {
+        $self->Fetch($event, $1, 'size');
+    } elsif ($message =~ /^\s*wwwlint\s+(.+?)\s*$/osi) {
+        $self->Fetch($event, $1, 'lint');
+    } elsif ($message =~ /^\s*wwwdoctype\s+(.+?)\s*$/osi) {
+        $self->Fetch($event, $1, 'doctype');
+    } elsif ($message =~ /^\s*wwwtitle\s+(.+?)\s*$/osi) {
+        $self->Fetch($event, $1, 'title');
+    } else {
+        return $self->SUPER::Told(@_);
+    }
+    return 0; # dealt with it...
+}
+
+sub Fetch {
+    my $self = shift;
+    my ($event, $uri, $type) = @_;
+    $self->getURI($event, $uri, $type);
+}
+
+sub GotURI {
+    my $self = shift;
+    my ($event, $uri, $output, $type) = @_;
+    my $chars = length($output);
+    if ($type eq 'size') {
+        if ($chars) {
+            $self->say($event, "$uri is $chars bytes long.");
+        } else {
+            $self->say($event, "$uri is either empty, or I could not download it.");
+        }
+    } elsif ($type eq 'lint') {
+        # ignore whether things are commented out or not.
+        unless ($chars) {
+            $self->say($event, "$uri is either empty, or I could not download it.");
+        } else {
+            my @status;
+            if ($output =~ /document\.all/os) {
+               push(@status, 'document.all');
+            }
+            if ($output =~ /document\.layers/os) {
+               push(@status, 'document.layers');
+            }
+            if ($output =~ / tag');
+            }
+            if (@status) {
+                my $status = shift(@status);
+                if (@status) {
+                    while (scalar(@status) > 1) {
+                        $status .= ', '.shift(@status);
+                    }
+                    $status .= ' and '.shift(@status);
+                }
+                $self->say($event, "$uri contains $status.");
+            } else {
+                $self->say($event, "$uri doesn't have any _obvious_ flaws..."); # XXX doesn't work! try php.net
+            }
+        }
+    } elsif ($type eq 'doctype') {
+        # assume doctype is not commented. 
+        unless ($chars) {
+            $self->say($event, "$uri is either empty, or I could not download it.");
+        } elsif ($output =~ /(]*>)/osi) {
+            my $doctype = $1;
+            $doctype =~ s/[\n\r]+/ /gosi;
+
+            # -- #mozilla was here --
+            #       it would break 99% of the web if we didn't do it that way.
+            #       including most of my test cases ;-)
+            #      test cases don't matter...
+            #      you'll fix them if we decide they're wrong
+            #      but the web is a problem
+
+            if (length($doctype) > 220) { # arbitrary length greater than two 80 character lines
+                $self->say($event, "$uri has a very long and possibly corrupted doctype (maybe it has an internal subset).");
+            } else {
+                $self->say($event, "$uri has the following doctype: $doctype");
+            }
+        } else {
+            $self->say($event, "$uri has no specified doctype.");
+        }
+    } elsif ($type eq 'title') {
+        # assume doctype is not commented. 
+        unless ($chars) {
+            $self->say($event, "$uri is either empty, or I could not download it.");
+        } elsif ($output =~ /(.*?)<\/title\s*>/osi or
+                 $output =~ /(.*?)<\/h1\s*>/osi) {
+            my $title = $1;
+            $title =~ s/\s+/ /gosi;
+            if (length($title) > 100) { # arbitrary length
+                $title = substr($title, 0, 100) . '...';
+            }
+            $self->say($event, "$uri has the following title: " . decode_entities($title));
+        } else {
+            $self->say($event, "$uri has no specified title.");
+        }
+    } else {
+        return $self->SUPER::GotURI(@_);
+    }
+}
diff --git a/BotModules/Wishlist.bm b/BotModules/Wishlist.bm
new file mode 100644
index 0000000..c0e7c03
--- /dev/null
+++ b/BotModules/Wishlist.bm
@@ -0,0 +1,55 @@
+################################
+# Wishlist Module              #
+################################
+
+package BotModules::Wishlist;
+use vars qw(@ISA);
+@ISA = qw(BotModules);
+1;
+
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    my $reply = {
+        '' => 'A module to store wishlist items, typically used to file bugs on the bot, but really for that you should use Bugzilla -- https://bugzilla.mozilla.org/ -- component MozBot in product Webtools.',
+        'wish' => 'Adds an item to the wishlist. Please use Bugzilla for this purpose though, see https://bugzilla.mozilla.org/ product Webtools, component Mozbot. Syntax: \'wish \'',
+        'wishes' => 'Causes the bot to list all the wishes that have been made. Since this may be long, it may only be done in a /msg. Syntax: \'wishes\'',
+    };
+    $$reply{''} .= ' To remove wishes, use the following command: vars Wishlist wishes \'-\'' if $self->isAdmin($event);
+    return $reply;
+}
+
+# RegisterConfig - Called when initialised, should call registerVariables
+sub RegisterConfig {
+    my $self = shift;
+    $self->SUPER::RegisterConfig(@_);
+    $self->registerVariables(
+      # [ name, save?, settable? ]
+        ['wishes', 1, 1, []],
+        ['reply', 1, 1, 'Noted!'],
+    );
+}
+
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    if ($message =~ /^\s*(?:i\s+)?wish(?:list)?[-\s:.,;!]+(...+?)\s*$/osi) {
+        push(@{$self->{'wishes'}}, "<$event->{'from'}> $1");
+        $self->say($event, "$event->{'from'}: $self->{'reply'}");
+        $self->saveConfig();
+    } elsif ($message =~ /^\s*wishes[\s?]*$/osi) {
+        if (@{$self->{'wishes'}}) {
+            $self->directSay($event, 'Wishes:');
+            foreach (@{$self->{'wishes'}}) {
+                $self->directSay($event, " $_");
+            }
+            $self->directSay($event, 'End of wishes.');
+        } else {
+            $self->directSay($event, 'No-one has wished for anything!');
+        }
+        $self->channelSay($event, "$event->{'from'}: wishlist /msg'ed");
+    } else {
+        return $self->SUPER::Told(@_);
+    }
+    return 0; # we've dealt with it, no need to do anything else.
+}
diff --git a/BotModules/XMLLogger.bm b/BotModules/XMLLogger.bm
new file mode 100644
index 0000000..9e81e06
--- /dev/null
+++ b/BotModules/XMLLogger.bm
@@ -0,0 +1,219 @@
+# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
+################################
+# XMLLogger Module             #
+################################
+# Original Author: Matt Jones
+# National Center for Ecological Analysis and Synthesis (NCEAS)
+# University of California Santa Barbara
+#
+# This package creates an XML log file of the messages sent to IRC channels
+# which mozbot has joined.  The content that is logged can be selected using
+# regular expression filters, although by default all messages are logged
+
+package BotModules::XMLLogger;
+use vars qw(@ISA);
+@ISA = qw(BotModules);
+1;
+
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    my $help = {
+        '' => 'This module keeps an XML log of channels.',
+    };
+    if ($self->isAdmin($event)) {
+        $help->{''} .= ' It can be configured to only accept messages matching certain patterns. The \'acceptedPatterns\' module variable is a list of regular expressions to use when determining what to log. The \'blockedPatterns\' list is the opposite.';
+        $help->{'rotatelogs'} = 'Creates a new log file for each channel and moves the old one to a date-stamped version, making sure that the XML is valid. Syntax: \'rotatelogs\'.';
+    }
+    return $help;
+}
+
+# RegisterConfig - Called when initialised, should call registerVariables
+sub RegisterConfig {
+    my $self = shift;
+    $self->SUPER::RegisterConfig(@_);
+    $self->registerVariables(
+      # [ name, save?, settable? ]
+        ['acceptedPatterns', 1, 1, ['']], # by default match everything
+        ['blockedPatterns', 1, 1, []], # by default block nothing
+    );
+}
+
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    if ($self->isAdmin($event)) {
+        if ($message =~ /^\s*rotate\s*logs?\s*$/osi) {
+            $self->RotateLogs($event);
+        } else {
+            return $self->SUPER::Told(@_);
+        }
+    } else {
+        return $self->SUPER::Told(@_);
+    }
+    return 0; # we've dealt with it, no need to do anything else.
+}
+
+sub Log {
+    my $self = shift;
+    my ($event) = @_;
+    if (($event->{'firsttype'} eq 'Told') or
+        ($event->{'firsttype'} eq 'Heard')) {
+        $self->DoLog($event, 'msg');
+    } elsif (($event->{'firsttype'} eq 'Felt') or
+             ($event->{'firsttype'} eq 'Saw')) {
+        $self->DoLog($event, 'emote');
+    } elsif (($event->{'firsttype'} eq 'SpottedKick') or
+             ($event->{'firsttype'} eq 'Kicked')) {
+        $self->DoLog($event, 'kick');
+    } elsif ($event->{'firsttype'} eq 'SpottedPart') {
+        $self->DoLog($event, 'part');
+    } elsif ($event->{'firsttype'} eq 'SpottedQuit') {
+        $self->DoLog($event, 'quit');
+    } elsif ($event->{'firsttype'} eq 'SpottedJoin') {
+        $self->DoLog($event, 'join');
+    } elsif ($event->{'firsttype'} eq 'SpottedNickChange') {
+        $self->DoLog($event, 'nick');
+    } elsif ($event->{'firsttype'} eq 'ModeChange') {
+        $self->DoLog($event, 'mode');
+    } elsif ($event->{'firsttype'} eq 'SpottedTopicChange') {
+        $self->DoLog($event, 'topic');
+    } # XXX should log notices
+    return $self->SUPER::Log(@_);
+}
+
+sub DoLog {
+    my $self = shift;
+    my ($event, $messageType) = @_;
+    if ($event->{'channel'} ne '') { # don't log private messages
+        foreach my $pattern (@{$self->{'acceptedPatterns'}}) {
+            my $regexp = $self->sanitizeRegexp($pattern);
+            if (($regexp eq '') ||
+                ($event->{'fulldata'} =~ /$regexp/s) ||
+                ($event->{'from'} =~ /$regexp/s)) {
+                # wohay, we have a candidate!
+                # now check for possible blockers...
+                unless ($self->isBlocked($event)) {
+                    $self->WriteMessage($event->{'time'},
+                                        $event->{'channel'},
+                                        $event->{'from'},
+                                        $event->{'fulldata'},
+                                        $messageType);
+                    return; # only store each message once, regardless of how many patterns it matches
+                }
+            }
+        }
+    }
+}
+
+sub isBlocked {
+    my $self = shift;
+    my ($event) = @_;
+    foreach my $blockedPattern (@{$self->{'blockedPatterns'}}) {
+        my $regexp = $self->sanitizeRegexp($blockedPattern);
+        if ($event->{'data'} =~ /$regexp/s) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
+sub WriteMessage {
+    my $self = shift;
+    my ($time, $channel, $from, $message, $messageType) = @_;
+    # Open the log file and append the message
+    $channel = $self->sanitiseChannelName($channel);
+    my $logName = $self->getLogFilename("$channel.xml.part");
+    if (open(LOG, ">>$logName")) {
+        my $msgtime = $self->logdate($time);
+        # sanitise the output
+        $_ = $self->escapeXML($_) for ($messageType, $channel, $from, $msgtime, $message);
+        print LOG "<$messageType channel=\"$channel\" nick=\"$from\" time=\"$msgtime\">$message\n";
+        close(LOG);
+    } else {
+        $self->debug("Error logging, failed to open log $logName");
+    }
+}
+
+sub RotateLogs {
+    my $self = shift;
+    my ($event) = @_;
+    my $errors = 0;
+    foreach my $channel (@{$self->{'channels'}}) {
+        $self->debug("Rotating log for $channel...");
+        # XXX could (optionally) output message to channel saying so
+        $errors += $self->RotateLogFile($event, $channel);
+    }
+    $errors = $errors == 1 ? "$errors error" : "$errors errors";
+    $self->say($event, "Finished rotating logs, $errors.");
+}
+
+sub RotateLogFile {
+    my $self = shift;
+    my ($event, $channel) = @_;
+
+    # create new names
+    $channel = $self->sanitiseChannelName($channel);
+    my $time = $self->filedate($event->{'time'});
+    my $partName = $self->getLogFilename("$channel.xml.part");
+    my $finalName = $self->getLogFilename("$channel-$time.xml");
+
+    # try to finalise file
+    if (-e $finalName) {
+        $self->debug("error rotating log for $channel, destination already existed");
+        return 1; # report error
+    } elsif (not (-e $partName and -s $partName)) {
+        $self->debug("skipping $channel log rotation, log was empty");
+        return 0; # not an error condition
+    } elsif (open(FinalLog, ">$finalName")) {
+        # opened new file, add the XML and copy the data over
+        print FinalLog "\n"; # XXX optional -- do we really want to add this?
+        print FinalLog "\n";
+        open(PartLog, "<$partName"); # XXX error checking
+        while (defined($_ = )) {
+            print FinalLog;
+        }
+        close(PartLog);
+        print FinalLog "";
+        close(FinalLog);
+        unlink($partName); # delete the part log, ready for new data
+    } else {
+        $self->debug("error rotating log for $channel, failed to open $finalName");
+        return 1; # doh, report error
+    }
+    return 0
+}
+
+# logdate: return nice looking date and time stamp
+sub logdate {
+    my $self = shift;
+    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift or time());
+    return sprintf("%d-%02d-%02dT%02d:%02d:%02dZ", $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
+}
+
+# return a date and time stamp suitable for file names
+sub filedate {
+    my $self = shift;
+    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift or time());
+    return sprintf('%d%02d%02d-%02d%02d%02d', $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
+}
+
+sub sanitiseChannelName {
+    my $self = shift;
+    my($channel) = @_;
+    $channel =~ s/([^\#&+a-zA-Z0-9-])//gosi; # sanitize
+    $channel =~ m/^(.*)$/os; # detaint
+    return $1;
+}
+
+# escape XML characters as needed
+sub escapeXML {
+    my $self = shift;
+    my ($string) = @_;
+    $string =~ s/&/&/gos;
+    $string =~ s/'/'/gos;
+    $string =~ s/"/"/gos;
+    $string =~ s//>/gos;
+    return $string;
+}
diff --git a/BotModules/devel.txt b/BotModules/devel.txt
new file mode 100644
index 0000000..ca3bb1e
--- /dev/null
+++ b/BotModules/devel.txt
@@ -0,0 +1,993 @@
+MODULE API DOCUMENTATION  
+========================
+
+This file documents the mozbot 2.5 bot module API.
+Revisions are welcome.
+
+Sample module
+-------------
+
+Here is the HelloWorld module:
+
+################################
+# Hello World Module           #
+################################
+
+package BotModules::HelloWorld;
+use vars qw(@ISA);
+@ISA = qw(BotModules);
+1;
+
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    return {
+        '' => 'This is the demo module that says Hello World.',
+        'hi' => 'Requests that the bot emit a hello world string.',
+    };
+}
+
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    if ($message =~ /^\s*hi\s*$/osi) {
+        $self->say($event, 'Hello World!');
+    } else {
+        return $self->SUPER::Told(@_);
+    }
+}
+
+################################
+
+
+Creating a module
+-----------------
+
+Modules are perl objects with names that start with 'BotModules::'
+and that are stored in files with the '.bm' extension in the
+'BotModules' directory. The first non-comment line of each module
+should be the 'package' line, which in the HelloWorld module reads:
+
+   package BotModules::HelloWorld;
+
+For a module to work correctly, it should inherit from the
+'BotModules' module (which is implemented internally in the main bot
+executable). This is done by including the following two lines
+immediately after the 'package' line:
+
+   use vars qw(@ISA);
+   @ISA = qw(BotModules);
+
+Since modules are dynamically loaded and unloaded, they should avoid
+using package globals. All variables should be stored in the '$self'
+blessed hashref. For more details, see the documentation of the
+'Initialise' function (below). Another result of the dynamic nature
+of modules is that they should not use BEGIN {} or END {} blocks, nor
+should they execute any code during their evaluation. Thus,
+immediately after the @ISA... line, the module should return success.
+This can be done easily:
+
+   1;
+
+Following this, you are free to implement all the functions you need
+for your module. Certain functions have certain calling semantics,
+these are described below.
+
+
+Module Functions
+----------------
+
+This section contains the names and descriptions of the functions in
+your module that will be called automatically depending on what is
+happening on IRC.
+
+All your functions should start by shifting the $self variable from
+the argument list:
+
+   my $self = shift;
+
+After this, it is common to get the other variables too:
+
+   my ($event, @anythingElse) = @_;
+
+...where the bit in the brackets is given in the brackets of the
+definitions of the functions as shown below. For example, for
+JoinedChannel it would be ($event, $channel), so a function to
+override the default JoinedChannel action would be something like:
+
+   sub JoinedChannel {
+       my $self = shift;
+       my ($event, $channel) = @_;
+       # ...
+       return $self->SUPER::JoinedChannel($event, $channel); # call inherited method
+   }
+
+Many functions have to return a special value, typically 0 if the
+event was handled, and 1 if it was not.
+
+For these functions, what actually happens is that for the relevant
+event, the bot has a list of event handlers it should call. For
+example, if someone says 'bot: hi' then the bot wants to call the
+Told() handler and the Baffled() handler. It first calls the Told()
+handler of every module. It then looks to see if any of the handlers
+returned 0. If so, it stops. Note, though, that every Told() handler
+got called! If none of the handlers returned 0, then it looks to see
+what the highest return value was. If it was greater than 1, then it
+increments the 'level' field of the $event hash (see below) and calls
+all the Told() handlers that returned 1 or more again. This means that
+if your module decides whether or not to respond by looking at a
+random number, it is prone to being confused by another module!
+
+   YOU SHOULD NOT USE RANDOM NUMBERS TO DECIDE WHETHER OR NOT TO
+   RESPOND TO A MESSAGE!
+
+Once all the relevant Told() handlers have been called again, the 
+bot once again examines all the return results, and stops if any 
+returned 0. If none did and if the current value of the level field 
+is less than the highest number returned from any of the modules, 
+then it repeats the whole process again. Once the level field is 
+equal to the highest number returned, then, if no module has ever
+returned 0 in that whole loopy time, it moves on to the next
+handler in the list (in this case Baffled()), and does the
+_entire_ process again.
+
+You may be asking yourself "Why oh why!". It is to allow you to
+implement priority based responses. If your module returns '5' to
+the Told() function, and only handles the event (i.e., only
+returns 0) once the level field is 5, then it will only handle the
+event if no other module has wanted to handle the event in any of
+the prior levels.
+
+It also allows inter-module communication, although since that is
+dodgy, the details are left as an exercise to the reader.
+
+Important: if you use this, make sure that you only reply to the 
+user once, based on the $event->{'level'} field. e.g., if you
+replied when level was zero, then don't reply _again_ when it is
+set to 1. This won't be a problem if your module only returns 1
+(the default) or 0 (indicating success).
+
+
+*** Help($event)
+
+ Every module that does anything visible should provide a 'Help'
+ function. This is called by the General module's 'help' command
+ implementation.
+
+ This function should return a hashref, with each key representing a
+ topic (probably a command) and each value the relevant help string.
+ The '' topic is special and should contain the help string for the
+ module itself.
+
+
+*** Initialise()
+
+ Called when the module is loaded.
+
+ No special return values.
+
+
+*** Schedule($event)
+
+ Schedule - Called after bot is set up, to set up any scheduled
+ tasks. See 'schedule' in the API documentation below for information
+ on how to do this.
+
+ No special return values. Always call inherited function!
+
+
+*** JoinedIRC($event)
+
+ Called before joining any channels (but after module is setup). This
+ does not get called for dynamically installed modules.
+
+ No special return values. Always call inherited function!
+
+
+*** JoinedChannel($event, $channel)
+
+ Called after joining a channel for the first time, for example if
+ the bot has been /invited.
+
+ No special return values. Always call inherited the function, as this
+ is where the autojoin function is implemented.
+
+
+*** PartedChannel($event, $channel)
+
+ Called after the bot has left a channel, for example if the bot has 
+ been /kicked.
+
+ No special return values. Always call inherited the function, as this
+ is where the autopart function is implemented.
+
+
+*** InChannel($event)
+
+ Called to determine if the module is 'in' the channel or not.
+ Generally you will not need to override this.
+
+ Return 0 if the module is not enabled in the channel in which the
+ event occured, non zero otherwise.
+
+
+*** IsBanned($event)
+
+ Same as InChannel(), but for determining if the user is banned or
+ not.
+
+ Return 1 if the user that caused the event is banned from this
+ module, non zero otherwise.
+
+
+*** Log($event)
+
+ Called once for most events, regardless of the result of the 
+ other handlers. This is the event to use if you wish to log
+ everything that happens on IRC (duh).
+
+ No return value.
+
+
+*** Baffled($event, $message)
+
+ Called for messages prefixed by the bot's nick which we don't
+ understand (i.e., that Told couldn't deal with).
+
+ Return 1 if you can't do anything (this is all the default
+ implementation of Baffled() does).
+
+
+*** Told($event, $message)
+
+ Called for messages heard that are prefixed by the bot's nick. See
+ also Baffled.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation of Told() does).
+
+
+*** Heard($event, $message)
+
+ Called for all messages not aimed directly at the bot, or those
+ aimed at the bot but with no content (e.g., "bot!!!").
+
+ Return 1 if you can't do anything (this is all the default
+ implementation of Heard() does).
+ 
+
+*** Noticed($event, $message)
+
+ Called for all 'notice' messages, whether aimed directly at the bot
+ or not. Don't use this message to trigger responses! Doing so is a
+ violation of the IRC protocol.
+
+ To quote RFC 1459: 
+
+ # [...] automatic replies must never be sent in response to a NOTICE
+ # message. [...] The object of this rule is to avoid loops between a
+ # client automatically sending something in response to something it
+ # received. This is typically used by automatons (clients with either
+ # an AI or other interactive program controlling their actions) which
+ # are always seen to be replying lest they end up in a loop with
+ # another automaton.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation of Noticed() does).
+ 
+
+*** Felt($event, $message)
+
+ Called for all emotes containing bot's nick.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation of Felt() does).
+
+
+*** Saw($event, $message)
+
+ Called for all emotes except those directly at the bot.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** Invited($event, $channel)
+
+ Called when bot is invited into another channel.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** Kicked($event, $channel)
+
+ Called when bot is kicked out of a channel.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** ModeChange($event, $what, $change, $who)
+
+ Called when either the channel or a person has a mode flag changed.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** GotOpped($event, $channel, $who)
+
+ Called when the bot is opped. (Not currently implemented.)
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** GotDeopped($event, $channel, $who)
+
+ Called when the bot is deopped. (Not currently implemented.)
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** Authed($event, $who)
+
+ Called when someone authenticates with us. Note that you cannot
+ do any channel-specific operations here since authentication is
+ done directly and without any channels involved. (Of course,
+ you can always do channel-wide stuff based on a channel list...)
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** SpottedNickChange($event, $from, $to)
+
+ Called when someone changes their nick. You cannot use directSay
+ here, since $event has the details of the old nick. And 'say' is
+ useless since the channel is the old userhost string... This may be
+ changed in a future implementation.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** SpottedTopicChange($event, $channel, $newtopic)
+
+ Called when the topic in a channel is changed.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** SpottedJoin($event, $channel, $who)
+
+ Called when someone joins a channel (including the bot).
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** SpottedPart($event, $channel, $who)
+
+ Called when someone leaves a channel (including the bot).
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** SpottedKick($event, $channel, $who)
+
+ Called when someone leaves a channel, um, forcibly (including the
+ bot).
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** SpottedQuit($event, $who, $why)
+
+ Called when someone leaves a server. You can't use say or directSay
+ as no channel involved and the user has quit, anyway (obviously).
+ This may change in future implementations (don't ask me how, please...).
+
+ This does not get called for the bot itself. There is no way to
+ reliably detect this (the core code itself has difficulty detecting
+ this case, and sometimes only detects it when it is not really in a
+ position to call into the modules). You may wish to use the 'unload'
+ handler or 'DESTROY' function instead.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** SpottedOpping($event, $channel, $who)
+
+ Called when someone is opped. (Not currently implemented.)
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** SpottedDeopping($event, $channel, $who)
+
+ Called when someone is... deopped, maybe? (Not currently implemented.)
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** CTCPPing($event, $who, $what)
+
+ Called when the bot receives a CTCP ping.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** CTCPVerson($event, $who, $what)
+
+ Called when the bot receives a CTCP verson.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** CTCPSource($event, $who, $what)
+
+ Called when the bot receives a CTCP source.
+
+ Return 1 if you can't do anything (this is all the default
+ implementation does).
+
+
+*** Scheduled($event, @data)
+
+ Called when a scheduled timer triggers. (See 'schedule' in the next
+ section to see how to schedule stuff.) By default, if the first
+ element of the @data array is a coderef, then the coderef is called
+ with ($event,@data) as the arguments. Otherwise, 'debug' is called
+ (see below).
+
+ No special return values. Always call inherited function if you
+ cannot handle the scheduled event yourself.
+
+
+*** GotURI($event, $uri, $contents, @data)
+
+ Called when a requested URI has been downloaded. $contents contains
+ the actual contents of the file. See getURI().
+
+ No special return values.
+
+
+*** ChildCompleted($event, $type, $output, @data)
+
+ Called when a spawned child has completed. $output contains
+ the output of the process. $type contains the child type as
+ given to the spawnChild() API function (which see).
+
+ No special return values. Always call the inherited function if
+ you cannot handle the given '$type'!
+
+
+*** DataAvailable($event, $handle, $data, $closed)
+
+ Called when $handle has data available. See registerDataHandle(). 
+ $data is the string that was read from the handle. Don't perform
+ blocking read I/O on $handle, since all the data that was available
+ has been read. (The handle is only returned because it is expected
+ you will use that as a key to work out who is talking to you.)
+ The $closed argument will be set to true if the handle is now closed.
+
+ No special return values. Make sure to call the inherited function if
+ you did not expect to see data on the specified $handle.
+
+
+*** RegisterConfig()
+
+ Called when initialised, should call registerVariables(), which see
+ below.
+
+ No special return values. Always call inherited function!
+
+
+*** Set($event, $variable, $value)
+
+ Called to set a variable to a particular value.
+
+ Should return one of the following:
+  -1 - silent success (caller should not report back to user)
+   0 - success
+   1 - can't set variable because it is of type ref($module->{$variable})
+   2 - variable not found or not writable (if $module->{$variable})
+   3 - variable is list and wrong format was used
+   4 - variable is hash and wrong format was used
+   9 - unknown error
+ 
+ Note that error codes 1-4 are probably too specific to the default
+ 'Set' function to be of any use. Reporting your own error messages
+ is fine.
+
+ Always call inherited function if you cannot set the variable yourself!
+
+
+*** Get($event, $variable)
+
+ Called to get a particular variable.
+
+ Should return the value of the variable. Default returns the value
+ of $self->{$variable}.
+
+ Always call inherited function if you cannot get the variable yourself!
+
+
+*** Unload()
+
+ Called when the module is unloaded. However, this is not always
+ reliably called when the module is unloaded immediately prior to the
+ bot shutting down or branching to a different process.
+
+ In general, relying on this function is poor design. It should only
+ really be used for things like untie-ing from hashes or disconnecting
+ from databases, where the code executing is not critical, merely good
+ manners or helpful.
+
+ No special return values. You are encouraged not to use this method. 
+ It is documented for completeness only.
+
+ Default implementation does nothing.
+
+
+
+The $event variable is a hash with the following keys:
+
+    'bot' => the IRC bot object - DO NOT USE THIS!!! [1]
+    'channel' => the channel the event occured in, or '' if n/a [2]
+    'from' => the nick of the person who created the event, if any
+    'target' => the target of the 'say' function (channel || from)
+    'user' => the userhost of the event
+    'data' => the main data of the event
+    'fulldata' => the data of the event before it got mangled [3]
+    'to' => the target of the event
+    'subtype' => the IRC module's idea of what the event was [1]
+    'maintype' => the name of the first handler called (eg. 'Told')
+    'level' => the number of times the handler has been called in a row
+    'userName' => the name of the user as they authenticated
+    'userFlags' => used internally for the implementation of isAdmin() [1]
+    'nick' => the nick of the bot
+    'time' => the value of time() when the event was constructed [4]
+
+It is passed to most functions, as the first parameter. Modify at your 
+own risk! ;-) If you do write to this hash at all, ensure that you make 
+a 'local' copy first. See the 'Parrot' module for an example of safely 
+modifying the $event hash. Note that some of these fields may be 
+inaccurate at times, due to peculiarities of the IRC protocol.
+
+[1]: These fields are dependent on the underlying implementation, so
+if you use them then your modules will not be compatible with any other
+implementations that use the same API. The 'bot' field in particular is
+a blessed reference to a Net::IRC::Connection object in this 
+implementation, and is passed around so that the API functions know
+what to operate on. However, in a POE implementation it could be 
+something totally different, maybe even undef. There are some other
+fields in the $event hash that start with an underscore (in particular
+there is '_event'). Do not even _think_ about using those. Using them
+is akin to hard-coding the ionode of the 'ls' program into your source
+so that you can read directories by branching to a disk address.
+
+[2]: The 'channel' field is ALWAYS lowercase. You should always lowercase
+any channel names you get from users before using them in comparisons or
+hash lookups.
+
+[3]: This is the same as the 'data' slot except for Told and Baffled
+events where it also contains the prefix that was stripped.
+
+[4]: Use this instead of calling time() so as to avoid time drift when
+comparing times at various points.
+
+
+Module API
+----------
+
+This section contains the names and descriptions of the functions
+that your module can call. While you can override these, it is not
+recommended.
+
+*** debug(@messages)
+
+ Outputs each item in @messages to the console (or the log file if
+ the bot has lost its controlling tty).
+
+ Example:
+    $self->debug('about to fetch listing from FTP...');
+
+
+*** saveConfig()
+
+ Saves the state of the module's registered variables to the
+ configuration file. This should be called when the variables have
+ changed.
+
+ Example:
+    $self->saveConfig(); # save our state!
+
+
+*** registerVariables( [ $name, $persistent, $settable, $value ] )
+
+ Registers variables (duh). It actually takes a list of arrayrefs.
+ The first item in each arrayref is the name to use (the name of the
+ variable in the blessed hashref that is the module's object, i.e.
+ $self). The second controls if the variable is saved when
+ saveConfig() is called. If it is set to 1 then the variable is
+ saved, if 0 then it is not, and if undef then the current setting is
+ not changed. Similarly, the third item controls whether or not the
+ variable can be set using the 'vars' command (in the Admin
+ module). 1 = yes, 0 = no, undef = leave unchanged. The fourth value,
+ if defined, is used to set the variable. See the Initialise
+ function's entry for more details.
+
+ Example:
+    $self->registerVariables(
+        [ 'ftpDelay', 1, 1, 60 ],
+        [ 'ftpSite', 1, 1, 'ftp.mozilla.org' ],
+    );
+
+ Only simple scalars, references to arrays of scalars, and references
+ to hashes of scalars, can be stored in registered variables.
+
+
+*** schedule($event, $time, $times, @data)
+
+ Schedules one or more events. $event is the usual event hash. $time
+ is the number of seconds to wait. It can be a scalarref to a
+ variable that contains this number, too, in which case it is
+ dereferenced. This comes in useful for making the frequency of
+ repeating events customisable. $times is the number of times to
+ perform the event, which can also be -1 meaning 'forever'. @data
+ (the remainder of the parameters) will be passed, untouched, to the
+ event handler, Scheduled. See the previous section.
+
+ Example:
+    $self->schedule($event, \$self->{'ftpDelay'}, -1, 'ftp', \$ftpsite); 
+
+
+*** getURI($event, $uri, @data)
+
+ Gets a URI in the background then calls GotURI (which see, above).
+
+ Example:
+    $self->getURI($event, $ftpsite, 'ftp'); 
+
+
+*** spawnChild($event, $command, $arguments, $type, $data)
+
+ Spawns a child in the background then calls ChildCompleted (which see, 
+ above). $arguments and $data are array refs! $command is either a 
+ command name (e.g., 'wget', 'ls') or a CODEREF. If it is a CODEREF,
+ then you will be wanting to make sure that the first argument is
+ the object reference, unless we are talking inlined code or something...
+
+ Example:
+    $self->spawnChild($event, '/usr/games/fortune', ['-s', '-o'], 
+                      'fortune', [@data]); 
+
+
+*** registerDataHandle($event, $handle)
+
+ Adds $handle to the list of file handles and sockets to watch. When
+ data is available on that socket, DataAvailable() will be called.
+
+
+*** getModule($name)
+
+ Returns a reference to the module with the given name. In general you
+ should not need to use this, but if you write a management module, for
+ instance, then this could be useful. See God.bm for an example of this.
+
+            IT IS VITAL THAT YOU DO NOT KEEP THE REFERENCE 
+                    THAT THIS FUNCTION RETURNS!!!
+
+ If you did so, the module would not get garbage collected if it ever
+ got unloaded or some such.
+
+ Example:
+    my $module = $self->getModule('Admin');
+    push(@{$module->{'files'}}, 'BotModules/SupportFile.pm');
+
+
+*** getModules()
+
+ Returns the list of module names that are loaded, in alphabetical
+ order, which you can then use with getModule().
+
+ Example:
+    my @modulenames = $self->getModules();
+    local $" = ', ';
+    $self->ctcpReply($event, 'VERSION', "mozbot $VERSION (@modulenames)");
+
+
+*** getMessageQueue()
+
+ Returns a reference to the message queue. Manipulating this is
+ probably not a good idea. In particular, don't add anything to this
+ array, use the say(), directSay(), channelSay(), announce(),
+ tellAdmin(), etc, methods defined below.
+
+ Each item in this array is an array ref, consisting of three
+ subitems. The first subitem is a scalar with the name of the channel
+ or nick targetted, the second is the message to send, and the third
+ is a scalar equal to one of: 'msg', 'me', 'notice', 'ctcpSend',
+ 'ctcpReply'. The second subitem is a scalar, except in the case of
+ 'ctcpSend' messages, in which case it's an array ref consisting of
+ first the type of the CTCP message, and then the data.
+
+ Note: Don't use 'delete' to remove items from this array, since that
+ leaves undefs in the array, which will later cause a crash.
+
+ Example:
+    my $queue = $self->getMessageQueue();
+    foreach my $message (@$queue) {
+        ++$count if $message->[0] eq $event->{'from'};
+    }
+
+
+*** getHelpLine()
+
+ Returns the bot's help line.
+
+ Example:
+    $self->say($event, $self->getHelpLine());
+
+
+*** getLogFilename($name)
+
+ Returns a filename (with path) appropriate to use for logging. $name
+ should be the filename wanted, without a path.
+
+ Example:
+    my $logName = $self->getLogFilename("$channel.log");
+    if (open(LOG, ">>$logName")) {
+        print LOG $data;
+        close LOG;
+    } else {
+        # XXX error handling
+    }
+
+
+*** unescapeXML($xml)
+
+ Performs the following conversions on the argument and returns the result: 
+    ' => '
+    " => "
+    <   => <
+    >   => >
+    &  => &
+
+ Example:
+    my $text = $self->unescapeXML($output);
+
+
+*** tellAdmin($event, $data);
+
+ Tries to tell an administrator $data. As currently implemented, only
+ one administrator will get the message, and there is no guarentee
+ that they will read it or even that the admin in question is
+ actually on IRC at the time.
+
+ Example:
+    $self->tellAdmin($event, 'Someone just tried to crack me...');
+
+
+*** say($event, $data)
+ 
+ Says $data in whatever channel the event was spotted in (this can be
+ /msg if that is how the event occured).  
+
+ Example:
+    $self->say($event, 'Yo, dude.');
+
+
+*** announce($event, $data)
+ 
+ Says $data in all the channels the module is in.
+
+ Example:
+    $self->announce($event, 'Bugzilla is back up.');
+
+
+*** directSay($event, $data)
+
+ Sends a message directly to the cause of the last event (i.e., like
+ /msg). It is recommended to use 'say' normally, so that users have a
+ choice of whether or not to get the answer in the channel (they
+ would say their command there) or not (they would /msg their
+ command).
+
+ Example:
+    $self->directSay($event, 'Actually, that\'s not right.');
+
+
+*** channelSay($event, $data)
+
+ Sends a message to the channel in which the message was given.
+ If the original command was sent in a /msg, then this will result
+ in precisely nothing. Useful in conjunction with directSay() to 
+ make it clear that a reply was sent privately.
+
+ Example:
+    $self->directSay($event, $veryLongReply);
+    $self->channelSay($event, "$event->{'from'}: data /msg'ed");
+
+
+*** emote($event, $what)
+*** directEmote($event, $what)
+
+ Same as say() and directSay(), but do the equivalent of /me instead.
+
+ Examples:
+    $self->emote($event, "slaps $event->{'from'} with a big smelly trout.");
+    $self->directEmote($event, "waves.");
+
+
+*** sayOrEmote($event, $what)
+*** directSayOrEmote($event, $what)
+
+ Call say (directSay) or emote (directEmote) based on the contents of $what.
+ If $what starts with '/me' then the relevant emote variation is called,
+ otherwise the say variations are used. The leading '/me' is trimmed before
+ being passed on.
+
+ Examples:
+    $self->sayOrEmote($event, $greeting);
+    $self->directSayOrEmote($event, $privateMessage);
+
+
+*** ctcpSend($event, $type, $data)
+
+ Same as say() but for sending CTCP messages.
+
+ Examples:
+    $self->ctcpSend($event, 'PING', $event->{'time'});
+
+
+*** ctcpReply($event, $type, $data)
+
+ Same as ctcpSend() but for sending CTCP replies.
+
+ Examples:
+    $self->ctcpReply($event, 'VERSION', "Version $major.$minor");
+
+
+*** notice($event, $data)
+ 
+ Sends a notice containing $data to whatever channel the event was
+ spotted in (this can be /msg if that is how the event occured).
+
+ Example:
+    foreach (@{$self->{'channels'}}) {
+        local $event->{'target'} = $_;
+        $self->notice($event, 'This is a test of the emergency announcement system.');
+    }
+
+
+*** isAdmin($event)
+
+ Returns true if the cause of the event was an authenticated administrator.
+
+ Example:
+    if ($self->isAdmin($event)) { ... }
+
+
+*** setAway($event, $message)
+
+ Set the bot's 'away' flag. A blank message will mark the bot as
+ back. Note: If you need this you are doing something wrong!!!
+ Remember that you should not be doing any lengthy processes since if
+ you are away for any length of time, the bot will be disconnected!
+
+ Also note that in 2.0 this is not throttled, so DO NOT call this
+ repeatedly, or put yourself in any position where you allow IRC
+ users to cause your module to call this. Otherwise, you open
+ yourself to denial of service attacks.
+
+ Finally, note that calling 'do', 'emote', 'say', and all the 
+ related functions will also reset the 'away' flag.
+
+ Example:
+    $self->setAway($event, 'brb...');
+
+
+*** setNick($event, $nick)
+
+ Set the bot's nick. This handles all the changing of the internal
+ state variables and saving the configuration and everything.
+ It will also add the nick to the list of nicks to try when
+ the bot finds its nick is already in use.
+
+ Note that in 2.0 this is not throttled, so DO NOT call this
+ repeatedly, or put yourself in any position where you allow IRC
+ users to cause your module to call this. Otherwise, you open
+ yourself to denial of service attacks.
+
+ Example:
+    $self->setNick($event, 'zippy');
+
+
+*** mode($event, $channel, $mode, $argument)
+
+ Changes a mode of channel $channel.
+
+ Example:
+    $self->mode($event, $event->{'channel'}, '+o', 'Hixie');
+
+
+*** invite($event, $who, $channel)
+
+ Invite $who to channel $channel. This can be used for intrabot
+ control, or to get people into a +i channel, for instance.
+
+ Example:
+    $self->invite($event, 'Hixie', '#privateChannel');
+
+
+*** prettyPrint($preferredLineLength, $prefix, $indent, $divider, @input)
+
+ Takes @input, and resorts it so that the lines are of roughly the same
+ length, aiming optimally at $preferredLineLength, prefixing each line
+ with $indent, placing $divider between each item in @input if they 
+ appear on the same line, and sticking $prefix at the start of it all on
+ the first line. The $prefix may be undef.
+
+ Returns the result of all that.
+
+ This is what the 'help' command uses to pretty print its output.
+
+ This is basically the same as wordWrap() but it can change the order
+ of the input.
+
+ Example:
+    my @result = $self->prettyPrint($linelength, undef, 'Info: ', ' -- ', @infoItems);
+
+
+*** wordWrap($preferredLineLength, $prefix, $indent, $divider, @input)
+
+ Takes @input, and places each item sequentially on lines, aiming optimally
+ at $preferredLineLength, prefixing each line with $indent, placing $divider
+ between each item in @input if they appear on the same line, and sticking 
+ $prefix at the start of it all on the first line, without ever cutting
+ items across lines. The $prefix may be undef.
+
+ Returns the result of all that.
+
+ This is basically the same as prettyPrint() but it doesn't change the
+ order of the input.
+
+ Example:
+    my @result = $self->wordWrap($linelength, undef, 'Info: ', ' ', split(/\s+/os, @lines);
+
+
+*** days($time)
+
+ Returns a string describing the length of time between $time and now.
+
+ Example:
+    $self->debug('uptime: '.$self->days($^T));
+
+
+*** sanitizeRegexp($regexp)
+
+ Checks to see if $regexp is a valid regular expression. If it is, returns
+ the argument unchanged. Otherwise, returns quotemeta($regexp), which should
+ be safe to use in regular expressions as a plain text search string.
+
+ Do not add prefixes or suffixes to the pattern after sanitizing it.
+ 
+ Example:
+     $pattern = $self->sanitizeRegexp($pattern);
+     $data =~ /$pattern//gsi;
+
+
+-- end --
diff --git a/INSTALL b/INSTALL
new file mode 100644
index 0000000..c349977
--- /dev/null
+++ b/INSTALL
@@ -0,0 +1,443 @@
+                       _           _ 
+        m o z i l l a |.| o r g   | | 
+    _ __ ___   ___ ___| |__   ___ | |_ 
+   | '_ ` _ \ / _ \_  / '_ \ / _ \| __|
+   | | | | | | (_) / /| |_) | (_) | |_ 
+   |_| |_| |_|\___/___|_.__/ \___/ \__|
+   ====================================
+
+
+INSTALLATION
+------------
+
+You will need the following programs and libraries to run mozbot2:
+
+   perl
+   wget
+   Net::IRC
+   Net::SMTP   
+   IO::Select  
+   IO::Pipe    
+
+These packages may have additional requirements of their own.
+
+In order to do anything useful with mozbot2, you will need some Bot
+Modules. Several are included in this distribution, and they may have
+requirements above and beyond those given above.
+
+Once you have set up all the packages on which mozbot2 depends, make
+mozbot.pl executable:
+
+   chmod +x mozbot.pl
+
+This is needed since mozbot2 will occasionally attempt to restart
+itself (e.g. if its source code is changed).
+
+Then, simply run mozbot.pl:
+
+   ./mozbot.pl
+
+Currently, you MUST run mozbot from the directory in which mozbot.pl
+is placed. This may be changed in a future version.
+
+
+SECURITY
+--------
+
+Since mozbot interacts with the outside world, do not run it as a
+privileged user!!!
+
+In addition, since mozbot calls external programs (currently perl and
+wget, possibly others in future versions) make sure that none of the
+directories on your path are writable by untrusted users! (e.g., do
+not put /tmp into your path!)
+
+Make sure that '.' is not in your path! This is a security risk in a
+situation like this, and perl will rightly refuse to execute external
+programs (like wget, used to get remote URIs for many functions) if
+'.' is on your path.
+
+Do not run the bot straight into a public channel on the first run!
+
+One important reason not to load the bot straight into a public
+channel on the first run is that until it has been properly
+configured, it will have a well defined username and password to
+access all its admin functions. Thus a malicious user could hijack the
+bot the moment it joined the channel.
+
+If this is a serious problem for you (e.g., your users are of a
+particularly high calibre and are doing regular polls of the /who
+command to see if any bots join) then use another server, such as one
+that you control, on localhost!
+
+See the "Administration" section for instructions on how to change the
+administration password (important!).
+
+Note: Passwords are printed in clear text on the console and in the
+log files. Secure them accordingly. Of course, IRC is an inherently
+insecure protocol anyway, and any machine between your IRC client's
+and your bot's, going through the IRC network's servers, will have
+access to the passwords. For this reason, change them often, and don't
+use passwords that you use for important things here.
+
+The default setting is for mozbot to run with taint checking
+enabled. I *STRONGLY* recommend not changing this.
+
+
+CONFIGURATION
+-------------
+
+When you start up mozbot for the first time, it will prompt you for
+the following information:
+
+   1. IRC server.
+      What machine you want the bot to connect to. At the moment,
+      mozbot only supports connecting to a single server at a time. It
+      would require a *significant* amount of work to change this.
+
+   2. Port. 
+      What port to connect to on the IRC server. Typically, this will
+      be 6667 or therabouts.
+
+   3. Password.
+      If your server has a password, enter it here. If there isn't one
+      (and this is almost certainly the case) then just hit enter.
+
+   4. Channels.
+      What channels the bot should initially connect to. It is
+      recommended that this just be a bot channel or a test channel,
+      for example #mozbot, since running a bot for the first time
+      before it is known to be ready is a bad idea. You can enter more
+      than one channel, just hit enter after each one (leave a blank
+      line when you have finished). (To make mozbot join a keyed
+      channel, you must first add the channel's key to the
+      'channelKeys' variable. To do this, the bot will have to be on
+      IRC first, so don't worry about it for now.)
+
+   5. Your e-mail address.
+      In case of great difficulties, mozbot may try to e-mail you. If
+      this happens, it will use the e-mail address you gave here. This
+      only happens if (a) it absolutely cannot connect to the server
+      you gave it, or (b) it cannot find a nick that is not in use.
+
+   6. SMTP server. 
+      The name of the SMTP server it should try to talk with in order
+      to send you mail. If you type in an invalid server name, it will
+      just fail to send mail and instead will complain bitterly to its
+      console.
+
+   7. Nicks.
+      Some nicks for IRC. For example, 'mozbot'. It is customary to
+      clearly mark the bot as being non-human, for example by putting
+      'bot' in the name. You should enter several possibilities
+      here. Hit enter after each one. Leave a blank line to finish.
+
+Once the bot is running, there are many other things that can be
+configured with it. See "variables".
+
+Note. The bot will treat all channel names as lowercase to avoid case
+sensitivity issues.
+
+
+LOGGING
+-------
+
+Normally, mozbot will output its complaints to the console
+(stdout). If you run mozbot in an xterm or screen session, you can
+therefore easily keep track of what is going on.
+
+It will also continuously log output to ~/logs/$0.$$.log, where $0 is
+the file name and $$ is the PID. You may wish to set up a cron job to
+prune this file on a regular basis, it gets LARGE. However, it can
+sometimes be the only way to track down how your system was
+compromised if it turns out that mozbot has a security flaw.
+
+Control over the logging is currently not available. This may change
+in future versions.
+
+Note that when the bot forks and then outputs a message, which happens
+occasionally, it will therefore use a new log file for the forked
+process. This should only happen when something bad happens,
+e.g. something forces the bot to restart or the bot forks and then the
+child enters a bad state.
+
+Note. Authentication passwords will be displayed in cleartext on the
+console and in the log files.
+
+
+ADMINISTRATION
+--------------
+
+Once the bot is active and on the IRC server, it starts to listen to
+all messages seen on any channels on which it is present, and all
+messages sent to it using /msg.
+
+Your first task should be to change the admin password. To do this,
+authenticate yourself using the "auth" command. The default username
+is "admin", and the default password is "password". If the bot is
+called "mozbot", then the command to authenticate would be as follows:
+
+   /msg mozbot auth admin password
+
+The bot should respond with "Hi admin!".
+
+Now create yourself an account by adding a username/password pair to
+the bot. You do this with the "newuser" command. Next, you should
+bless this new user, making it a bot administrator. This is done using
+these commands:
+
+   /msg mozbot newuser   
+   /msg mozbot bless 
+
+Now authenticate yourself again, as the new user:
+
+   /msg mozbot auth  
+
+The moment you authenticate as the new admin, the default admin
+account is deleted.
+
+You are now in a position to add the modules you want and to put the
+bot in the channels you want it in.
+
+To load modules is easy.
+
+   /msg mozbot load module
+
+...where "module" is a module name, such as "HelloWorld" (note that
+the ".bm" extension is not included). By default, the General,
+Greeting, Infobot and Parrot modules are loaded. The General module
+provides the 'help' command and responds to CTCP VERSION messages. The
+Greeting module responds to greetings and generally tries to be
+friendly. The Infobot module provides information storage and
+retrieval functions. The Parrot module lets an admin control the bot
+much like a puppet.
+
+By default, modules will be enabled in all channels. See the
+"variables" section below to change this.
+
+
+HINTS
+-----
+
+If the bot goes mad and starts flooding a channel -- e.g., if someone
+keeps asking it for information -- then authenticate and then send it
+the following message:
+
+   /msg mozbot shutup please
+
+It should respond within a few seconds. You can authenticate while it
+is speaking, that's not a problem.
+
+
+VARIABLES
+---------
+
+For information on changing variables on the fly, use the "vars"
+command:
+
+   /msg mozbot vars
+
+Each module has several variables that you can change. You can see
+what they are by typing:
+
+   /msg mozbot vars module
+
+...where module is the module in question. These always include
+"Admin" and "General". Admin provides the commands such as "auth",
+"newuser", "password", and provides additional commands to admins,
+such as "shutdown", "cycle", "leave", "restart", and so on. "General"
+provides the "help" command to everyone.
+
+The main variables are:
+
+   channels -- which channels the module should listen in, and which
+   channels the module should send announcements to. Must be in
+   lowercase!
+
+   channelKeys -- a mapping of (lowercase) channel names to keys. It
+   is assumed that any channel without an entry in this variable has
+   no key. For example, to tell mozbot that the key for channel
+   #channel is 'password', you would use:
+
+      /msg mozbot vars Admin channelKeys '+|#channel|password'
+
+   autojoin -- whether (1) or not (0) the module should automatically
+   add a new channel to its "channels" list when the bot joins a new
+   channel. If this is not enabled, then you will have to add new
+   channels to the "channels" list of this module each time.
+
+   channelsBlocked -- channels that will not be autojoined, so if a
+   module has been disabled, it won't rejoin the channel if the bot is
+   kicked then reinvited.
+
+   denyusers -- user@host regexp masks of users that should be
+   completely ignored (for this module). The regexp will be placed
+   between "^" and "$" modifiers, so do not include them, and *do*
+   include everything required to make the whole user@host mask match.
+
+   allowusers -- identical in usage to denyusers, but checked first to
+   override it. So to give access to everyone but a few people, leave
+   allowusers blank and add some masks to denyusers, but to give
+   access to only a few people, add their user@host masks to
+   allowusers, and add ".*" to denyusers.
+
+In addition, other modules may have extra variables.
+
+The admin variable has quite a few variables, including all those that
+are prompted for during initial startup. The interesting ones are:
+
+   currentnick -- the nick. This can be changed on the fly.
+
+   server, port, password -- the server and port to connect to, and
+   the server password to use. If you change these and then cycle the
+   bot (/msg mozbot cycle) then the bot will change servers without
+   shutting down.
+
+   localAddr -- if you don't seem to be able to establish a
+   connection, but it works fine with other software, then you should
+   try setting the localAddr variable to your IP address. Technically,
+   this variable sets which interface to use to form the outgoing
+   connection. (This is to work around a limitation of Net::IRC.) 
+   Typically you would set this variable directly in the configuration
+   file, by adding a line that says "localAddr=10.11.12.13" or
+   whatever your IP address is.
+
+   simpleIRCNameServer -- if the value of this variable equals the
+   name of the server, then the IRC Name sent to the server will be
+   simplified so that it doesn't include the URI of the mozbot help
+   files. This is usually dealt with automatically, but if you are
+   having troubles connecting, you could try setting it. (It is set to
+   the name of the server so that if you change servers, by default
+   mozbot will use a complete IRC Name again.)
+
+   username -- if this variable has a true value, then the bot will
+   use its value as its IRC username. By default, the bot uses
+   "pid-1234" as the username, where "1234" is the bot's process ID. 
+   This can cause problems on networks or with BNCs that require a
+   valid and accurate ident, in which case this variable can provide a
+   solution. (You can also set this variable by entering
+   "username=blah" into the configuration file, where blah is the
+   username you want to use.)
+
+   channels -- unlike other modules, the channels variable for the
+   Admin module actually controls which channels the bot itself
+   appears in. The preferred method for controlling this is using
+   /invite and /kick or "join" and "part", though (since editing the
+   list directly will probably require a cycle of the bot to take
+   effect).
+
+   admins -- the administrators. See "Administration" above.
+
+   allowInviting -- this controls whether the /invite IRC command will
+   be obeyed or not.
+
+   allowChannelAdmin -- this controls whether or not the bot will
+   accept admin commands that are given in a channel or not. In any
+   case, the "auth" command is never accepted in a channel.
+
+   files -- this is a list of files whose timestamps are monitored to
+   decide if the source code has changed. If it is established that
+   any of these files have changed while the bot is running, then the
+   bot will shutdown and restart itself. Modules are dealt with
+   separately, and need not be listed here. (And when modules change,
+   the whole bot is not restarted, only the module.)
+
+   sourceCodeCheckDelay -- number of seconds between checks of the bot
+   and module sources. Note that changes will only take effect after
+   the previous timer has passed, so changing it from 3600 (an hour)
+   to 10 (10 seconds) may not be of much immediate use. In these
+   cases, setting the variable to the new value then cycling the bot
+   is a good plan.
+
+   ignoredUsers -- a list of regular expressions that are matched
+   against the user@host strings of everything that is said. If a user
+   matches one of the entires in this list, then that user will be
+   completely ignored. (^ and $ symbols are implied at the start and
+   end of this regular expression.) Use this sparingly. It will stop
+   the user's statements from having _any_ effect on the bot,
+   including in any statistic-collecting modules, etc. If you just
+   want to block a user from certain modules, add a regular expression
+   to the 'denyusers' variable of those modules.
+   Example:
+      >mozbot< vars Admin ignoredUsers '+root@.*'
+      *** moron (root@example.org) has joined #mozbot
+       mozbot: help
+      * you watch the tumbleweed roll on by
+
+   ignoredTargets -- when someone says something to someone who
+   matches one of the regular expressions in this list, the line will
+   be ignored as if the person saying it was banned with ignoreUsers. 
+   This is useful when you have other bots in the channel, and don't
+   want the mozbot to respond in place of the other bots (e.g. with an
+   auto-helping Infobot module). Note: It is safe to user a regular
+   expression that matches the mozbot bot's name; it will always
+   respond to messages to itself (as well as messages that are sent
+   via /msg) irrespective of this setting.
+   Example:
+       foobot: what is green?
+       user: green is good.
+       user: green is good.
+       mozbot: vars Admin ignoredTargets '+.*bot[0-9]*'
+       Variable 'ignoredTargets' in module 'Admin' has changed.
+       foobot: what is green?
+       user: green is good.
+      * user patpats mozbot
+
+Changes to variables are usually immediately recorded in the
+configuration file and will be saved for the next time the bot is
+loaded.
+
+There are three types of editable variables: scalars, arrays of
+scalars, and hashes of scalars.
+
+Scalars are easy, and lists are explained by the bot quite well, just
+try to set a list and it will tell you if you are doing something
+wrong!
+
+To add a value to a hash, there is a more complex syntax. For example,
+to add a new site to the list of sites that the RDF module monitors,
+use the following command:
+
+   /msg mozbot vars RDF sites '+|slashdot|http://slashdot.org/slashdot.rdf'
+
+First, note that the value is surrounded by quotes.  You can nest
+quotes without any problems, the quotes are just needed to
+differentiate significant trailing whitespace from mistakes.
+
+The "+" means you want to add a value to the hash (as you'll see in a
+minute, to remove an item you use "-"). Then, since a hash is a
+key/value pair, you have to delimit the two. In this case, we have
+used "|" as a delimiter. However, you could use anything.  The first
+occurance tells mozbot what delimiter you have picked.  The second
+separates the key (in this case the site nickname) from the value (in
+this case the URI). For example:
+
+   /msg mozbot vars RDF sites '+*key*value'
+
+You could even use a letter as a delimiter, but since that is usually
+a sign that you have forgotten to declare which delimiter you are
+using, mozbot will warn you about this. For example (the 'users' hash,
+BTW, is the hash in which all the username/password pairs are kept):
+
+   /msg mozbot vars Admin users '+sarah|lisa'
+
+...will be treated the same as:
+
+   /msg mozbot vars Admin users '+*arah|li*a'
+
+..., i.e. the username added would be "arah|li" and the password would
+be "a". This is not a bug, it's a feature. It means you can include
+any character, including "'", "|", and so on, in the key, without fear
+of it being interpreted as a delimiter.
+
+To remove a user, or any key/value pair in a hash, you use this
+syntax:
+
+   /msg mozbot vars Admin users '-admin'
+
+That's it. No need to say what the value is, since each key in a hash
+has to be unique. (Although, in this particular case, it should be
+noted that the preferred way to remove users is actually the
+'deleteuser' command.)
+
+-- end --
diff --git a/INSTALL.UNIX.CHROOT-JAIL b/INSTALL.UNIX.CHROOT-JAIL
new file mode 100644
index 0000000..b831914
--- /dev/null
+++ b/INSTALL.UNIX.CHROOT-JAIL
@@ -0,0 +1,514 @@
+                       _           _ 
+        m o z i l l a |.| o r g   | | 
+    _ __ ___   ___ ___| |__   ___ | |_ 
+   | '_ ` _ \ / _ \_  / '_ \ / _ \| __|
+   | | | | | | (_) / /| |_) | (_) | |_ 
+   |_| |_| |_|\___/___|_.__/ \___/ \__|
+   ====================================
+
+
+INTRODUCTION
+------------
+
+This was written as a living document. I (the author of mozbot 2.0)
+tried (successfully!) to set up mozbot in a secure environment,
+chrooted and setuided. This requires much more than a usual
+installation. So, without further ado, over to myself in the field:
+
+
+GETTING STARTED
+---------------
+
+I will first be trying to install mozbot 2.0 on a SPARC machine
+running Sun Solaris. These instructions will probably work for any
+sane UNIX system. If you use Windows, see the INSTALL.WIN32 file.
+
+    mkdir mozbot
+    cd mozbot
+    version
+   Machine hardware:   sun4u
+   OS version:         5.7
+   Processor type:     sparc
+   Hardware:           SUNW,Ultra-60
+
+I already had Emacs 20.7 installed on the machine, for which I must
+thank Pavlov. You may, of course, use any editor of your choosing when
+doing this, although if you use vi or one of its siblings then don't
+even _think_ about asking me for help. (If you can understand vi I
+figure mozbot should no problem.)
+
+    mkdir mozbot
+    cd mozbot
+
+I also had several gigabytes of free disk space. You'll probably need
+several hundred megabytes to do all of this (including scratch space).
+(I believe the end result was around 30 megs for everything in the
+chroot jail directory.)
+
+
+PERL
+----
+
+The first thing on my list was to install Perl.
+
+    mkdir resources
+    cd resources
+    wget http://www.perl.com/CPAN/src/stable.tar.gz
+    tar xvfz stable.tar.gz
+
+Next I read the README and INSTALL files:
+
+    cd perl-5.6.0/
+    emacs-20.7 README INSTALL
+
+This told me how to do the next few bits.
+
+    rm -f config.sh Policy.sh
+    sh Configure -Dprefix=/u/ianh/mozbot
+
+By providing a prefix, the default installation directory for a lot of
+modules I am about to install is automatically set up correctly. So if
+you don't install Perl yourself, remember to take this into account!
+
+Note: I didn't change any of the build options, so threads, debugging
+and the like are all disabled (or at their defaults). The only things
+I changed were that I answered 'n' to the question 'Binary
+compatibility with Perl 5.005?', which defaulted to 'y', and I told it
+not to install into '/usr/bin/perl'.
+
+    make
+    make test
+    make install
+    cd ..
+
+At this point I had Perl installed correctly in my mozbot directory.
+
+
+WGET
+----
+
+The next thing to install was wget.
+
+    wget ftp://ftp.gnu.org/pub/gnu/wget/wget-1.6.tar.gz
+    tar xvfz wget-1.6.tar.gz
+    cd wget-1.6
+    emacs-20.7 README INSTALL
+    ./configure --prefix=/u/ianh/mozbot
+    make
+    make install
+    cd ..
+
+No problems, no difficulties.
+
+
+MOZBOT
+------
+
+Now, before going on any further with installing the required modules,
+I needed to find what those were. Ergo, the next thing to install was
+mozbot. Presumably you already have the relevant files, or know where
+to get them, since you are reading a file that comes with the source.
+
+    wget http://www.damowmow.com/mozilla/mozbot/mozbot.tar.gz
+
+There is no configuration, makefile or install script for mozbot,
+since there is nothing to compile or particularly install. So, I just
+extracted the mozbot tarball directly inside what would be the root of
+the file system when I eventually chroot()ed.
+
+    cd ../..
+    tar xvfz mozbot/resources/mozbot.tar.gz
+
+Like all shell scripts, one thing to change about it is the location
+of the Perl executable in the shebang.
+
+    cd mozbot
+    emacs-20.7 mozbot.pl
+
+Since I'll be running it from the version of Perl I just installed, I
+changed the first line to read:
+
+   #!./bin/perl -wT
+
+Note that this requires me to run mozbot from the mozbot directory. If
+you've read the README file, you'll know that this is a prerequisite
+of running mozbot anyway.
+
+
+Net::IRC
+--------
+
+If you tried running mozbot now, you'd find it was missing
+Net::IRC. So, guess what I installed next? ;-)
+
+    cd resources
+    wget http://www.cpan.org/authors/id/FIMM/Net-IRC-0.70.tar.gz
+    tar xvfz Net-IRC-0.70.tar.gz
+    cd Net-IRC-0.70
+    emacs-20.7 README
+    ../../bin/perl Makefile.PL
+    make
+    make install
+    cd ..
+
+It is important to use the Perl we just installed and not any other
+Perl on the system, otherwise you'll get incorrect prefixes and
+stuff. (I didn't bother to use the wget I just installed...)
+
+
+Net::SMTP
+---------
+
+Yup, you guessed it, Net::SMTP is next.
+
+    wget http://www.cpan.org/authors/id/GBARR/libnet-1.0703.tar.gz
+    tar xvfz libnet-1.0703.tar.gz
+    cd libnet-1.0703
+    emacs-20.7 README
+    ../../bin/perl Makefile.PL
+
+I answered 'y' to the question 'Do you want to modify/update your
+configuration (y|n) ? [no]', which was asked because the system
+had already had libnet installed once.
+
+I kept the defaults for all the options though.
+
+    make
+    make test
+    make install
+    cd ..
+
+This also installed Net::FTP, which is required by some of the modules
+(in particular, the FTP module!).
+
+
+INITIAL CONFIGURATION
+---------------------
+
+Now I needed to set up the environment for mozbot. The only real thing
+that needs setting up is the PATH variable. So:
+
+    cd ..
+    emacs-20.7 run-mozbot-chrooted
+
+Here are the contents of my run-mozbot-chrooted script:
+
+   export PATH=/u/ianh/mozbot/bin
+   ./mozbot.pl
+
+It is absolutely imperative that the path not contain '::' or '.'
+anywhere, as this will be treated as the current directory, which will
+then result in perl exiting with taint errors.
+
+Now we make it executable:
+
+    chmod +x run-mozbot-chrooted
+
+(Note. a sample run-mozbot-chrooted script is shipped with mozbot --
+it still requires you to follow all these steps though.)
+
+
+INITIAL RUN
+-----------
+
+At this point, mozbot is runnable... so I ran it!
+
+    ./run-mozbot-chrooted
+
+Note that I'm running it via my script and not directly. If you were
+not intending to run mozbot in a chroot() jail environment, then
+'./mozbot.pl' would be sufficient.
+
+It prompted me for various things, like servers and so on. Then it
+connected without problems but with no modules set up, as I expected.
+
+On IRC, I configured mozbot as I wanted it:
+
+   /query mozbot
+   mozbot auth admin password
+   newuser Hixie newpass newpass
+   bless Hixie
+   auth Hixie newpass
+
+I also played a bit with the configuration variables:
+
+   vars Admin throttleTime '2.2'
+
+This was all very well, but no modules makes mozbot a boring bot, so
+the next thing was...
+
+
+FILTERS
+-------
+
+I shut down mozbot ('shutdown please') and installed the filters
+required by the 'Filters' BotModule.
+
+    cd resources
+    wget ftp://ftp.debian.org/pub/mirrors/debian/dists/potato/main/source/games/filters_2.9.tar.gz
+    tar xvfz filters_2.9.tar.gz
+    cd filters
+    emacs-20.7 README
+    make
+
+At this point, I edited the Makefile to change /usr/.../ so as to
+point in the places we used for installing Perl.
+
+    make install PREFIX=/u/ianh/mozbot
+    cd ..
+ 
+I should point out that this didn't go too well and I had to hack
+about with the Makefile and my environment and so on, so good luck
+(admittedly, Pavlov happened to install a new compiler at the same
+time, and didn't bother to install a license for it, so I had a few
+more problems than you should, but...).
+
+You should also make sure that the shebang lines in the five relevant
+perl scripts that you should make sure ended up in ~/mozbot/bin
+actually point to the right perl executable. I had to edit the files
+by hand.
+
+
+Net::Telnet
+-----------
+
+In order to insult people, the Rude module needs to Telnet:
+
+    wget http://www.cpan.org/authors/id/JROGERS/Net-Telnet-3.02.tar.gz
+    tar xvfz Net-Telnet-3.02.tar.gz
+    cd Net-Telnet-3.02
+    emacs-20.7 README
+    ../../bin/perl Makefile.PL
+    make
+    make test
+    make install
+    cd ..
+
+That went a lot smoother than the filters installation, let me tell
+you! ;-)
+
+
+WWW::Babelfish
+--------------
+
+The translation module requires a whole bunch of other modules, mainly
+due to its dependency on WWW::Babelfish, which requires half of libwww
+and also IO::String. libwww itself requires another half a dozen
+modules, namely URI, MIME-Base64, HTML::Parser, libnet (which I
+installed earlier, thankfully), and Digest::MD5. And HTML-Parser
+requires HTML-Tagset!
+
+I found these dependencies out by browsing CPAN reading README files.
+
+    lynx http://www.cpan.org/
+
+Thankfully, they all installed rather smoothly. Here is the complete
+list of commands I used to install WWW::Babelfish (starting in the
+'resources' directory):
+
+   wget http://www.cpan.org/authors/id/GAAS/MIME-Base64-2.12.tar.gz
+   tar xvfz MIME-Base64-2.12.tar.gz
+   cd MIME-Base64-2.12
+   ../../bin/perl Makefile.PL
+   make
+   make test
+   make install
+   cd ..
+
+   wget http://www.cpan.org/authors/id/GAAS/URI-1.11.tar.gz
+   tar xvfz URI-1.11.tar.gz
+   cd URI-1.11
+   ../../bin/perl Makefile.PL
+   make
+   make test
+   make install
+   cd ..
+
+   wget http://www.cpan.org/authors/id/S/SB/SBURKE/HTML-Tagset-3.03.tar.gz
+   tar xvfz HTML-Tagset-3.03.tar.gz
+   cd HTML-Tagset-3.03
+   ../../bin/perl Makefile.PL
+   make
+   make test
+   make install
+   cd ..
+
+   wget http://www.cpan.org/authors/id/GAAS/HTML-Parser-3.19_91.tar.gz
+   tar xvfz HTML-Parser-3.19_91.tar.gz
+   cd HTML-Parser-3.1991
+   ../../bin/perl Makefile.PL
+   make
+   make test
+   make install
+   cd ..
+
+   wget http://www.cpan.org/authors/id/GAAS/Digest-MD5-2.13.tar.gz
+   tar xvfz Digest-MD5-2.13.tar.gz
+   cd Digest-MD5-2.13
+   ../../bin/perl Makefile.PL
+   make
+   make test
+   make install
+   cd ..
+
+   wget http://www.cpan.org/authors/id/GAAS/libwww-perl-5.51.tar.gz
+   tar xvfz libwww-perl-5.51.tar.gz
+   cd libwww-perl-5.51
+   ../../bin/perl Makefile.PL
+   make
+   make test
+   make install
+   cd ..
+
+   wget http://www.cpan.org/authors/id/GAAS/IO-String-1.01.tar.gz
+   tar xvfz IO-String-1.01.tar.gz
+   cd IO-String-1.01
+   ../../bin/perl Makefile.PL
+   make
+   make test
+   make install
+   cd ..
+
+   wget http://www.cpan.org/authors/id/D/DU/DURIST/WWW-Babelfish-0.09.tar.gz
+   tar xvfz WWW-Babelfish-0.09.tar.gz
+   cd WWW-Babelfish-0.09/
+   ../../bin/perl Makefile.PL
+   make
+   make test
+   make install
+   cd ..
+
+Yes, this is surreal. I always knew languages were hard.
+
+
+UUIDGEN
+-------
+
+The last module, the UUID generator, requires a program that you'll
+find along with mozbot in CVS. You may have this already. If you
+don't, then here's how I got my copy:
+
+    export CVSROOT=:pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot
+    cvs login
+
+The password is 'anonymous'.
+
+    cvs checkout mozilla/webtools/mozbot/uuidgen
+    cd mozilla/webtools/mozbot/uuidgen/
+    make
+    cp uuidgen ../../../../../bin
+    cd ../../../../../
+
+At this point I think I had all the required programs.
+
+
+MORE THOROUGH CONFIGURATION
+---------------------------
+
+Now that I'm ready to run mozbot chroot()ed, it is time to make the
+final preparations. Firts, I moved the resources directory out of the
+way, since I had finished with it:
+
+    mv resources ../installed-resources
+
+Next I made sure all the rights were set to read-only for people other
+than the user:
+
+    chmod -R go-w .
+
+At this point I wanted to make sure the bot started ok, so I ran the
+run-mozbot-chrooted script:
+
+    ./run-mozbot-chrooted
+
+That worked. I changed the script to:
+
+   export PATH=/bin
+   ./mozbot.pl --chroot /config/default
+
+What's this 'config' thing? Well, since we're about to chown() all the
+files to root and then setuid the script to nobody, the bot wouldn't
+be able to edit the config file if it was in the same directory as the
+source -- so I created a new directory with no rights restrictions,
+and moved the configuration file into it:
+
+    mkdir config
+    mv mozbot.pl.cfg config/default
+    chmod ugo=rwx config
+    chmod ugo=rw config/default
+
+In order to not have to change all the perl scripts, I gave them a
+fake 'mozbot' directory:
+
+    mkdir u
+    mkdir u/ianh
+    cd u/ianh
+    ln -s / mozbot
+    cd ../../
+
+At this point I ran 'su' to drop down to a root shell. Be careful!
+
+I had to copy several library files to a usr/lib directory. To do
+this, the 'truss' and 'ldd' tools came in very useful. In particular,
+I used 'truss' to watch what calls mozbot was attempting, and 'ldd' to
+find what modules dependencies Perl, wget, and the modules had.
+
+Credit should be given to Pavlov for actually doing most of this for
+me... I didn't even know 'ldd' existed until he showed me. ;-)
+
+Here is the list of the modules I copied:
+
+   usr/lib:
+   ld.so.1          libdl.so.1       libgen.so.1      libmp.so.2 
+   libresolv.so.1   libsec.so.1      nscd_nischeck    nss_files.so.1
+   libc.so.1        libdoor.so.1     libld.so.2       libnsl.so.1       
+   libresolv.so.2   libsocket.so.1   nss_compat.so.1  nss_nis.so.1
+   libcrypt_i.so.1  libelf.so.1      liblddbg.so.4    libpthread.so.1   
+   librtld.so.1     libthread.so.1   nss_dns.so.1     nss_nisplus.so.1
+
+   usr/platform/SUNW,Ultra-60:
+   libc_psr.so.1
+
+You may not need all of these.
+
+I also had to copy /dev/null, /dev/zero, /dev/tcp, /dev/ticotsord and
+/dev/udp into a new dev/ directory (hint: use 'tar' to copy devices,
+it won't work if you try to do it with 'cp'). I may not have needed
+all of these (this was slightly complicated by the fact that on
+Solaris the /dev devices are symlinks; I used 'tar' to copy the real
+devices from /devices and renamed them when I extracted the tarball):
+
+   total 4
+   drwxrwxr-x   2 root     other        512 Mar 30 14:34 .
+   drwxr-xr-x  16 root     staff        512 Mar 30 15:47 ..
+   crw-rw-r--   1 root     sys       13,  2 Mar 30 14:25 null
+   crw-rw-rw-   1 root     sys       11, 42 Jun  6  2000 tcp
+   crw-rw-rw-   1 root     sys      105,  1 Jun  6  2000 ticotsord
+   crw-rw-rw-   1 root     sys       11, 41 Jun  6  2000 udp
+   crw-rw-r--   1 root     sys       13, 12 Jun  6  2000 zero
+
+I had to copy several files from /etc into a new 'etc' directory, in
+particular:
+
+   etc:
+   group            hosts            netconfig       nsswitch.conf
+   passwd           protocols        resolv.conf     wgetrc
+
+You may wish to sanitize your 'passwd' file. For the nsswitch.conf
+file you should use the 'nsswitch.dns' file (if you have one) -- make
+sure the DNS line is 'dns files' and not 'files dns'. (Profuse thanks
+go to rfm from Sun who helped me with this.)
+
+Now I used 'chown' to make every file in /u/ianh/mozbot/ be owned by
+root, except the config directory. I also edited 'mozbot.pl' to ensure
+that the correct arguments were passed to 'setuid' and 'setgid' --
+search for 'setuid' in the source to find the right place.
+
+With that all set up, I finally could run the bot safe in the
+knowledge that it was relatively secure:
+
+    ./run-mozbot-chrooted
+
+I hope this has helped you in some way!!!
+
+-- end --
\ No newline at end of file
diff --git a/INSTALL.WIN32 b/INSTALL.WIN32
new file mode 100644
index 0000000..b92d6da
--- /dev/null
+++ b/INSTALL.WIN32
@@ -0,0 +1,29 @@
+                       _           _ 
+        m o z i l l a |.| o r g   | | 
+    _ __ ___   ___ ___| |__   ___ | |_ 
+   | '_ ` _ \ / _ \_  / '_ \ / _ \| __|
+   | | | | | | (_) / /| |_) | (_) | |_ 
+   |_| |_| |_|\___/___|_.__/ \___/ \__|
+   ====================================
+
+
+INTRODUCTION
+------------
+
+Running mozbot on windows is officially unsupported, and does not
+work at all when using ActiveState Perl, as it does not support
+forking which mozbot uses extensively.
+
+However, mozbot runs successfully on Windows with Cygwin Perl. Tested
+on Microsoft Windows XP and Windows Server 2003, Perl 5.8.4 and higher,
+including 5.10. Windows Vista and Windows Server 2008 may also work, but
+have not been tested, you're on your own.
+
+Once you have Cygwin (http://www.cygwin.com) installed with the Perl
+package, follow the instructions in the INSTALL file. You will need
+to use CPAN and install the required modules for mozbot to work
+properly.
+
+Your mileage may vary, it may not work at all for you. Good luck.
+
+-- end --
\ No newline at end of file
diff --git a/README b/README
new file mode 100644
index 0000000..cbaa94c
--- /dev/null
+++ b/README
@@ -0,0 +1,4 @@
+This is the source code for "mozbot", the IRC bot who hangs out in the
+#mozilla channel at irc.mozilla.org.
+
+See the INSTALL file for installation and configuration instructions.
diff --git a/config/CVS/Entries b/config/CVS/Entries
new file mode 100644
index 0000000..74ec028
--- /dev/null
+++ b/config/CVS/Entries
@@ -0,0 +1,2 @@
+/sample/2.0/Mon Apr 23 07:09:16 2001//TMOZBOT-2_6
+D
diff --git a/config/CVS/Repository b/config/CVS/Repository
new file mode 100644
index 0000000..e4f8f8c
--- /dev/null
+++ b/config/CVS/Repository
@@ -0,0 +1 @@
+mozilla/webtools/mozbot/config
diff --git a/config/CVS/Root b/config/CVS/Root
new file mode 100644
index 0000000..cdb6f4a
--- /dev/null
+++ b/config/CVS/Root
@@ -0,0 +1 @@
+:pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot
diff --git a/config/CVS/Tag b/config/CVS/Tag
new file mode 100644
index 0000000..0fe9246
--- /dev/null
+++ b/config/CVS/Tag
@@ -0,0 +1 @@
+NMOZBOT-2_6
diff --git a/config/sample b/config/sample
new file mode 100644
index 0000000..b56ce28
--- /dev/null
+++ b/config/sample
@@ -0,0 +1,130 @@
+connectTimeout=120
+helpline=see http://www.mozilla.org/projects/mozbot/
+sleep=60
+throttleTime=2.2
+Admin::files=lib/Configuration.pm
+Admin::files=lib/Mails.pm
+Admin::files=mozbot.pl
+Admin::files=lib/IO/SecurePipe.pm
+Bugzilla::ignoreCommentsFrom=|
+FortuneCookies::bakingTime=20
+FortuneCookies::cookies=* UNIX is a Trademark of Bell Laboratories.
+FortuneCookies::cookies=/earth is 98% full ... please delete anyone you can.
+FortuneCookies::cookies=A man is not complete until he is married -- then he is finished.
+FortuneCookies::cookies=A man with his hands in pockets feels foolish, but a man with holes in pockets feels nuts.
+FortuneCookies::cookies=A meeting is an event at which the minutes are kept and the hours are lost.
+FortuneCookies::cookies=A modem is a baudy house.
+FortuneCookies::cookies=A thunderstorm in .nl here can startle a butterfly in .au
+FortuneCookies::cookies=Anyone can make an omelet with eggs.  The trick is to make one with none.
+FortuneCookies::cookies=Best of all is never to have been born.  Second best is to die soon.
+FortuneCookies::cookies=Better to sleep with chicken than to choke it.
+FortuneCookies::cookies=Confession is good for the soul, but bad for the career.
+FortuneCookies::cookies=Confucius not: know what to say!
+FortuneCookies::cookies=Confucius say: "Is more to running BBS than finding ON.
+FortuneCookies::cookies=Confucius say: A bird in hand makes hard to blow nose.
+FortuneCookies::cookies=Confucius say: Baby conceived in automatic car shiftless bastard.
+FortuneCookies::cookies=Confucius say: I didn't say that!
+FortuneCookies::cookies=Confucius say: Is stuffy inside fortune cookie.
+FortuneCookies::cookies=Confucius say: Man who Farts in Church sits in own pew.
+FortuneCookies::cookies=Confucius say: Man who pull out too fast leave rubber.
+FortuneCookies::cookies=Confucius say: Man who stand on toilet is high on pot.
+FortuneCookies::cookies=Confucius say: Man with hand in pocket is having a ball.
+FortuneCookies::cookies=Confucius say: Man with no legs bums around.
+FortuneCookies::cookies=Confucius say: Put Rooster in Freezer Get A Stiff Cock.
+FortuneCookies::cookies=Confucius say: Shit happens.
+FortuneCookies::cookies=Confucius say: Show off always shown up in showdown.
+FortuneCookies::cookies=Confucius say: Woman who cook carrots and peas in same pot not sanitary!
+FortuneCookies::cookies=Confucius say: `A Watched Tandy Never Boots!
+FortuneCookies::cookies=Confucius say: man who smoke pot choke on handle.
+FortuneCookies::cookies=Confucius say: nothing - Because he's dead!
+FortuneCookies::cookies=Confucius say: too damn much!
+FortuneCookies::cookies=Death is nature's way of telling you to slow down.
+FortuneCookies::cookies=Debug is human, de-fix divine.
+FortuneCookies::cookies=Despite all appearances, your boss is a thinking, feeling, human being.
+FortuneCookies::cookies=Do not drink coffee in early A.M.  It will keep you awake until noon.
+FortuneCookies::cookies=Do not simplify the design of a program if a way can be found to make it complex and wonderful.
+FortuneCookies::cookies=Due to lack of disk space, this fortune database has been discontinued.
+FortuneCookies::cookies=Early to bed and early to rise and you'll be groggy when everyone else is wide awake.
+FortuneCookies::cookies=Every path has its puddle.
+FortuneCookies::cookies=Everything that you know is wrong, but you can be straightened out.
+FortuneCookies::cookies=Experience is the worst teacher.  It always gives the test first and the instruction afterward.
+FortuneCookies::cookies=Future looks spotty.  You will spill soup in late evening.
+FortuneCookies::cookies=God made machine language; all the rest is the work of man.
+FortuneCookies::cookies=He that teaches himself has a fool for a master.
+FortuneCookies::cookies=He who crosses the ocean twice without washing is a dirty double crosser.
+FortuneCookies::cookies=He who has a shady past knows that nice guys finish last.
+FortuneCookies::cookies=History repeats itself.  That's one thing wrong with history.
+FortuneCookies::cookies=Hope that the day after you die is a nice day.
+FortuneCookies::cookies=House without toilet is uncanny.
+FortuneCookies::cookies=I have a theory that it's impossible to prove anything, but I can't prove it.
+FortuneCookies::cookies=I know you're in search of yourself, I just haven't seen you anywhere.
+FortuneCookies::cookies=If at first you don't succeed, redefine success.
+FortuneCookies::cookies=If life isn't what you wanted, have you asked for anything else?
+FortuneCookies::cookies=If this fortune didn't exist, somebody would have invented it.
+FortuneCookies::cookies=If we meet a man of rare intellect, we should ask him what book he reads.
+FortuneCookies::cookies=If you are too busy to read, then you are too busy.
+FortuneCookies::cookies=If you do something right once, someone will ask you to do it again.
+FortuneCookies::cookies=If you park, don't drink, accidents cause people.
+FortuneCookies::cookies=If your aim in life is nothing, you can't miss.
+FortuneCookies::cookies=In English, every word can be verbed.  Would that it were so in our programming languages.
+FortuneCookies::cookies=In an orderly world, there's always a place for the disorderly.
+FortuneCookies::cookies=In the force if Yoda's so strong, construct a sentence with words in the proper order then why can't he?
+FortuneCookies::cookies=It is not well to be thought of as one who meekly submits to insolence and intimidation.
+FortuneCookies::cookies=It is very difficult to prophesy, especially when it pertains to the future.
+FortuneCookies::cookies=Life is too short to be taken seriously.
+FortuneCookies::cookies=Logic is a systematic method of coming to the wrong conclusion with confidence.
+FortuneCookies::cookies=Ma Bell is a mean mother!
+FortuneCookies::cookies=Man who arrives at party two hours late will find he has been beaten to the punch.
+FortuneCookies::cookies=Man who eat many prunes, sit on toilet many moons.
+FortuneCookies::cookies=Man who fight with wife all day, get no peace at night!
+FortuneCookies::cookies=Man who put head on Rail Road track to listen for train likely to end up with sudden splitting headache.
+FortuneCookies::cookies=May all your PUSHes be POPped.
+FortuneCookies::cookies=Measure with a micrometer.  Mark with chalk.  Cut with an axe.
+FortuneCookies::cookies=Message will arrive in the mail.  Destroy, before the FBI sees it.
+FortuneCookies::cookies=Never trust a computer you can't repair yourself.
+FortuneCookies::cookies=Never underestimate the power of human stupidity.
+FortuneCookies::cookies=No matter what happens, there is always someone who knew it would.
+FortuneCookies::cookies=Nondeterminism means never having to say you are wrong.
+FortuneCookies::cookies=On the eighth day, God created FORTRAN.
+FortuneCookies::cookies=One person's error is another person's data.
+FortuneCookies::cookies=One possible reason that things aren't going according to plan is that there never was a plan in the first place.
+FortuneCookies::cookies=One seldom sees a monument to a committee.
+FortuneCookies::cookies=Others can stop you temporarily, only you can do it permanently.
+FortuneCookies::cookies=Overflow on /dev/null, please empty the bit bucket.
+FortuneCookies::cookies=Passwords are implemented as a result of insecurity.
+FortuneCookies::cookies=Pause for storage relocation.
+FortuneCookies::cookies=Pretend to spank me -- I'm a pseudo-masochist!
+FortuneCookies::cookies=Quantity is no substitute for quality, but its the only one we've got.
+FortuneCookies::cookies=Real computer scientists don't comment their code.  The identifiers are so long they can't afford the disk space.
+FortuneCookies::cookies=Recursion is the root of computation since it trades description for time.
+FortuneCookies::cookies=Standards are crucial.  And the best thing about standards is: there are so many to choose from!
+FortuneCookies::cookies=The first version always gets thrown away.
+FortuneCookies::cookies=The important thing is not to stop questioning.
+FortuneCookies::cookies=The light of a hundred stars does not equal the light of the moon.
+FortuneCookies::cookies=The meek shall inherit the earth; the rest of us will go to the stars.
+FortuneCookies::cookies=The more you sweat in peace, the less you bleed in war.
+FortuneCookies::cookies=The most important early product on the way to developing a good product is an imperfect version.
+FortuneCookies::cookies=The number of feet in a yard is directly proportional to the success of the barbecue.
+FortuneCookies::cookies=The only person who always got his work done by Friday was Robinson Crusoe.
+FortuneCookies::cookies=The sun will rise in the east today, indicating nothing in particular.
+FortuneCookies::cookies=The trouble with computers is that they do what you tell them, not what you want.
+FortuneCookies::cookies=There are two ways to write error-free programs; only the third one works.
+FortuneCookies::cookies=This life is yours.  Some of it was given to you; the rest, you made yourself.
+FortuneCookies::cookies=This system will self-destruct in five minutes.
+FortuneCookies::cookies=This will be a memorable month -- no matter how hard you try to forget it.
+FortuneCookies::cookies=Those who do not understand Unix are condemned to reinvent it, poorly.
+FortuneCookies::cookies=Those who smile bring light to others
+FortuneCookies::cookies=Tomorrow will be cancelled due to lack of interest.
+FortuneCookies::cookies=War doesn't determine who's right, war determines who's left.
+FortuneCookies::cookies=War is peace.  Freedom is slavery.  Ketchup is a vegetable.
+FortuneCookies::cookies=We promise according to our hopes, and perform according to our fears.
+FortuneCookies::cookies=Wife who put husband in doghouse soon find him in cat house.
+FortuneCookies::cookies=You can always tell the people that are forging the new frontier.  They're the ones with arrows sticking out of their backs.
+FortuneCookies::cookies=You have many friends and very few living enemies.
+FortuneCookies::cookies=You may attend a party where strange customs prevail.
+FortuneCookies::cookies=You might have mail.
+FortuneCookies::cookies=You will be advanced socially, without any special effort on your part.
+FortuneCookies::cookies=You're currently going through a difficult transition period called "Life."
+FortuneCookies::cookies=panic: kernel segmentation violation. core dumped               (only kidding)
+FortuneCookies::cookiesIndex=38
+FortuneCookies::cookiesMax=10
diff --git a/factoids-are.dir b/factoids-are.dir
new file mode 100644
index 0000000000000000000000000000000000000000..6fb20e1e77f05e20c29927595bff5be5910bdb43
GIT binary patch
literal 12288
zcmeI%u?fOZ6h`4|X(zaVBRGOMft|a#fU~4=CC$rA;4f?h3nO13?}k7?j^~{sdEBo1
z+Eq>GINIFK^WNsEEmfCIpYPV^c(`AML$?429I^*|-~%6$03VWuKJbALNq`SYLmz(A
zhvh#S&dZg#Is%9J7n>af4mdOdJm3Kj>;oOp0Ugi*9nb+C(1Abe!1P(aeg8l9?fs3_
s`?^jM2OM%g@qrI~NCJFF8v4KoJ|qD?Bn^Gw10RwAACktWeQ3|V0HNbA`v3p{

literal 0
HcmV?d00001

diff --git a/factoids-are.pag b/factoids-are.pag
new file mode 100644
index 0000000000000000000000000000000000000000..6fb20e1e77f05e20c29927595bff5be5910bdb43
GIT binary patch
literal 12288
zcmeI%u?fOZ6h`4|X(zaVBRGOMft|a#fU~4=CC$rA;4f?h3nO13?}k7?j^~{sdEBo1
z+Eq>GINIFK^WNsEEmfCIpYPV^c(`AML$?429I^*|-~%6$03VWuKJbALNq`SYLmz(A
zhvh#S&dZg#Is%9J7n>af4mdOdJm3Kj>;oOp0Ugi*9nb+C(1Abe!1P(aeg8l9?fs3_
s`?^jM2OM%g@qrI~NCJFF8v4KoJ|qD?Bn^Gw10RwAACktWeQ3|V0HNbA`v3p{

literal 0
HcmV?d00001

diff --git a/factoids-is.dir b/factoids-is.dir
new file mode 100644
index 0000000000000000000000000000000000000000..89940810d9076fa0e0874b564259fd014b469619
GIT binary patch
literal 16037
zcmeHNdyE}b8J|873$;{Q%Bu^9N?F=&_t65yZCMIb9-+WOx@}tNHfQdfJ2QJ{&biEE
zZ+8n+Lkud!C`bSU37Qt7Ay$YOfoe3Bm?}Xb5FbH7Y1Cj$YDt>#ivE5x=aT({yJfK?
zYVHlQ_ug~QeDi(3@Av(_Z>Bu=jZO2MxsFpDc;ovl`~C>u*Yc0!3{ETG+ke{#v=L|{
z&_zA)d
zO?-^?hj!*qV&{#a$4`*1bn?~MgcoC-iKCVMduMOj7Ke$mr=Ppa{cG|5;8ROxWh%|S
zc_CLF=X@NKUAL9}sjhEc{>p664ZXK4ZuI?F98(ncAj=8)y#aacPYhrH~~
zGjr{U>Kc5(>v$Z@@zL_Xm7N#wxXSfp>g=@skSFy2z@8U2dwCr1wf@teB}dVpTkiVG
z?7C8kW3S8n5{p)T?%r^l3__JWYjNg&f#b31Yx`prYR~eM7@vpZjJtn6mw0~3+Gnm9
z!`eU2-GO+;ixy|@@4@lY!Cf83lj07`w@=#rZ+&}cb1akWZ+87-Sf7pKFDr(E5hJ|U
zK8-JU(e{ZrcAbCkwcLN7<%x^68PK>^aedV54{rQ!zm{EMzxAIuForjuUcbeYTCbXb
z|G8NI-GVvW-0_CE+3LnASR;22uiCK{FvpMD{j|Y&U%v5cGodr$V!NN5or_~x$BrPa
z1ZvX-_<|R4X6hd8b4-}{>T$cDa&t8GWZ^{*pP@}AHm!hRyiUNun1|~Jclat0$Jo3y
z>+Yk*f2#J+d;ab#i02D^^xkn6;8=uX&Ku7!-VmtdI2#xH*OfT-p7qq$SccJUHZIl$
zx!dZx$1mM_ik2c)mbbLuIm!N3cBZ;6ZhU#mh|0!)V|hsbSw~Z~^WV1r?r9y1WTm1`
zw0M%|lkxe`)w|}q(P2;9Jl=`@)Q+jfbV*L+|8x(nXyw!j91cPJGYrmW~V!FgZTi2{3^6i!j{xPhA
zF3~YzPM|(KvwvBKrxNjqwa@(@Cf>JaE}Ko=uGn~4)5Q6e&gC?J?kJMq#9IdYVsT-faqVK{L&f*Dk-D#8TZ)K;|`Z+hHgY@6A{+tZk
z*G*!7!%3^Uzz1iJ%_HZHb0*n8{m=hgcxCL#&s&_yHEPHAX8ptqD}i|3@{PG&h-3HP
z-`o(UA~@ORo!Yh($0NH>yk4V$ITi=%}qLHP?4
z<`Cxn$-l0^4^g<)_BC>!x!L%!U+EF4oxPU-jF&ag>bg^1Kkjqq4-O4F&VCzjbN+mH
z_5G_^@Aud`Jsa0#%{yP+a%wF7@Hx9q+}H!2nYL>S=luKa{RR2Vm>(Lt{o)vX^Jg|+
z^u561wppjw@cE$4%QSpuUZ(2*p(BO$%_rXu*|?hhda8DwUNFCt
z`nk^Xjd@|KX=Ue*^-o+w-uBpjM2<7>t@iib_3AjP*Xgr-Ab*JGOS^9$Vtswf+95WS
zz*ctlT(f^&UvIBCX#HfrVCb#(<0psnKVyrG@0tvsQd|+=(@eTygbxTra6=rrZkP!#
zQI*>8FvnK5f_f5;N^lm#Oqzny+V2t#tk(cLt%NGbxGzz4Ga?11Q6pCNir5t#^i%vv
zYbFk{&IUrOxz3apQK)MvxFK`IuSHb_@P)IljBp-4h&4U+0WqGBhALuhc%c$GL?O-i
zgkj87tL)6ujg){V*?V7BFJWdxB~nt;8!e=Uo45+yZs0=}`YNS-$tZ(|8m1W)qll#T
zQyB|iHDo176`b|NxXOJ|gXd-BETmN62UE*qr8C?wWg<*j7XYAnF;naA?k;TB^E5!f
zxFD`jnrH$hYGD**!^7;M%9jyO;dWXtuqvR5S86KjHi_SZ$5RT~3;dpuJk7RMO|osw;UV$ezIgJT>jF-b7Z%vWky;H4TsWs2;gER#^P
zN)C{28Dt^rLV;7@$aV-!OnFSux1lQ(gF-7(F(OB$XDWqup%_Tqg0QH=BKM&Wil)fF
z(i~<=F`|s29LE(bQEe@iINcRy!A~*_7X+uW#6WD4nzRziXEQ3S=qimS++XNYnhA}S
zYQj2We@HWL6lEskI1|)Q8$09<@(O>G5Fooyq=pJH7=x$y9^+k${=pGxJtZty$6zIj
zy362{pNFDqGLx40x)QLUfHaDLqG6F?g{3A>D)`Y?6NWwgIrh)!=
zc>JW10at0}AcY5!fl`NhJVy;Hv}K9KX_UQ8fg{Sbj{Q{>
zATXeCV!hlBRcIjNp&w%nrmXAC4<2->?IJ~fpia;tmSy+IsD$o!qt%oS6Uj9}7Doek
zQ_>qK7_i1Q-q?W1q@RKYX_$>?9IRu{MSA1IegqkTmF{ld*1$fx2y}%xV$VUiE>K4n
zNr3((d^V^OBq>!u!-iQ2fMMYm7&@*ZlX&dJ<2ftdZ(F@
zWFx%b%_Ji(6|3ZG86I>Um+lf4vnI7kf8biW5`nS@-MjGHrLYkUn%uYh3$V*pC1X2tSW!oieBxP?O
z2AZOcu&XprV&39nUP9JDIKX8=5F}=xa?VAZo3M;I1qq5tEMz59VN@g)xMO@`uuZ>H
zba0h$)mS`2h>sF(^_VMsp!%e7Bs10`k74C240DwZfAD9iz{
zDwC>BEhe)X)u8CA0G#JFPeQVwBbdmF(Tqh@v}aTUiUE5mlt?^M&Y^{TU_p`&yvBr)
z3t!=(uW%+56`hYm7L;Rnm=SkDSZXXbj*|EteO(m#*j>&6oJlzL#)Z5AI0#lH0GVA8
z21o%;f~pFh1igA%}fVS6$Y#-G`R0?jA4+G`lLD@e8`)94`F@yF<<#v}t2(Hb;!PNiabp-Lcd
z#dcN(xet9VJ4vA!J3tQ@m7CNQu&X
z@B-e|S&7XC;98MF)1)k`PcSKaR_XfH`rAo#y!Q%=OYQ%A*OQe{8y3u-zErlHL9~e++s2x(JP#ivE5x=aT({yJfK?
zYVHlQ_ug~QeDi(3@Av(_Z>Bu=jZO2MxsFpDc;ovl`~C>u*Yc0!3{ETG+ke{#v=L|{
z&_zA)d
zO?-^?hj!*qV&{#a$4`*1bn?~MgcoC-iKCVMduMOj7Ke$mr=Ppa{cG|5;8ROxWh%|S
zc_CLF=X@NKUAL9}sjhEc{>p664ZXK4ZuI?F98(ncAj=8)y#aacPYhrH~~
zGjr{U>Kc5(>v$Z@@zL_Xm7N#wxXSfp>g=@skSFy2z@8U2dwCr1wf@teB}dVpTkiVG
z?7C8kW3S8n5{p)T?%r^l3__JWYjNg&f#b31Yx`prYR~eM7@vpZjJtn6mw0~3+Gnm9
z!`eU2-GO+;ixy|@@4@lY!Cf83lj07`w@=#rZ+&}cb1akWZ+87-Sf7pKFDr(E5hJ|U
zK8-JU(e{ZrcAbCkwcLN7<%x^68PK>^aedV54{rQ!zm{EMzxAIuForjuUcbeYTCbXb
z|G8NI-GVvW-0_CE+3LnASR;22uiCK{FvpMD{j|Y&U%v5cGodr$V!NN5or_~x$BrPa
z1ZvX-_<|R4X6hd8b4-}{>T$cDa&t8GWZ^{*pP@}AHm!hRyiUNun1|~Jclat0$Jo3y
z>+Yk*f2#J+d;ab#i02D^^xkn6;8=uX&Ku7!-VmtdI2#xH*OfT-p7qq$SccJUHZIl$
zx!dZx$1mM_ik2c)mbbLuIm!N3cBZ;6ZhU#mh|0!)V|hsbSw~Z~^WV1r?r9y1WTm1`
zw0M%|lkxe`)w|}q(P2;9Jl=`@)Q+jfbV*L+|8x(nXyw!j91cPJGYrmW~V!FgZTi2{3^6i!j{xPhA
zF3~YzPM|(KvwvBKrxNjqwa@(@Cf>JaE}Ko=uGn~4)5Q6e&gC?J?kJMq#9IdYVsT-faqVK{L&f*Dk-D#8TZ)K;|`Z+hHgY@6A{+tZk
z*G*!7!%3^Uzz1iJ%_HZHb0*n8{m=hgcxCL#&s&_yHEPHAX8ptqD}i|3@{PG&h-3HP
z-`o(UA~@ORo!Yh($0NH>yk4V$ITi=%}qLHP?4
z<`Cxn$-l0^4^g<)_BC>!x!L%!U+EF4oxPU-jF&ag>bg^1Kkjqq4-O4F&VCzjbN+mH
z_5G_^@Aud`Jsa0#%{yP+a%wF7@Hx9q+}H!2nYL>S=luKa{RR2Vm>(Lt{o)vX^Jg|+
z^u561wppjw@cE$4%QSpuUZ(2*p(BO$%_rXu*|?hhda8DwUNFCt
z`nk^Xjd@|KX=Ue*^-o+w-uBpjM2<7>t@iib_3AjP*Xgr-Ab*JGOS^9$Vtswf+95WS
zz*ctlT(f^&UvIBCX#HfrVCb#(<0psnKVyrG@0tvsQd|+=(@eTygbxTra6=rrZkP!#
zQI*>8FvnK5f_f5;N^lm#Oqzny+V2t#tk(cLt%NGbxGzz4Ga?11Q6pCNir5t#^i%vv
zYbFk{&IUrOxz3apQK)MvxFK`IuSHb_@P)IljBp-4h&4U+0WqGBhALuhc%c$GL?O-i
zgkj87tL)6ujg){V*?V7BFJWdxB~nt;8!e=Uo45+yZs0=}`YNS-$tZ(|8m1W)qll#T
zQyB|iHDo176`b|NxXOJ|gXd-BETmN62UE*qr8C?wWg<*j7XYAnF;naA?k;TB^E5!f
zxFD`jnrH$hYGD**!^7;M%9jyO;dWXtuqvR5S86KjHi_SZ$5RT~3;dpuJk7RMO|osw;UV$ezIgJT>jF-b7Z%vWky;H4TsWs2;gER#^P
zN)C{28Dt^rLV;7@$aV-!OnFSux1lQ(gF-7(F(OB$XDWqup%_Tqg0QH=BKM&Wil)fF
z(i~<=F`|s29LE(bQEe@iINcRy!A~*_7X+uW#6WD4nzRziXEQ3S=qimS++XNYnhA}S
zYQj2We@HWL6lEskI1|)Q8$09<@(O>G5Fooyq=pJH7=x$y9^+k${=pGxJtZty$6zIj
zy362{pNFDqGLx40x)QLUfHaDLqG6F?g{3A>D)`Y?6NWwgIrh)!=
zc>JW10at0}AcY5!fl`NhJVy;Hv}K9KX_UQ8fg{Sbj{Q{>
zATXeCV!hlBRcIjNp&w%nrmXAC4<2->?IJ~fpia;tmSy+IsD$o!qt%oS6Uj9}7Doek
zQ_>qK7_i1Q-q?W1q@RKYX_$>?9IRu{MSA1IegqkTmF{ld*1$fx2y}%xV$VUiE>K4n
zNr3((d^V^OBq>!u!-iQ2fMMYm7&@*ZlX&dJ<2ftdZ(F@
zWFx%b%_Ji(6|3ZG86I>Um+lf4vnI7kf8biW5`nS@-MjGHrLYkUn%uYh3$V*pC1X2tSW!oieBxP?O
z2AZOcu&XprV&39nUP9JDIKX8=5F}=xa?VAZo3M;I1qq5tEMz59VN@g)xMO@`uuZ>H
zba0h$)mS`2h>sF(^_VMsp!%e7Bs10`k74C240DwZfAD9iz{
zDwC>BEhe)X)u8CA0G#JFPeQVwBbdmF(Tqh@v}aTUiUE5mlt?^M&Y^{TU_p`&yvBr)
z3t!=(uW%+56`hYm7L;Rnm=SkDSZXXbj*|EteO(m#*j>&6oJlzL#)Z5AI0#lH0GVA8
z21o%;f~pFh1igA%}fVS6$Y#-G`R0?jA4+G`lLD@e8`)94`F@yF<<#v}t2(Hb;!PNiabp-Lcd
z#dcN(xet9VJ4vA!J3tQ@m7CNQu&X
z@B-e|S&7XC;98MF)1)k`PcSKaR_XfH`rAo#y!Q%=OYQ%A*OQe{8y3u-zErlHL9~e++s2x(JP
+#                 Terry Weissman 
+#                 Ian Hickson 
+
+package Configuration;
+use strict;
+use Carp;
+
+sub Get {
+    my ($file, $config) = @_;
+    my %seen;
+    open FILE, "<$file" or return 0;
+    my $line = 0;
+    while () {
+        $line++; chomp;
+        if (/^ *([^#;][^=\n\r]*)(?:=(.*))?$/os) {
+            my $value = $$config{$1};
+            if (defined($value)) {
+                $value = $$value while ref($value) eq 'REF';
+                if (ref($value) eq 'SCALAR') {
+                    $$value = $2;
+                } elsif (ref($value) eq 'ARRAY') {
+                    unless ($seen{$1}) {
+                        @$value = ();
+                    }
+                    if (defined($2)) {
+                        push(@$value, $2);
+                    }
+                } elsif (ref($value) eq 'HASH') {
+                    unless ($seen{$1}) {
+                        %$value = ();
+                    }
+                    if (defined($2)) {
+                        $2 =~ /^(.)(.*?)\1=>(.*)$/so;
+                        $$value{$2} = $3;
+                    }
+                }
+            } # else unknown variable, ignore
+            $seen{$1} = 1;
+        } # else ignore (probably comment)
+    }
+    close FILE;
+    return $line;
+}
+
+sub Save {
+    my ($file, $config) = @_;
+    local $_;
+
+    # Try to keep file structure if possible
+    my @lines;
+    if (open FILE, "<$file") {
+        while () {
+           push @lines, $_;
+        }
+        close FILE;
+    }
+
+    # but make sure we put in all the data (dups are dealt with)
+    foreach (sort keys %$config) {
+        push @lines, "$_=";
+    }
+
+    # Open file to which we are saving
+    open FILE, ">$file.~$$~" or confess("Could not save configuration: $!");
+
+    # ok, save file back again
+    # make sure we only write parameters once by
+    # keeping a log of those done
+    my %seen;
+    foreach (@lines) {
+        chomp;
+        if (/^ *([^#;][^=\n\r]*)(?:=(.*))?$/os) {
+            my $variable = $1;
+            my $value = $2;
+            if (defined($$config{$variable})) {
+                unless ($seen{$variable}) {
+                    $value = $$config{$variable};
+                    $value = $$value while ref($value) eq 'REF';
+                    if (ref($value) eq 'SCALAR') {
+                        if (defined($$value)) {
+                            print FILE $variable.'='.$$value."\n" or confess("Could not save configuration: $!");
+                        }
+                    } elsif (ref($value) eq 'HASH') {
+                        my @keys = keys %$value;
+                        if (@keys > 0) {
+                            foreach my $item (@keys) {
+                                my $data = $$value{$item};
+                                $item = '' unless defined $item;
+                                $data = '' unless defined $data;
+                                my $delimiter;
+                                foreach ('"','\'','|',':','#','*','<','>','/','[',']','{','}',
+                                         '(',')','\\','=','-','@','!','\$','%','&',' ','\`','~') {
+                                    if ($item !~ /\Q$_\E=>/os) {
+                                        $delimiter = $_;
+                                        last;
+                                    }
+                                }
+                                if (defined($delimiter)) {
+                                  print FILE "$variable=$delimiter$item$delimiter=>$data\n"
+                                    or confess("Could not save configuration: $!");
+                                }
+                                # else, silent data loss... XXX
+                            }
+                        } else {
+                            print FILE "$variable\n" or confess("Could not save configuration: $!");
+                        }
+                    } elsif (ref($value) eq 'ARRAY') {
+                        if (@$value > 0) {
+                            foreach my $item (@$value) {
+                                if (defined($item)) {
+                                    print FILE "$variable=$item\n" or confess("Could not save configuration: $!");
+                                } else {
+                                    print FILE "$variable=\n" or confess("Could not save configuration: $!");
+                                }
+                            }
+                        } else {
+                            print FILE "$variable\n" or confess("Could not save configuration: $!");
+                        }
+                    } else {
+                        confess("Unsupported data type '".ref($value)."' writing $variable (".$$config{$variable}.')');
+                    }
+                    $seen{$variable} = 1;
+                } # else seen it already
+            } else { # unknown
+                if (defined($value)) {
+                    print FILE "$variable=$value\n" or confess("Could not save configuration: $!");
+                } else {
+                    print FILE "$variable\n" or confess("Could not save configuration: $!");
+                }
+            }
+        } else {
+            # might be a comment
+            print FILE $_."\n" or confess("Could not save configuration: $!");
+        }
+    }
+    # actually do make a change to the real file    
+    close FILE or confess("Could not save configuration: $!");
+
+    # -- #mozwebtools was here --
+    # * Hixie is sad as his bot crashes.
+    # * Hixie adds in a check to make sure that the file he tries
+    #   to delete actually exists first.
+    #    delete??
+
+    unlink $file or confess("Could not delete $file: $!") if (-e $file);
+    rename("$file.~$$~", $file) or confess("Could not rename to $file: $!");
+}
+
+sub Ensure {
+    my ($config) = @_;
+    my $changed;
+    foreach (@$config) {
+        if (ref($$_[1]) eq 'SCALAR') {
+            unless (defined(${$$_[1]})) {
+                if (-t) {
+                    print $$_[0]. ' ';
+                    <> =~ /^(.*)$/os;
+                    ${$$_[1]} = $1;
+                    ${$$_[1]} = '' unless defined ${$$_[1]};
+                    chomp(${$$_[1]});
+                    $changed++;
+                } else {
+                    confess("Terminal is not interactive, so could not ask '$$_[0]'. Gave up");
+                }
+            }
+        } elsif (ref($$_[1]) eq 'ARRAY') {
+            unless (defined(@{$$_[1]})) {
+                if (-t) {
+                    print $$_[0]. " (enter a blank line to finish)\n";
+                    my $input;
+                    do {
+                        $input = <>;
+                        $input = '' unless defined $input;
+                        chomp($input);
+                        push @{$$_[1]}, $input if $input;
+                        $changed++;
+                    } while $input;
+                } else {
+                    confess("Terminal is not interactive, so could not ask '$$_[0]'. Gave up");
+                }
+            }
+        } else {
+            confess("Unsupported data type expected for question '$$_[0]'");
+        }
+    }
+    return $changed;
+}
+
+1; # end
diff --git a/lib/IO/CVS/Entries b/lib/IO/CVS/Entries
new file mode 100644
index 0000000..35afa03
--- /dev/null
+++ b/lib/IO/CVS/Entries
@@ -0,0 +1,2 @@
+/SecurePipe.pm/2.1/Sun Oct  5 20:15:05 2003//TMOZBOT-2_6
+D
diff --git a/lib/IO/CVS/Repository b/lib/IO/CVS/Repository
new file mode 100644
index 0000000..3821213
--- /dev/null
+++ b/lib/IO/CVS/Repository
@@ -0,0 +1 @@
+mozilla/webtools/mozbot/lib/IO
diff --git a/lib/IO/CVS/Root b/lib/IO/CVS/Root
new file mode 100644
index 0000000..cdb6f4a
--- /dev/null
+++ b/lib/IO/CVS/Root
@@ -0,0 +1 @@
+:pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot
diff --git a/lib/IO/CVS/Tag b/lib/IO/CVS/Tag
new file mode 100644
index 0000000..0fe9246
--- /dev/null
+++ b/lib/IO/CVS/Tag
@@ -0,0 +1 @@
+NMOZBOT-2_6
diff --git a/lib/IO/SecurePipe.pm b/lib/IO/SecurePipe.pm
new file mode 100644
index 0000000..4bb8a24
--- /dev/null
+++ b/lib/IO/SecurePipe.pm
@@ -0,0 +1,67 @@
+# IO::SecurePipe.pm
+# Created by Ian Hickson to make exec() call if IO::Pipe more secure.
+# Distributed under exactly the same licence terms as IO::Pipe.
+
+package IO::SecurePipe;
+use strict;
+#use Carp;
+use IO::Pipe;
+use vars qw(@ISA);
+@ISA = qw(IO::Pipe);
+
+my $do_spawn = $^O eq 'os2';
+
+sub croak {
+    $0 =~ m/^(.*)$/os; # untaint $0 so that we can call it below:
+    exec { $1 } ($1, '--abort'); # do not call shutdown handlers
+    exit(); # exit (implicit in exec() actually)   
+}
+
+sub _doit {
+    my $me = shift;
+    my $rw = shift;
+
+    my $pid = $do_spawn ? 0 : fork();
+
+    if($pid) { # Parent
+        return $pid;
+    }
+    elsif(defined $pid) { # Child or spawn
+        my $fh;
+        my $io = $rw ? \*STDIN : \*STDOUT;
+        my ($mode, $save) = $rw ? "r" : "w";
+        if ($do_spawn) {
+          require Fcntl;
+          $save = IO::Handle->new_from_fd($io, $mode);
+          # Close in child:
+          fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
+          $fh = $rw ? ${*$me}[0] : ${*$me}[1];
+        } else {
+          shift;
+          $fh = $rw ? $me->reader() : $me->writer(); # close the other end
+        }
+        bless $io, "IO::Handle";
+        $io->fdopen($fh, $mode);
+	$fh->close;
+
+        if ($do_spawn) {
+          $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
+          my $err = $!;
+    
+          $io->fdopen($save, $mode);
+          $save->close or croak "Cannot close $!";
+          croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
+          return $pid;
+        } else {
+          exec { $_[0] } @_  or  # XXX change here
+            croak "IO::Pipe: Cannot exec: $!";
+        }
+    }
+    else {
+        croak "IO::Pipe: Cannot fork: $!";
+    }
+
+    # NOT Reached
+}
+
+1;
diff --git a/lib/Mails.pm b/lib/Mails.pm
new file mode 100644
index 0000000..3fa46a6
--- /dev/null
+++ b/lib/Mails.pm
@@ -0,0 +1,196 @@
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+# The contents of this file are subject to the Mozilla Public
+# License Version 1.1 (the "License"); you may not use this file
+# except in compliance with the License. You may obtain a copy of
+# the License at http://www.mozilla.org/MPL/
+#
+# Software distributed under the License is distributed on an "AS
+# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
+# implied. See the License for the specific language governing
+# rights and limitations under the License.
+#
+# The Original Code is the Bugzilla Bug Tracking System.
+#
+# The Initial Developer of the Original Code is Netscape Communications
+# Corporation. Portions created by Netscape are
+# Copyright (C) 1998 Netscape Communications Corporation. All
+# Rights Reserved.
+#
+# Contributor(s): Harrison Page 
+#                 Terry Weissman 
+#                 Ian Hickson 
+
+package Mails;
+use strict;
+use Carp;
+
+# User must declare the following package global variables:
+#  $Mails::owner = \'e-mail address of owner';
+#  $Mails::smtphost = 'name of SMTP server';
+#  $Mails::debug = \&function to print debug messages # better solutions welcome
+
+# send mail to the owner
+sub mailowner {
+    my ($subject, $text) = @_;
+    &$Mails::debug('I am going to mail the owner!!!');
+    return &sendmail($$Mails::owner, $0, $subject, $text);
+}
+
+sub RFC822time {
+    # Returns today's date as an RFC822 compliant string with the
+    # exception that the year is returned as four digits.  In my
+    # extremely valuable opinion RFC822 was wrong to specify the year
+    # as two digits.  Many email systems generate four-digit years.
+
+    # Today is defined as the first parameter, if given, or else the
+    # value that time() gives.
+
+    my ($tsec,$tmin,$thour,$tmday,$tmon,$tyear,$twday,$tyday,$tisdst) = gmtime(shift || time());
+    $tyear += 1900; # as mentioned above, this is not RFC822 compliant, but is Y2K-safe.
+    $tsec = "0$tsec" if $tsec < 10;
+    $tmin = "0$tmin" if $tmin < 10;
+    $thour = "0$thour" if $thour < 10;
+    $tmon = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$tmon];
+    $twday = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$twday];
+    return "$twday, $tmday $tmon $tyear $thour:$tmin:$tsec GMT";
+
+}
+
+sub sendmail {
+    my ($to, $from, $subject, $text, $sig) = (@_, $0);
+    eval {
+        use Net::SMTP;
+        my $date = &RFC822time();
+        my $smtp = Net::SMTP->new($Mails::smtphost) or confess("Could not create SMTP connection to $Mails::smtphost! Giving Up");
+        $smtp->mail($ENV{USER}); # XXX ?
+        $smtp->to($to);
+        $smtp->data(<quit;
+    } or do {
+        &$Mails::debug('Failed to send e-mail.');
+        &$Mails::debug($@);
+        &$Mails::debug('-'x40);
+        &$Mails::debug("To: $to");
+        &$Mails::debug("From: $from");
+        &$Mails::debug("Subject: $subject");
+        &$Mails::debug("\n$text\n-- \n$sig");
+        &$Mails::debug('-'x40);
+        return 0;
+    };
+    return 1;
+}
+
+
+##########################################################
+####  The Mails ##########################################
+##########################################################
+
+sub ServerDown {
+    my ($server, $port, $localAddr, $nick, $ircname, $username) = @_;
+    my $localAddrMessage;
+    if (defined($localAddr)) {
+        $localAddrMessage = <
+#                 Terry Weissman 
+#                 Risto Kotalampi 
+#                 Josh Soref 
+#                 Ian Hickson 
+#                 Ken Coar 
+#                 Adam Di Carlo 
+#
+# mozbot.pl harrison@netscape.com 1998-10-14
+# "irc bot for the gang on #mozilla"
+#
+# mozbot.pl mozbot@hixie.ch 2000-07-04
+# "irc bot engine for anyone" :-)
+#
+# hack on me! required reading:
+#
+# Net::IRC web page:
+#   http://sourceforge.net/projects/net-irc/
+#   (free software)
+#   or get it from CPAN @ http://www.perl.com/CPAN
+#
+# RFC 1459 (Internet Relay Chat Protocol):
+#   http://sunsite.cnlab-switch.ch/ftp/doc/standard/rfc/14xx/1459
+#
+# Please file bugs in Bugzilla, under the 'Webtools' product,
+# component 'Mozbot'.  https://bugzilla.mozilla.org/
+
+# TO DO LIST
+# XXX Something that checks modules that failed to compile and then
+#     reloads them when possible
+# XXX an HTML entity convertor for things that speak web page contents
+# XXX UModeChange
+# XXX minor checks
+# XXX throttle nick changing and away setting (from module API)
+# XXX compile self before run
+# XXX parse mode (+o, etc)
+# XXX optimisations
+# XXX maybe should catch hangup signal and go to background?
+# XXX protect the bot from DOS attacks causing server overload
+# XXX protect the server from an overflowing log (add log size limitter
+#     or rotation)
+# XXX fix the "hack hack hack" bits to be better.
+
+
+################################
+# Initialisation               #
+################################
+
+# -- #mozwebtools was here --
+#       syntax error at oopsbot.pl line 48, near "; }"
+#       Execution of oopsbot.pl aborted due to compilation errors.
+#       DOH!
+#      hee hee. nice smily in the error message
+
+# catch nasty occurances
+$SIG{'INT'}  = sub { &killed('INT'); };
+$SIG{'KILL'} = sub { &killed('KILL'); };
+$SIG{'TERM'} = sub { &killed('TERM'); };
+
+# this allows us to exit() without shutting down (by exec($0)ing)
+BEGIN { exit() if ((defined($ARGV[0])) and ($ARGV[0] eq '--abort')); }
+
+# pragmas
+use strict;
+use diagnostics;
+
+# chroot if requested
+my $CHROOT = 0;
+if ((defined($ARGV[0])) and ($ARGV[0] eq '--chroot')) {
+    # chroot
+    chroot('.') or die "chroot failed: $!\nAborted";
+    # setuid
+    # This is hardcoded to use user ids and group ids 60001.
+    # You'll want to change this on your system.
+    $> = 60001; # setuid nobody
+    $) = 60001; # setgid nobody
+    shift(@ARGV);
+    use lib '/lib';
+    $CHROOT = 1;
+} elsif ((defined($ARGV[0])) and ($ARGV[0] eq '--assume-chrooted')) {
+    shift(@ARGV);
+    use lib '/lib';
+    $CHROOT = 1;
+} else {
+    use lib 'lib';
+}
+
+# important modules
+use Net::IRC 0.7; # 0.7 is not backwards compatible with 0.63 for CTCP responses
+use IO::SecurePipe; # internal based on IO::Pipe
+use Socket;
+use POSIX ":sys_wait_h";
+use Carp qw(cluck confess);
+use Configuration; # internal
+use Mails; # internal
+
+# Net::IRC 0.74+ require Time::HiRes, if its missing, Net::IRC will fail with
+# a "No method called "time" for object." error during mozbot startup.
+
+# Note: Net::SMTP is also used, see the sendmail function in Mails.
+
+# force flushing
+$|++;
+
+# internal 'constants'
+my $USERNAME = "pid-$$";
+my $LOGFILEPREFIX;
+
+# variables that should only be changed if you know what you are doing
+my $LOGGING = 1; # set to '0' to disable logging
+my $LOGFILEDIR; # set this to override the logging output directory
+
+if ($LOGGING) {
+    # set up the log directory
+    unless (defined($LOGFILEDIR)) {
+        if ($CHROOT) {
+            $LOGFILEDIR = '/log';
+        } else {
+            # setpwent doesn't work on Windows, we should wrap this in some OS test
+            setpwent; # reset the search settings for the getpwuid call below
+            $LOGFILEDIR = (getpwuid($<))[7].'/log';
+        }
+    }
+    "$LOGFILEDIR/$0" =~ /^(.*)$/os; # untaints the evil $0.
+    $LOGFILEPREFIX = $1; # for some reason, $0 is considered tainted here, but not in other cases...
+    mkdir($LOGFILEDIR, 0700); # if this fails for a bad reason, we'll find out during the next line
+}
+
+# begin session log...
+&debug('-'x80);
+&debug('mozbot starting up');
+&debug('compilation took '.&days($^T).'.');
+if ($CHROOT) {
+    &debug('mozbot chroot()ed successfully');
+}
+
+# secure the environment
+#
+# XXX could automatically remove the current directory here but I am
+# more comfortable with people knowing it is not allowed -- see the
+# README file.
+if ($ENV{'PATH'} =~ /^(?:.*:)?\.?(?::.*)?$/os) {
+    die 'SECURITY RISK. You cannot have \'.\' in the path. See the README. Aborted';
+}
+$ENV{'PATH'} =~ /^(.*)$/os;
+$ENV{'PATH'} = $1; # we have to assume their path is otherwise safe, they called us!
+delete (@ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'});
+
+
+# read the configuration file
+my $cfgfile = shift || "$0.cfg";
+$cfgfile =~ /^(.*)$/os;
+$cfgfile = $1; # untaint it -- we trust this, it comes from the admin.
+&debug("reading configuration from '$cfgfile'...");
+
+# - setup variables
+# note: owner is only used by the Mails module
+my ($server, $port, $password, $localAddr, @nicks, @channels, %channelKeys, $owner,
+    @ignoredUsers, @ignoredTargets, $ssl);
+my $nick = 0;
+my $sleepdelay = 60;
+my $connectTimeout = 120;
+my $delaytime = 1.3; # amount of time to wait between outputs
+my $recentMessageCountThreshold = 3; # threshold before we stop outputting
+my $recentMessageCountPenalty = 10; # if we hit the threshold, bump it up by this much
+my $recentMessageCountLimit = 20; # limit above which the count won't go
+my $recentMessageCountDecrementRate = 0.1; # how much to take off per $delaytime
+my $variablepattern = '[-_:a-zA-Z0-9]+';
+my %users = ('admin' => &newPassword('password')); # default password for admin
+my %userFlags = ('admin' => 3); # bitmask; 0x1 = admin, 0x2 = delete user a soon as other admin authenticates
+my $helpline = 'http://www.mozilla.org/projects/mozbot/'; # used in IRC name and in help
+my $serverRestrictsIRCNames = '';
+my $serverExpectsValidUsername = '';
+my $username = 0; # makes the username default to the pid ($USERNAME)
+my @modulenames = ('General', 'Greeting', 'Infobot', 'Parrot');
+my $gender = 'female'; #changed to female by special request
+my $umode;
+
+# - which variables can be saved.
+®isterConfigVariables(
+    [\$server, 'server'],
+    [\$port, 'port'],
+    [\$password, 'password'],
+    [\$localAddr, 'localAddr'],
+    [\@nicks, 'nicks'],
+    [\$nick, 'currentnick'], # pointer into @nicks
+    [\@channels, 'channels'],
+    [\%channelKeys, 'channelKeys'],
+    [\@ignoredUsers, 'ignoredUsers'],
+    [\@ignoredTargets, 'ignoredTargets'],
+    [\@modulenames, 'modules'],
+    [\$owner, 'owner'],
+    [\$sleepdelay, 'sleep'],
+    [\$connectTimeout, 'connectTimeout'],
+    [\$delaytime, 'throttleTime'],
+    [\%users, 'users'], # usernames => &newPassword(passwords)
+    [\%userFlags, 'userFlags'], # usernames => bits
+    [\$variablepattern, 'variablepattern'],
+    [\$helpline, 'helpline'],
+    [\$username, 'username'],
+    [\$serverRestrictsIRCNames, 'simpleIRCNameServer'],
+    [\$serverExpectsValidUsername, 'validUsernameServer'],
+    [\$ssl, 'ssl'],
+    [\$umode, 'umode'],
+    [\$gender, 'gender'],
+    [\$Mails::smtphost, 'smtphost'],
+);
+
+# - read file
+&Configuration::Get($cfgfile, &configStructure()); # empty gets entire structure
+
+# - check variables are ok
+# note. Ensure only works on an interactive terminal (-t).
+# It will abort otherwise.
+{ my $changed; # scope this variable
+$changed = &Configuration::Ensure([
+    ['Connect to which server?', \$server],
+    ['To which port should I connect?', \$port],
+    ['Connect to this port using SSL?', \$ssl],
+    ['What is the server\'s password? (Leave blank if there isn\'t one.)', \$password],
+    ['What channels should I join?', \@channels],
+    ['What is the e-mail address of my owner?', \$owner],
+    ['What is your SMTP host?', \$Mails::smtphost],
+]);
+
+# - check we have some nicks
+until (@nicks) {
+    $changed = &Configuration::Ensure([['What nicks should I use? (I need at least one.)', \@nicks]]) || $changed;
+    # the original 'mozbot 2.0' development codename (and thus nick) was oopsbot.
+}
+
+# - check current nick pointer is valid
+# (we assume that no sillyness has happened with $[ as,
+# according to man perlvar, "Its use is highly discouraged".)
+$nick = 0 if (($nick > $#nicks) or ($nick < 0));
+
+# - check channel names are all lowercase
+foreach (@channels) { $_ = lc; }
+
+# save configuration straight away, to make sure it is possible and to save
+# any initial settings on the first run, if anything changed.
+if ($changed) {
+    &debug("saving configuration to '$cfgfile'...");
+    &Configuration::Save($cfgfile, &configStructure());
+}
+
+} # close the scope for the $changed variable
+
+# ensure Mails is ready
+&debug("setting up Mails module...");
+$Mails::debug = \&debug;
+$Mails::owner = \$owner;
+
+# setup the IRC variables
+&debug("setting up IRC variables...");
+my $uptime;
+my $irc = new Net::IRC or confess("Could not create a new Net::IRC object. Aborting");
+
+# connect
+&debug("attempting initial connection...");
+&connect(); # hmm.
+
+# setup the modules array
+my @modules; # we initialize it lower down (at the bottom in fact)
+my $lastadmin; # nick of last admin to be seen
+my %authenticatedUsers; # hash of user@hostname=>users who have authenticated
+
+
+################################
+# Net::IRC handler subroutines #
+################################
+
+sub setEventArgs {
+    my $event = shift;
+    if ($Net::IRC::VERSION == 0.75) {
+        # curses. This version of Net::IRC is broken. Work around
+        # it here.
+        return $event->args(\@_);
+    } else {
+        return $event->args(@_);
+    }
+}
+
+my $lastNick;
+
+# setup connection
+sub connect {
+    $uptime = time();
+
+    &debug("connecting to $server:$port using nick '$nicks[$nick]'..." 
+			. ($ssl && lc($ssl) eq 'yes')? "via SSL" : "");
+    my ($bot, $mailed);
+
+    $lastNick = undef;
+
+    my $ircname = 'mozbot';
+    if ($serverRestrictsIRCNames ne $server) {
+        $ircname = "[$ircname] $helpline";
+    }
+
+    my $identd = getpwuid($<);
+    if ($serverExpectsValidUsername ne $server) {
+        $identd = $username || $USERNAME;
+    }
+
+    until (inet_aton($server) and # we check this first because Net::IRC::Connection doesn't
+           $bot = $irc->newconn(
+             Server => $server,
+             Port => $port,
+             Password => $password ne '' ? $password : undef, # '' will cause PASS to be sent
+             Nick => $nicks[$nick],
+             Ircname => $ircname,
+             Username => $identd,
+             LocalAddr => $localAddr,
+			 SSL => ($ssl && lc($ssl) eq 'yes') ? 'true' : undef, 
+           )) {
+        &debug("Could not connect. Are you sure '$server:$port' is a valid host?");
+        unless (inet_aton($server)) {
+            &debug('I couldn\'t resolve it.');
+        }
+        if (defined($localAddr)) {
+            &debug("Is '$localAddr' the correct address of the interface to use?");
+        } else {
+            &debug("Try editing '$cfgfile' to set 'localAddr' to the address of the interface to use.");
+        }
+        if ($Net::IRC::VERSION < 0.73) {
+            &debug("Note that to use 'localAddr' you need Net::IRC version 0.73 or higher (you have $Net::IRC::VERSION)");
+        }
+        $mailed = &Mails::ServerDown($server, $port, $localAddr, $nicks[$nick], $ircname, $identd) unless $mailed;
+        sleep($sleepdelay);
+        &Configuration::Get($cfgfile, &configStructure(\$server, \$port, \$password, \@nicks, \$nick, \$owner, \$sleepdelay));
+        &debug("connecting to $server:$port again...");
+    }
+
+    &debug("connected! woohoo!");
+
+    # add the handlers
+    &debug("adding event handlers");
+
+    # $bot->debug(1); # this can help when debugging API stuff
+
+    $bot->add_global_handler([ # Informational messages -- print these to the console
+        251, # RPL_LUSERCLIENT
+        252, # RPL_LUSEROP
+        253, # RPL_LUSERUNKNOWN
+        254, # RPL_LUSERCHANNELS
+        255, # RPL_LUSERME
+        302, # RPL_USERHOST
+        375, # RPL_MOTDSTART
+        372, # RPL_MOTD
+    ], \&on_startup);
+
+    $bot->add_global_handler([ # Informational messages -- print these to the console
+        'snotice', # server notices
+        461, # need more arguments for PASS command
+        409, # noorigin
+        405, # toomanychannels  XXX should do something about this!
+        404, # cannot send to channel
+        403, # no such channel
+        401, # no such server
+        402, # no such nick
+        407, # too many targets
+    ], \&on_notice);
+
+    $bot->add_global_handler([ # should only be one command here - when to join channels
+        376, # RPL_ENDOFMOTD
+        422, # nomotd
+    ], \&on_connect);
+
+    $bot->add_handler('welcome', \&on_welcome); # when we connect, to get our nick/umode
+    $bot->add_global_handler([ # when to change nick name
+        'erroneusnickname',
+        433, # ERR_NICKNAMEINUSE
+        436, # nick collision
+    ], \&on_nick_taken);
+    $bot->add_handler('nick', \&on_nick); # when someone changes nick
+
+    $bot->add_global_handler([ # when to give up and go home
+        'disconnect', 'kill', # bad connection, booted offline
+        465, # ERR_YOUREBANNEDCREEP
+    ], \&on_disconnected);
+    $bot->add_handler('destroy', \&on_destroy); # when object is GCed.
+
+    $bot->add_handler('msg', \&on_private); # /msg bot hello
+    $bot->add_handler('public', \&on_public);  # hello
+    $bot->add_handler('notice', \&on_noticemsg); # notice messages
+    $bot->add_handler('join', \&on_join); # when someone else joins
+    $bot->add_handler('part', \&on_part); # when someone else leaves
+    $bot->add_handler('topic', \&on_topic); # when topic changes in a channel
+    $bot->add_handler('notopic', \&on_topic); # when topic in a channel is cleared
+    $bot->add_handler('invite', \&on_invite); # when someone invites us
+    $bot->add_handler('quit', \&on_quit); # when someone quits IRC
+    $bot->add_handler('kick', \&on_kick); # when someone (or us) is kicked
+    $bot->add_handler('mode', \&on_mode); # when modes change
+    $bot->add_handler('umode', \&on_umode); # when modes of user change (by IRCop or ourselves)
+    # XXX could add handler for 474, # ERR_BANNEDFROMCHAN
+
+    $bot->add_handler([ # ones we handle to get our hostmask
+        311, # whoisuser
+    ], \&on_whois);
+    $bot->add_handler([ # ones we handle just by outputting to the console
+        312, # whoisserver
+        313, # whoisoperator
+        314, # whowasuser
+        315, # endofwho
+        316, # whoischanop
+        317, # whoisidle
+        318, # endofwhois
+        319, # whoischannels
+    ], \&on_notice);
+    $bot->add_handler([ # names (currently just ignored)
+        353, # RPL_NAMREPLY " :[[@|+] [[@|+] [...]]]"
+    ], \&on_notice);
+    $bot->add_handler([ # end of names (we use this to establish that we have entered a channel)
+        366, # RPL_ENDOFNAMES " :End of /NAMES list"
+    ], \&on_join_channel);
+
+    $bot->add_handler('cping', \&on_cping); # client to client ping
+    $bot->add_handler('crping', \&on_cpong); # client to client ping (response)
+    $bot->add_handler('cversion', \&on_version); # version info of mozbot.pl
+    $bot->add_handler('csource', \&on_source); # where is mozbot.pl's source
+    $bot->add_handler('caction', \&on_me); # when someone says /me
+    $bot->add_handler('cgender', \&on_gender); # guess
+
+    $bot->schedule($connectTimeout, \&on_check_connect);
+
+    # and done.
+    &Mails::ServerUp($server) if $mailed;
+
+}
+
+# called when the client receives a startup-related message
+sub on_startup {
+    my ($self, $event) = @_;
+    my (@args) = $event->args;
+    shift(@args);
+    &debug(join(' ', @args));
+}
+
+# called when the client receives a server notice
+sub on_notice {
+    my ($self, $event) = @_;
+    &debug($event->type.': '.join(' ', $event->args));
+}
+
+# called when the client receives whois data
+sub on_whois {
+    my ($self, $event) = @_;
+    &debug('collecting whois information: '.join('|', $event->args));
+    # XXX could cache this information and then autoop people from
+    # the bot's host, or whatever
+}
+
+my ($nickFirstTried, $nickHadProblem, $nickProblemEscalated) = (0, 0, 0);
+
+# this is called for the welcome message (001) it calls on_set_nick to
+# get our nick and on_set_umode to set our umode once we have a nick
+sub on_welcome {
+    my ($self, $event) = @_;
+    on_set_nick($self, $event);
+    on_set_umode($self, $event);
+}
+
+# this is called both for the welcome message (001) and by the on_nick handler
+sub on_set_nick {
+    my ($self, $event) = @_;
+    ($lastNick) = $event->args; # (args can be either array or scalar, we want the first value)
+    # Find nick's index.
+    my $newnick = 0;
+    $newnick++ while (($newnick < @nicks) and ($lastNick ne $nicks[$newnick]));
+    # If nick isn't there, add it.
+    if ($newnick >= @nicks) {
+        push(@nicks, $lastNick);
+    }
+    # set variable
+    $nick = $newnick;
+    &debug("using nick '$nicks[$nick]'");
+
+    # try to get our hostname
+    $self->whois($nicks[$nick]);
+
+    if ($nickHadProblem) {
+        Mails::NickOk($nicks[$nick]) if $nickProblemEscalated;
+        $nickHadProblem = 0;
+    }
+
+    # save
+    &Configuration::Save($cfgfile, &::configStructure(\$nick, \@nicks));
+}
+
+sub on_nick_taken {
+    my ($self, $event, $nickSlept) = @_, 0;
+    return unless $self->connected();
+
+    if ($event->type eq 'erroneusnickname') {
+        my ($currentNick, $triedNick, $err) = $event->args; # current, tried, errmsg
+        &debug("requested nick ('$triedNick') refused by server ('$err')");
+    } elsif ($event->type eq 'nicknameinuse') {
+        my ($currentNick, $triedNick, $err) = $event->args; # current, tried, errmsg
+        &debug("requested nick ('$triedNick') already in use ('$err')");
+    } else {
+        my $type = $event->type;
+        my $args = join(' ', $event->args);
+        &debug("message $type from server: $args");
+    }
+
+    if (defined $lastNick) {
+        &debug("silently abandoning nick change idea :-)");
+        return;
+    }
+
+    # at this point, we don't yet have a nick, but we need one
+    
+    if ($nickSlept) {
+        &debug("waited for a bit -- reading $cfgfile then searching for a nick...");
+        &Configuration::Get($cfgfile, &configStructure(\@nicks, \$nick));
+        $nick = 0 if ($nick > $#nicks) or ($nick < 0); # sanitise
+        $nickFirstTried = $nick;
+    } else {
+        if (not $nickHadProblem) {
+            $nickHadProblem = 1;
+            $nickFirstTried = $nick;
+        }
+        ++$nick;
+        $nick = 0 if $nick > $#nicks; # sanitise
+
+        if ($nick == $nickFirstTried) {
+            # looped!
+            local $" = ", ";
+            &debug("could not find an acceptable nick");
+            &debug("nicks tried: @nicks");
+
+            if (not -t) {
+                &debug("edit $cfgfile to add more nicks *hint* *hint*");
+                $nickProblemEscalated ||= # only e-mail once (returns 0 on failure)
+                  Mails::NickShortage($cfgfile, $self->server, $self->port,
+                                      $self->username, $self->ircname, @nicks)
+                &debug("going to wait $sleepdelay seconds so as not to overload ourselves.");
+                $self->schedule($sleepdelay, \&on_nick_taken, $event, 1); # try again
+                return; # otherwise we no longer respond to pings.
+            }
+
+            # else, we're terminal bound, ask user for nick
+            print "Please suggest a nick (blank to abort): ";
+            my $new = <>;
+            chomp($new);
+            if (not $new) {
+                &debug("Could not find an acceptable nick");
+                exit(1);
+            }
+            # XXX this could introduce duplicates
+            @nicks = (@nicks[0..$nickFirstTried], $new, @nicks[$nickFirstTried+1..$#nicks]);
+            $nick += 1; # try the new nick now
+            $nickFirstTried = $nick;
+        }
+    }
+
+    &debug("now going to try nick '$nicks[$nick]'");
+    &Configuration::Save($cfgfile, &configStructure(\$nick, \@nicks));
+    $self->nick($nicks[$nick]);
+}
+
+#called by on_welcome after we get our nick
+sub on_set_umode {
+    my ($self, $event) = @_;
+    # set usermode for the bot
+    if ($umode) {
+        &debug("using umode: '$umode'");
+        $self->mode($self->nick, $umode);
+    }
+}
+
+# called when we connect.
+sub on_connect {
+    my $self = shift;
+
+    if (defined($self->{'__mozbot__shutdown'})) { # HACK HACK HACK
+        &debug('Uh oh. I connected anyway, even though I thought I had timed out.');
+        &debug('I\'m going to increase the timeout time by 20%.');
+        $connectTimeout = $connectTimeout * 1.2;
+        &Configuration::Save($cfgfile, &configStructure(\$connectTimeout));
+        $self->quit('having trouble connecting, brb...');
+        # XXX we don't call the SpottedQuit handlers here
+        return;
+    }
+
+    # -- #mozwebtools was here --
+    # *** oopsbot (oopsbot@129.59.231.42) has joined channel #mozwebtools
+    # *** Mode change [+o oopsbot] on channel #mozwebtools by timeless
+    #    wow an oopsbot!
+    # *** Signoff: oopsbot (oopsbot@129.59.231.42) has left IRC [Leaving]
+    #    um
+    #    not very stable.
+
+    # now load all modules
+    my @modulesToLoad = @modulenames;
+    @modules = (BotModules::Admin->create('Admin', '')); # admin commands
+    @modulenames = ('Admin');
+    foreach (@modulesToLoad) {
+        next if $_ eq 'Admin'; # Admin is static and is installed manually above
+        my $result = LoadModule($_);
+        if (ref($result)) {
+            &debug("loaded $_");
+        } else {
+            &debug("failed to load $_", $result);
+        }
+    }
+
+    # mass-configure the modules
+    &debug("loading module configurations...");
+    { my %struct; # scope this variable
+    foreach my $module (@modules) { %struct = (%struct, %{$module->configStructure()}); }
+    &Configuration::Get($cfgfile, \%struct);
+    } # close the scope for the %struct variable
+
+    # tell the modules they have joined IRC
+    my $event = newEvent({
+        'bot' => $self,
+    });
+    foreach my $module (@modules) {
+        $module->JoinedIRC($event);
+    }
+
+    # tell the modules to set up the scheduled commands
+    &debug('setting up scheduler...');
+    foreach my $module (@modules) {
+        eval {
+            $module->Schedule($event);
+        };
+        if ($@) {
+            &debug("Warning: An error occured while loading the module:\n$@");
+        }
+    }
+
+    # join the channels
+    &debug('going to join: '.join(',', @channels));
+    foreach my $channel (@channels) {
+        if (defined($channelKeys{$channel})) {
+            $self->join($channel, $channelKeys{$channel});
+        } else {
+            $self->join($channel);
+        }
+    }
+    @channels = ();
+
+    # enable the drainmsgqueue
+    &drainmsgqueue($self);
+    $self->schedule($delaytime, \&lowerRecentMessageCount);
+
+    # signal that we are connected (see next two functions)
+    $self->{'__mozbot__active'} = 1; # HACK HACK HACK
+
+    # all done!
+    &debug('initialisation took '.&days($uptime).'.');
+    $uptime = time();
+
+}
+
+sub on_check_connect {
+    my $self = shift;
+    return if (defined($self->{'__mozbot__shutdown'}) or defined($self->{'__mozbot__active'})); # HACK HACK HACK
+    $self->{'__mozbot__shutdown'} = 1; # HACK HACK HACK
+    &debug("connection timed out -- trying again");
+    # XXX we don't call the SpottedQuit handlers here
+    foreach (@modules) { $_->unload(); }
+    @modules = ();
+    $self->quit('connection timed out -- trying to reconnect');
+    &connect();
+}
+
+# if something nasty happens
+sub on_disconnected {
+    my ($self, $event) = @_;
+    return if defined($self->{'__mozbot__shutdown'}); # HACK HACK HACK
+    $self->{'__mozbot__shutdown'} = 1; # HACK HACK HACK
+    # &do(@_, 'SpottedQuit'); # XXX do we want to do this?
+    my($reason) = $event->args;
+    if ($reason =~ /Connection timed out/osi
+        and ($serverRestrictsIRCNames ne $server
+             or $serverExpectsValidUsername ne $server)) {
+        # try to set everything up as simple as possible
+        $serverRestrictsIRCNames = $server;
+        $serverExpectsValidUsername = $server;
+        &Configuration::Save($cfgfile, &configStructure(\$serverRestrictsIRCNames));
+        &debug("Hrm, $server is having issues.");
+        &debug("We're gonna try again with different settings, hold on.");
+        &debug("The full message from the server was: '$reason'");
+    } elsif ($reason =~ /Bad user info/osi and $serverRestrictsIRCNames ne $server) {
+        # change our IRC name to something simpler by setting the flag
+        $serverRestrictsIRCNames = $server;
+        &Configuration::Save($cfgfile, &configStructure(\$serverRestrictsIRCNames));
+        &debug("Hrm, $server didn't like our IRC name.");
+        &debug("Trying again with a simpler one, hold on.");
+        &debug("The full message from the server was: '$reason'");
+    } elsif ($reason =~ /identd/osi and $serverExpectsValidUsername ne $server) {
+        # try setting our username to the actual username
+        $serverExpectsValidUsername = $server;
+        &Configuration::Save($cfgfile, &configStructure(\$delaytime));
+        &debug("Hrm, $server said something about an identd problem.");
+        &debug("Trying again with our real username, hold on.");
+        &debug("The full message from the server was: '$reason'");
+    } elsif ($reason =~ /Excess Flood/osi) {
+        # increase the delay by 20%
+        $delaytime = $delaytime * 1.2;
+        &Configuration::Save($cfgfile, &configStructure(\$delaytime));
+        &debug('Hrm, we it seems flooded the server. Trying again with a delay 20% longer.');
+        &debug("The full message from the server was: '$reason'");
+    } elsif ($reason =~ /Bad Password/osi) {
+        &debug('Hrm, we don\'t seem to know the server password.');
+        &debug("The full message from the server was: '$reason'");
+        if (-t) {
+            print "Please enter the server password: ";
+            $password = <>;
+            chomp($password);
+            &Configuration::Save($cfgfile, &configStructure(\$password));
+        } else {
+            &debug("edit $cfgfile to set the password *hint* *hint*");
+            &debug("going to wait $sleepdelay seconds so as not to overload ourselves.");
+            sleep $sleepdelay;
+        }
+    } else {
+        &debug("eek! disconnected from network: '$reason'");
+    }
+    foreach (@modules) { $_->unload(); }
+    @modules = ();
+    &connect();
+}
+
+# on_join_channel: called when we join a channel
+sub on_join_channel {
+    my ($self, $event) = @_;
+    my ($nick, $channel) = $event->args;
+    $channel = lc($channel);
+    push(@channels, $channel);
+    &Configuration::Save($cfgfile, &configStructure(\@channels));
+    &debug("joined $channel, about to autojoin modules...");
+    foreach (@modules) {
+        $_->JoinedChannel(newEvent({
+            'bot' => $self,
+            'channel' => $channel,
+            'target' => $channel,
+            'nick' => $nick
+        }), $channel);
+    }
+}
+
+# if something nasty happens
+sub on_destroy {
+    &debug("Connection: garbage collected");
+}
+
+sub targetted {
+    my ($data, $nick) = @_;
+    return $data =~ /^(\s*$nick(?:[\s,:;!?]+|\s*:-\s*|\s*--+\s*|\s*-+>?\s+))(.+)$/is ?
+      (defined $2 ? $2 : '') : undef;
+}
+
+# on_public: messages received on channels
+sub on_public {
+    my ($self, $event) = @_;
+    my $data = join(' ', $event->args);
+    if (defined($_ = targetted($data, quotemeta($nicks[$nick])))) {
+        if ($_ ne '') {
+            setEventArgs($event, $_);
+            $event->{'__mozbot__fulldata'} = $data;
+            &do($self, $event, 'Told', 'Baffled');
+        } else {
+            &do($self, $event, 'Heard');
+        }
+    } else {
+        foreach my $nick (@ignoredTargets) {
+            if (defined targetted($data, $nick)) {
+                my $channel = &toToChannel($self, @{$event->to});
+                &debug("Ignored (target matched /$nick/): $channel <".$event->nick.'> '.join(' ', $event->args));
+                return;
+            }
+        }
+        &do($self, $event, 'Heard');
+    }
+}
+
+# on_noticemsg: notice messages from the server, some service, or another
+# user.  beware!  it's generally Bad Juju to respond to these, but for
+# some things (like opn's NickServ) it's appropriate.
+sub on_noticemsg {
+    my ($self, $event) = @_;
+    &do($self, $event, 'Noticed');
+}
+
+sub on_private {
+    my ($self, $event) = @_;
+    my $data = join(' ', $event->args);
+    my $nick = quotemeta($nicks[$nick]);
+    if (($data =~ /^($nick(?:[-\s,:;.!?]|\s*-+>?\s+))(.+)$/is) and ($2)) {
+        # we do this so that you can say 'mozbot do this' in both channels
+        # and /query screens alike (otherwise, in /query screens you would
+        # have to remember to omit the bot name).
+        setEventArgs($event, $2);
+    }
+    &do($self, $event, 'Told', 'Baffled');
+}
+
+# on_me: /me actions (CTCP actually)
+sub on_me {
+    my ($self, $event) = @_;
+    my @data = $event->args;
+    my $data = join(' ', @data);
+    setEventArgs($event, $data);
+    my $nick = quotemeta($nicks[$nick]);
+    if ($data =~ /(?:^|[\s":<([])$nick(?:[])>.,?!\s'&":]|$)/is) {
+        &do($self, $event, 'Felt');
+    } else {
+        &do($self, $event, 'Saw');
+    }
+}
+
+# on_topic: for when someone changes the topic
+# also for when the server notifies us of the topic
+# ...so we have to parse it carefully.
+sub on_topic {
+    my ($self, $event) = @_;
+    if ($event->userhost eq '@') {
+        # server notification
+        # need to parse data
+        my (undef, $channel, $topic) = $event->args;
+        setEventArgs($event, $topic);
+        $event->to($channel);
+    }
+    &do(@_, 'SpottedTopicChange');
+}
+
+# on_kick: parse the kick event
+sub on_kick {
+    my ($self, $event) = @_;
+    my ($channel, $from) = $event->args; # from is already set anyway
+    my $who = $event->to;
+    $event->to($channel);
+    foreach (@$who) {
+        setEventArgs($event, $_);
+        if ($_ eq $nicks[$nick]) {
+            &do(@_, 'Kicked');
+        } else {
+            &do(@_, 'SpottedKick');
+        }
+    }
+}
+
+# Gives lag results for outgoing PINGs.
+sub on_cpong {
+    my ($self, $event) = @_;
+    &debug('completed CTCP PING with '.$event->nick.': '.days($event->args->[0]));
+    # XXX should be able to use this then... see also Greeting module
+    # in standard distribution
+}
+
+# -- #mozbot was here --
+#    $conn->add_handler('gender',\&on_ctcp_gender);
+#    sub on_ctcp_gender{
+#        my (undef, $event)=@_;
+#        my $nick=$event->nick;
+#           # timeless this suspense is killing me!
+#        $bot->ctcp_reply($nick, 'neuter');
+#    }
+
+# on_gender: What gender are we?
+sub on_gender {
+    my ($self, $event) = @_;
+    my $nick = $event->nick;
+    $self->ctcp_reply($nick, $gender);
+}
+
+# on_nick: A nick changed -- was it ours?
+sub on_nick {
+    my ($self, $event) = @_;
+    if ($event->nick eq $nicks[$nick]) {
+        on_set_nick($self, $event);
+    }
+    &do(@_, 'SpottedNickChange');
+}
+
+# simple handler for when users do various things and stuff
+sub on_join { &do(@_, 'SpottedJoin'); }
+sub on_part { &do(@_, 'SpottedPart'); }
+sub on_quit { &do(@_, 'SpottedQuit'); }
+sub on_invite { &do(@_, 'Invited'); }
+sub on_mode { &do(@_, 'ModeChange'); } # XXX need to parse modes # XXX on key change, change %channelKeys hash
+sub on_umode { &do(@_, 'UModeChange'); }
+sub on_version { &do(@_, 'CTCPVersion'); }
+sub on_source { &do(@_, 'CTCPSource'); }
+sub on_cping { &do(@_, 'CTCPPing'); }
+
+sub newEvent($) {
+    my $event = shift;
+    $event->{'time'} = time();
+    return $event;
+}
+
+sub toToChannel {
+    my $self = shift;
+    my $channel;
+    foreach (@_) {
+        if (/^[#&+\$]/os) {
+            if (defined($channel)) {
+                return '';
+            } else {
+                $channel = $_;
+            }
+        } elsif ($_ eq $nicks[$nick]) {
+            return '';
+        }
+    }
+    return lc($channel); # if message was sent to one person only, this is it
+}
+
+# XXX some code below calls this, on lines marked "hack hack hack". We
+# should fix this so that those are supported calls.
+sub do {
+    my $self = shift @_;
+    my $event = shift @_;
+    my $to = $event->to;
+    my $channel = &toToChannel($self, @$to);
+    my $e = newEvent({
+        'bot' => $self,
+        '_event' => $event, # internal internal internal do not use... ;-)
+        'channel' => $channel,
+        'from' => $event->nick,
+        'target' => $channel || $event->nick,
+        'user' => $event->userhost,
+        'data' => join(' ', $event->args),
+        'fulldata' => defined($event->{'__mozbot__fulldata'}) ? $event->{'__mozbot__fulldata'} : join(' ', $event->args),
+        'to' => $to,
+        'subtype' => $event->type,
+        'firsttype' => $_[0],
+        'nick' => $nicks[$nick],
+        # level   (set below)
+        # type  (set below)
+    });
+    # updated admin field if person is an admin
+    if ($authenticatedUsers{$event->userhost}) {
+        if (($userFlags{$authenticatedUsers{$event->userhost}} & 1) == 1) {
+            $lastadmin = $event->nick;
+        }
+        $e->{'userName'} = $authenticatedUsers{$event->userhost};
+        $e->{'userFlags'} = $userFlags{$authenticatedUsers{$event->userhost}};
+    } else {
+        $e->{'userName'} = 0;
+    }
+    unless (scalar(grep $e->{'user'} =~ /^$_$/gi, @ignoredUsers)) {
+        my $continue;
+        do {
+            my $type = shift @_;
+            my $level = 0;
+            my @modulesInNextLoop = @modules;
+            $continue = 1;
+            $e->{'type'} = $type;
+            &debug("$type: $channel <".$event->nick.'> '.join(' ', $event->args));
+            do {
+                $level++;
+                $e->{'level'} = $level;
+                my @modulesInThisLoop = @modulesInNextLoop;
+                @modulesInNextLoop = ();
+                foreach my $module (@modulesInThisLoop) {
+                    my $currentResponse;
+                    eval {
+                        $currentResponse = $module->do($self, $event, $type, $e);
+                    };
+                    if ($@) {
+                        # $@ contains the error
+                        &debug("ERROR IN MODULE $module->{'_name'}!!!", $@);
+                    } elsif (!defined($currentResponse)) {
+                        &debug("ERROR IN MODULE $module->{'_name'}: invalid response code to event '$type'.");
+                    } else {
+                        if ($currentResponse > $level) {
+                            push(@modulesInNextLoop, $module);
+                        }
+                        $continue = ($continue and $currentResponse);
+                    }
+                }
+            } while ($continue and @modulesInNextLoop);
+        } while ($continue and scalar(@_));
+    } else {
+        &debug('Ignored (from \'' . $event->userhost . "'): $channel <".$event->nick.'> '.join(' ', $event->args));
+    }
+    &doLog($e);
+}
+
+sub doLog {
+    my $e = shift;
+    foreach my $module (@modules) {
+        eval {
+            $module->Log($e);
+        };
+        if ($@) {
+            # $@ contains the error
+            &debug("ERROR!!!", $@);
+        }
+    }
+}
+
+
+################################
+# internal utilities           #
+################################
+
+my @msgqueue;
+my %recentMessages;
+my $timeLastSetAway = 0; # the time since the away flag was last set, so that we don't set it repeatedly.
+
+# Use this routine, always, instead of the standard "privmsg" routine.  This
+# one makes sure we don't send more than one message every two seconds or so,
+# which will make servers not whine about us flooding the channel.
+# messages aren't the only type of flood :-( away is included
+sub sendmsg {
+    my ($self, $who, $msg, $do) = (@_, 'msg');
+    unless ((defined($do) and defined($msg) and defined($who) and ($who ne '')) and
+            ((($do eq 'msg') and (not ref($msg))) or
+             (($do eq 'me') and (not ref($msg))) or
+             (($do eq 'notice') and (not ref($msg))) or
+             (($do eq 'ctcpSend') and (ref($msg) eq 'ARRAY') and (@$msg >= 2)) or
+             (($do eq 'ctcpReply') and (not ref($msg))))) {
+        cluck('Wrong arguments passed to sendmsg() - ignored');
+    } else {
+        $self->schedule($delaytime / 2, \&drainmsgqueue) unless @msgqueue;
+        if ($do eq 'msg' or $do eq 'me' or $do eq 'notice') {
+            foreach (splitMessageAcrossLines($msg)) {
+                push(@msgqueue, [$who, $_, $do]);
+            }
+        } else {
+            push(@msgqueue, [$who, $msg, $do]);
+        }
+    }
+}
+
+# send any pending messages
+sub drainmsgqueue {
+    my $self = shift;
+    return unless $self->connected;
+    my $qln = @msgqueue;
+    if (@msgqueue > 0) {
+        my ($who, $msg, $do) = getnextmsg();
+        unless (weHaveSaidThisTooManyTimesAlready($self, \$who, \$msg, \$do)) {
+            my $type;
+            if ($do eq 'msg') {
+                &debug("->$who: $msg"); # XXX this makes logfiles large quickly...
+                $self->privmsg($who, $msg); # it seems 'who' can be an arrayref and it works
+                $type = 'Heard';
+            } elsif ($do eq 'me') {
+                &debug("->$who * $msg"); # XXX
+                $self->me($who, $msg);
+                $type = 'Saw';
+            } elsif ($do eq 'notice') {
+                &debug("=notice=>$who: $msg");
+                $self->notice($who, $msg);
+                # $type = 'XXX';
+            } elsif ($do eq 'ctcpSend') {
+                { local $" = ' '; &debug("->$who CTCP PRIVMSG @$msg"); }
+                my $type = shift @$msg; # @$msg contains (type, args)
+                $self->ctcp($type, $who, @$msg);
+                # $type = 'XXX';
+            } elsif ($do eq 'ctcpReply') {
+                &debug("->$who CTCP NOTICE $msg");
+                $self->ctcp_reply($who, $msg);
+                # $type = 'XXX';
+            } else {
+                &debug("Unknown action '$do' intended for '$who' (content: '$msg') ignored.");
+            }
+            if (defined($type)) {
+                &doLog(newEvent({
+                    'bot' => $self,
+                    '_event' => undef,
+                    'channel' => &toToChannel($self, $who),
+                    'from' => $nicks[$nick],
+                    'target' => $who,
+                    'user' => undef, # XXX
+                    'data' => $msg,
+                    'fulldata' => $msg,
+                    'to' => $who,
+                    'subtype' => undef,
+                    'firsttype' => $type,
+                    'nick' => $nicks[$nick],
+                    'level' => 0,
+                    'type' => $type,
+                }));
+            }
+        }
+        if (@msgqueue > 0) {
+            if ((@msgqueue % 10 == 0) and (time() - $timeLastSetAway > 5 * $delaytime)) {
+                &bot_longprocess($self, "Long send queue. There were $qln, and I just sent one to $who.");
+                $timeLastSetAway = time();
+                $self->schedule($delaytime * 4, # because previous one counts as message, plus you want to delay an extra bit regularly
+                    \&drainmsgqueue);
+            } else {
+                $self->schedule($delaytime, \&drainmsgqueue);
+            }
+        } else {
+            &bot_back($self); # clear away state
+        }
+    }
+}
+
+sub weHaveSaidThisTooManyTimesAlready {
+    my($self, $who, $msg, $do) = @_;
+    my $key;
+    if ($$do eq 'ctcpSend') {
+        local $" = ',';
+        $key = "$$who,$$do,@{$$msg}";
+    } else {
+        $key = "$$who,$$do,$$msg";
+    }
+    my $count = ++$recentMessages{$key};
+    if ($count >= $recentMessageCountThreshold and
+        $count < $recentMessageCountThreshold + 1 and
+        $$do ne 'ctcpSend') {
+        $recentMessages{$key} += $recentMessageCountPenalty;
+        my $text = $$msg;
+        if (length($msg) > 23) { # arbitrary length (XXX)
+            $text = substr($text, 0, 20) . '...';
+        }
+        $$do = 'me';
+        $$msg = "was going to say '$text' but has said it too many times today already";
+    } elsif ($count >= $recentMessageCountThreshold) {
+        if ($count > $recentMessageCountLimit) {
+            # if the message keeps getting output, we'll get to the
+            # point where if it stops it doesn't matter because the
+            # recent count will be _so_ high we'll never see zero
+            # again. So here we put a cap on the recent message count.
+            $recentMessages{$key} = $recentMessageCountLimit;
+        }
+        if ($$do eq 'msg') {
+            &debug("MUTED: ->$$who: $$msg");
+        } elsif ($$do eq 'me') {
+            &debug("MUTED: ->$$who * $$msg"); # XXX
+        } elsif ($$do eq 'notice') {
+            &debug("MUTED: =notice=>$$who: $$msg");
+        } elsif ($$do eq 'ctcpSend') {
+            local $" = ' ';
+            &debug("MUTED: ->$$who CTCP PRIVMSG @{$$msg}");
+        } elsif ($$do eq 'ctcpReply') {
+            &debug("MUTED: ->$$who CTCP NOTICE $$msg");
+        } else {
+            &debug("MUTED: Unknown action '$$do' intended for '$$who' (content: '$$msg') ignored.");
+        }
+        return 1;
+    }
+    return 0;
+}
+
+sub lowerRecentMessageCount {
+    my $self = shift;
+    return unless $self->connected;
+    foreach my $key (keys %recentMessages) {
+        $recentMessages{$key} -= $recentMessageCountDecrementRate;
+        if ($recentMessages{$key} <= 0) {
+            delete $recentMessages{$key};
+        }
+    }
+    $self->schedule($delaytime, \&lowerRecentMessageCount);
+}
+
+# wrap long lines at spaces and hard returns (\n)
+# this is for IRC, not for the console -- long can be up to 255
+sub splitMessageAcrossLines {
+    my ($str) = @_;
+    my $MAXPROTOCOLLENGTH = 255;
+    my @output;
+    # $str could be several lines split with \n, so split it first:
+    foreach my $line (split(/\n/, $str)) {
+        while (length($line) > $MAXPROTOCOLLENGTH) {
+            # position is zero-based index
+            my $pos = rindex($line, ' ', $MAXPROTOCOLLENGTH - 1);
+            if ($pos < 0) {
+                $pos = $MAXPROTOCOLLENGTH - 1;
+            }
+            push(@output, substr($line, 0, $pos));
+            $line = substr($line, $pos);
+            $line =~ s/^\s+//gos;
+        }
+        push(@output, $line) if length($line);
+    }
+    return @output;
+}
+
+# equivalent of shift or pop, but for the middle of the array.
+# used by getnextmsg() below to pull the messages out of the
+# msgqueue stack and shove them at the end.
+sub yank {
+    my ($index, $list) = @_;
+    my $result = @{$list}[$index];
+    @{$list} = (@{$list}[0..$index-1], @{$list}[$index+1..$#{$list}]);
+    return $result;
+}
+
+# looks at the msgqueue stack and decides which message to send next.
+sub getnextmsg {
+    my ($who, $msg, $do) = @{shift(@msgqueue)};
+    my @newmsgqueue;
+    my $index = 0;
+    while ($index < @msgqueue) {
+        if ($msgqueue[$index]->[0] eq $who) {
+            push(@newmsgqueue, &yank($index, \@msgqueue));
+        } else {
+            $index++;
+        }
+    }
+    push(@msgqueue, @newmsgqueue);
+    return ($who, $msg, $do);
+}
+
+my $markedaway = 0;
+
+# mark bot as being away
+sub bot_longprocess {
+    my $self = shift;
+    &debug('[away: '.join(' ',@_).']');
+    $self->away(join(' ',@_));
+    $markedaway = @_;
+}
+
+# mark bot as not being away anymore
+sub bot_back {
+    my $self = shift;
+    $self->away('') if $markedaway;
+    $markedaway = 0;
+}
+
+
+# internal routines for IO::Select handling
+
+sub bot_select {
+    my ($pipe) = @_;
+    $irc->removefh($pipe);
+    # enable slurp mode for this function (see man perlvar for $/ documentation)
+    local $/;
+    undef $/;
+    my $data = <$pipe>;
+    &debug("child ${$pipe}->{'BotModules_PID'} completed ${$pipe}->{'BotModules_ChildType'}".
+           (${$pipe}->{'BotModules_Module'}->{'_shutdown'} ?
+            ' (nevermind, module has shutdown)': ''));
+    kill 9, ${$pipe}->{'BotModules_PID'}; # ensure child is dead
+    # non-blocking reap of any pending zombies
+    1 while waitpid(-1,WNOHANG) > 0;
+    return if ${$pipe}->{'BotModules_Module'}->{'_shutdown'}; # see unload()
+    eval {
+        ${$pipe}->{'BotModules_Event'}->{'time'} = time(); # update the time field of the event
+        ${$pipe}->{'BotModules_Module'}->ChildCompleted(
+            ${$pipe}->{'BotModules_Event'},
+            ${$pipe}->{'BotModules_ChildType'},
+            $data,
+            @{${$pipe}->{'BotModules_Data'}}
+        );
+    };
+    if ($@) {
+        # $@ contains the error
+        &debug("ERROR!!!", $@);
+    }
+    # prevent any memory leaks by cleaning up all the variables we added
+    foreach (keys %{${$pipe}}) {
+        m/^BotModules_/ && delete(${$pipe}->{$_});
+    }
+}
+
+sub bot_select_data_available {
+    my ($handle) = @_;
+    &debug("Module ${$handle}->{'BotModules_Module'}->{'_name'} received some data");
+    # read data while there is some
+    my $fh = '';
+    vec($fh, fileno($handle), 1) = 1;
+    my $count = 0; # number of bytes read
+    my $ready;
+    my $data = '';
+    my $close = 0;
+    while (select($ready = $fh, undef, undef, 0.1) and
+           vec($ready, fileno($handle), 1) and
+           $count < 1024 and
+           not $close) { # read up to 1kb
+        sysread($handle, $data, 1, length($data)) or $close = 1;
+    } 
+    if (not ${$handle}->{'BotModules_Module'}->{'_shutdown'}) {
+        eval {
+            ${$handle}->{'BotModules_Event'}->{'time'} = time();
+            ${$handle}->{'BotModules_Module'}->DataAvailable(
+                ${$handle}->{'BotModules_Event'},
+                $handle,
+                $data,
+                $close,
+            );
+        };
+        if ($@) {
+            # $@ contains the error
+            &debug("ERROR!!!", $@);
+        }
+    } else {
+        # module doesn't care, it was shut down
+        &debug("Dropping data - module is already shut down.");
+        $close = 1;
+    }
+    if ($close) {
+        # Note: It's the responsibility of the module to actually
+        # close the handle.
+        &debug("Dropping handle...");
+        $irc->removefh($handle);
+        # prevent any memory leaks by cleaning up all the variables we added
+        foreach (keys %{${$handle}}) {
+            m/^BotModules_/ && delete(${$handle}->{$_});
+        }
+    }
+}
+
+
+# internal routines for console output, stuff
+
+# print debugging info
+sub debug {
+    my $line;
+    foreach (@_) {
+        $line = $_; # can't chomp $_ since it is a hardref to the arguments...
+        chomp $line; # ...and they are probably a constant string!
+        if (-t) {
+            print &logdate() . " ($$) $line";
+        }
+        if ($LOGGING) {
+            # XXX this file grows without bounds!!!
+            if (open(LOG, ">>$LOGFILEPREFIX.$$.log")) {
+                print LOG &logdate() . " $line\n";
+                close(LOG);
+                print "\n";
+            } else {
+                print " [not logged, $!]\n";
+            }
+        }
+    }
+}
+
+# logdate: return nice looking date and time stamp
+sub logdate {
+    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift or time());
+    return sprintf("%d-%02d-%02d %02d:%02d:%02d UTC",
+                   $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
+}
+
+# days: how long ago was that?
+sub days {
+    my $then = shift;
+    # maths
+    my $seconds = time() - $then;
+    my $minutes = int ($seconds / 60);
+    my $hours = int ($minutes / 60);
+    my $days = int ($hours / 24);
+    # english
+    if ($seconds < 60) {
+        return sprintf("%d second%s", $seconds, $seconds == 1 ? "" : "s");
+    } elsif ($minutes < 60) {
+        return sprintf("%d minute%s", $minutes, $minutes == 1 ? "" : "s");
+    } elsif ($hours < 24) {
+        return sprintf("%d hour%s", $hours, $hours == 1 ? "" : "s");
+    } else {
+        return sprintf("%d day%s", $days, $days == 1 ? "" : "s");
+    }
+}
+
+# signal handler
+sub killed {
+    my($sig) = @_;
+    &debug("received signal $sig. shutting down...");
+    &debug('This is evil. You should /msg me a shutdown command instead.');
+    &debug('WARNING: SHUTTING ME DOWN LIKE THIS CAN CAUSE FORKED PROCESSES TO START UP AS BOTS!!!'); # XXX which we should fix, of course.
+    exit(1); # sane exit, including shutting down any modules
+}
+
+
+# internal routines for configuration
+
+my %configStructure; # hash of cfg file keys and associated variable refs
+
+# ok. In strict 'refs' mode, you cannot use strings as refs. Fair enough.
+# However, hash keys are _always_ strings. Using a ref as a hash key turns
+# it into a string. So we have to keep a virgin copy of the ref around.
+#
+# So the structure of the %configStructure hash is:
+#   "ref" => [ cfgName, ref ]
+# Ok?
+
+sub registerConfigVariables {
+    my (@variables) = @_;
+    foreach (@variables) {
+        $configStructure{$$_[0]} = [$$_[1], $$_[0]];
+    }
+} # are you confused yet?
+
+sub configStructure {
+    my (@variables) = @_;
+    my %struct;
+    @variables = keys %configStructure unless @variables;
+    foreach (@variables) {
+        confess("Function configStructure was passed something that is either not a ref or has not yet neem registered, so aborted") unless defined($configStructure{$_});
+        $struct{$configStructure{$_}[0]} = $configStructure{$_}[1];
+    }
+    return \%struct;
+}
+
+
+# internal routines for handling the modules
+
+sub getModule {
+    my ($name) = @_;
+    foreach my $module (@modules) { # XXX this is not cached as a hash as performance is not a priority here
+        return $module if $name eq $module->{'_name'};
+    }
+    return undef;
+}
+
+sub LoadModule {
+    my ($name) = @_;
+    # sanitize the name
+    $name =~ s/[^-a-zA-Z0-9]/-/gos;
+    # check the module is not already loaded
+    foreach (@modules) {
+        if ($_->{'_name'} eq $name) {
+            return "Failed [0]: Module already loaded. Don't forget to enable it in the various channels (vars $name channels '+#channelname').";
+        }
+    }
+    # read the module in from a file
+    my $filename = "./BotModules/$name.bm"; # bm = bot module
+    my $result = open(my $file, "< $filename");
+    if ($result) {
+        my $code = do {
+            local $/ = undef; # enable "slurp" mode
+            <$file>; # whole file now here
+        };
+        if ($code) {
+#           if ($code =~ /package\s+\QBotModules::$name\E\s*;/gos) { XXX doesn't work reliably?? XXX
+                # eval the file
+                $code =~ /^(.*)$/os;
+                $code = $1; # completely defeat the tainting mechanism.
+                # $code = "# FILE: $filename\n".$code; # "# file 1 '$filename' \n" would be good without Carp.pm
+                { no warnings; # as per the warning, but doesn't work??? XXX
+                eval($code); }
+                if ($@) {
+                    # $@ contains the error
+                    return "Failed [4]: $@";
+                } else {
+                    # if ok, then create a module
+                    my $newmodule;
+                    eval("
+                        \$newmodule = BotModules::$name->create('$name', '$filename');
+                    ");
+                    if ($@) {
+                        # $@ contains the error
+                        return "Failed [5]: $@";
+                    } else {
+                        # if ok, then add it to the @modules list
+                        push(@modules, $newmodule);
+                        push(@modulenames, $newmodule->{'_name'});
+                        &Configuration::Save($cfgfile, &::configStructure(\@modulenames));
+                        # Done!!!
+                        return $newmodule;
+                    }
+                }
+#           } else {
+#               return "Failed [3]: Could not find valid module definition line.";
+#           }
+        } else {
+            # $! contains the error
+            if ($!) {
+                return "Failed [2]: $!";
+            } else {
+                return "Failed [2]: Module file is empty.";
+            }
+        }
+    } else {
+        # $! contains the error
+        return "Failed [1]: $!";
+    }
+}
+
+sub UnloadModule {
+    my ($name) = @_;
+    # remove the reference from @modules
+    my @newmodules;
+    my @newmodulenames;
+    foreach (@modules) {
+        if ($name eq $_->{'_name'}) {
+            if ($_->{'_static'}) {
+                return 'Cannot unload this module, it is built in.';
+            }
+            $_->unload();
+        } else {
+            push(@newmodules, $_);
+            push(@newmodulenames, $_->{'_name'});
+        }
+    }
+    if (@modules == @newmodules) {
+        return 'Module not loaded. Are you sure you have the right name?';
+    } else {
+        @modules = @newmodules;
+        @modulenames = @newmodulenames;
+        &Configuration::Save($cfgfile, &::configStructure(\@modulenames));
+        return;
+    }
+}
+
+# password management functions
+
+sub getSalt {
+    # straight from man perlfunc
+    return join('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]);
+}
+
+sub newPassword {
+    my($text) = @_;
+    return crypt($text, &getSalt());
+}
+
+sub checkPassword {
+    my($text, $password) = @_;
+    return (crypt($text, $password) eq $password);
+}
+
+################################
+# Base Module                  #
+################################
+
+# And now, for my next trick, the base module (duh).
+
+package BotModules;
+
+1; # nothing to see here...
+
+# ENGINE INTERFACE
+
+# create - create a new BotModules object.
+# Do not call this yourself. We call it. Ok?
+# Do not override this either, unless you know what
+# you are doing (I don't, and I wrote it...). If you
+# want to add variables to $self, use Initialise.
+# The parameter is the name of the module.
+sub create {
+    my $class = shift;
+    my ($name, $filename) = @_;
+    my $self = {
+        '_name' => $name,
+        '_shutdown' => 0, # see unload()
+        '_static' => 0, # set to 1 to prevent module being unloaded
+        '_variables' => {},
+        '_config' => {},
+        '_filename' => $filename,
+        '_filemodificationtime' => undef,
+    };
+    bless($self, $class);
+    $self->Initialise();
+    $self->RegisterConfig();
+    return $self;
+}
+
+sub DESTROY {
+    my $self = shift;
+    $self->debug('garbage collected');
+}
+
+# called by &::UnloadModule().
+# this removes any pointers to the module.
+# for example, it stops the scheduler from installing new timers,
+# so that the bot [eventually] severs its connection with the module.
+sub unload {
+    my $self = shift;
+    $self->Unload(); # hook for bot modules to use
+    $self->{'_shutdown'} = 1; # see doScheduled and bot_select
+}
+
+# configStructure - return the hash needed for Configuration module
+sub configStructure {
+    my $self = shift;
+    return $self->{'_config'};
+}
+
+# do - called to do anything (duh) (no, do, not duh) (oh, ok, sorry)
+sub do {
+    my $self = shift;
+    my ($bot, $event, $type, $e) = @_;
+    # first, we check that the user is not banned from using this module. If he
+    # is, then re give up straight away.
+    return 1 if ($self->IsBanned($e));
+    # next we check that the module is actually enabled in this channel, and
+    # if it is not we quit straight away as well.
+    return 1 unless ($e->{'channel'} eq '') or ($self->InChannel($e));
+    # Ok, dispatch the event.
+    if ($type eq 'Told') {
+        return $self->Told($e, $e->{'data'});
+    } elsif ($type eq 'Heard') {
+        return $self->Heard($e, $e->{'data'});
+    } elsif ($type eq 'Baffled') {
+        return $self->Baffled($e, $e->{'data'});
+    } elsif ($type eq 'Noticed') {
+        return $self->Noticed($e, $e->{'data'});
+    } elsif ($type eq 'Felt') {
+        return $self->Felt($e, $e->{'data'});
+    } elsif ($type eq 'Saw') {
+        return $self->Saw($e, $e->{'data'});
+    } elsif ($type eq 'Invited') {
+        return $self->Invited($e, $e->{'data'});
+    } elsif ($type eq 'Kicked') {
+        return $self->Kicked($e, $e->{'channel'});
+    } elsif ($type eq 'ModeChange') {
+        return $self->ModeChange($e, $e->{'channel'}, $e->{'data'}, $e->{'from'});
+    } elsif ($type eq 'Authed') {
+        return $self->Authed($e, $e->{'from'});
+    } elsif ($type eq 'SpottedNickChange') {
+        return $self->SpottedNickChange($e, $e->{'from'}, $e->{'data'});
+    } elsif ($type eq 'SpottedTopicChange') {
+        return $self->SpottedTopicChange($e, $e->{'channel'}, $e->{'data'});
+    } elsif ($type eq 'SpottedJoin') {
+        return $self->SpottedJoin($e, $e->{'channel'}, $e->{'from'});
+    } elsif ($type eq 'SpottedPart') {
+        return $self->SpottedPart($e, $e->{'channel'}, $e->{'from'});
+    } elsif ($type eq 'SpottedKick') {
+        return $self->SpottedKick($e, $e->{'channel'}, $e->{'data'});
+    } elsif ($type eq 'SpottedQuit') {
+        return $self->SpottedQuit($e, $e->{'from'}, $e->{'data'});
+    } elsif ($type eq 'CTCPPing') {
+        return $self->CTCPPing($e, $e->{'from'}, $e->{'data'});
+    } elsif ($type eq 'CTCPVersion') {
+        return $self->CTCPVersion($e, $e->{'from'}, $e->{'data'});
+    } elsif ($type eq 'CTCPSource') {
+        return $self->CTCPSource($e, $e->{'from'}, $e->{'data'});
+
+    # XXX have not implemented mode parsing yet
+    } elsif ($type eq 'GotOpped') {
+        return $self->GotOpped($e, $e->{'channel'}, $e->{'from'});
+    } elsif ($type eq 'GotDeopped') {
+        return $self->GotDeopped($e, $e->{'channel'}, $e->{'from'});
+    } elsif ($type eq 'SpottedOpping') {
+        return $self->SpottedOpping($e, $e->{'channel'}, $e->{'from'});
+    } elsif ($type eq 'SpottedDeopping') {
+        return $self->SpottedDeopping($e, $e->{'channel'}, $e->{'from'});
+    } else {
+        $self->debug("Unknown action type '$type'. Ignored.");
+        # XXX UModeChange (not implemented yet)
+        return 1; # could not do it
+    }
+}
+
+
+# MODULE API - use these from the your routines.
+
+# prints output to the console
+sub debug {
+    my $self = shift;
+    foreach my $line (@_) {
+        &::debug('Module '.$self->{'_name'}.': '.$line);
+    }
+}
+
+# saveConfig - call this when you change a configuration option. It resaves the config file.
+sub saveConfig {
+    my $self = shift;
+    &Configuration::Save($cfgfile, $self->configStructure());
+}
+
+# registerVariables - Registers a variable with the config system and the var setting system
+# parameters: (
+#     [ 'name', persistent ? 1:0, editable ? 1:0, $value ],
+#               use undef instead of 0 or 1 to leave as is
+#               use undef (or don't mention) the $value to not set the value
+# )
+sub registerVariables {
+    my $self = shift;
+    my (@variables) = @_;
+    foreach (@variables) {
+        $self->{$$_[0]} = $$_[3] if defined($$_[3]);
+        if (defined($$_[1])) {
+            if ($$_[1]) {
+                $self->{'_config'}->{$self->{'_name'}.'::'.$$_[0]} = \$self->{$$_[0]};
+            } else {
+                delete($self->{'_config'}->{$self->{'_name'}.'::'.$$_[0]});
+            }
+        }
+        $self->{'_variables'}->{$$_[0]} = $$_[2] if defined($$_[2]);
+    }
+}
+
+# internal implementation of the scheduler
+sub doScheduled {
+    my $bot = shift;
+    my ($self, $event, $time, $times, @data) = @_;
+    return if ($self->{'_shutdown'}); # see unload()
+    # $self->debug("scheduled event occured; $times left @ $$time second interval");
+    eval {
+        $event->{'time'} = time(); # update the time field of the event
+        $self->Scheduled($event, @data);
+        $self->schedule($event, $time, --$times, @data);
+    };
+    if ($@) {
+        # $@ contains the error
+        &::debug("ERROR!!!", $@);
+    }
+}
+
+# schedule - Sets a timer to call Scheduled later
+# for events that should be setup at startup, call this from Schedule().
+sub schedule {
+    my $self = shift;
+    my ($event, $time, $times, @data) = @_;
+    return if ($times == 0 or $self->{'_shutdown'}); # see unload()
+    $times = -1 if ($times < 0); # pass a negative number to have a recurring timer
+    my $delay = $time;
+    if (ref($time)) {
+        if (ref($time) eq 'SCALAR') {
+            $delay = $$time;
+        } else {
+            return; # XXX maybe be useful?
+        }
+    }
+    # if ($delay < 1) {
+    #     $self->debug("Vetoed aggressive scheduling; forcing to 1 second minimum");
+    #     $delay = 1;
+    # }
+    $event->{'bot'}->schedule($delay, \&doScheduled, $self, $event, $time, $times, @data);
+}
+
+# spawnChild - spawns a child process and adds it to the list of file handles to monitor
+# eventually the bot calls ChildCompleted() with the output of the child process.
+sub spawnChild {
+    my $self = shift;
+    my ($event, $command, $arguments, $type, $data) = @_;
+    # uses IO::SecurePipe and fork and exec
+    # secure, predictable, no dependencies on external code
+    # uses fork explicitly (and once implicitly)
+    my $pipe = IO::SecurePipe->new();
+    if (defined($pipe)) {
+        my $child = fork();
+        if (defined($child)) {
+            if ($child) {
+                # we are the parent process
+                $pipe->reader();
+                ${$pipe}->{'BotModules_Module'} = $self;
+                ${$pipe}->{'BotModules_Event'} = {%$event}; # Must be unchanged
+                ${$pipe}->{'BotModules_ChildType'} = $type;
+                ${$pipe}->{'BotModules_Data'} = $data;
+                ${$pipe}->{'BotModules_Command'} = $command;
+                ${$pipe}->{'BotModules_Arguments'} = $arguments;
+                ${$pipe}->{'BotModules_PID'} = $child;
+                $irc->addfh($pipe, \&::bot_select);
+                local $" = ' ';
+                $self->debug("spawned $child ($command @$arguments)");
+                return 0;
+            } else {
+                eval {
+                    # we are the child process
+                    # call $command and buffer the output
+                    $pipe->writer(); # get writing end of pipe, ready to output the result
+                    my $output;
+                    if (ref($command) eq 'CODE') {
+                        $output = &$command(@$arguments);
+                    } else {
+                        # it would be nice if some of this was on a timeout...
+                        my $result = IO::SecurePipe->new(); # create a new pipe for $command
+                        # call $command (implicit fork(), which may of course fail)
+                        $result->reader($command, @$arguments);
+                        local $/; # to not affect the rest of the program (what little there is)
+                        $/ = \(2*1024*1024); # slurp up to two megabytes
+                        $output = <$result>; # blocks until child process has finished
+                        close($result); # reap child
+                    }
+                    print $pipe $output if ($output); # output the lot in one go back to parent
+                    $pipe->close();
+                };
+                if ($@) {
+                    # $@ contains the error
+                    $self->debug('failed to spawn child', $@);
+                }
+
+                # -- #mozwebtools was here --
+                #        when is that stupid bot going to get checked in?
+                #    after it stops fork bombing
+                #        which one? yours or hixies?
+                #    his, mine doesn't fork
+                #    see topic
+                #        are there plans to fix it?
+                #    yes. but he isn't sure exactly what went wrong
+                #    i think it's basically they fork for wget
+                #        why don't you help him?
+                #    i don't understand forking
+                #        that didn't stop hixie
+                #    not to mention the fact that his forking doesn't
+                #              work on windows
+                #        you have other machines. techbot1 runs on windows?
+                #    yeah it runs on windows
+                #        oh
+                #        get a real os, man
+
+                # The bug causing the 'fork bombing' was that I only
+                # did the following if $@ was true or if the call to
+                # 'reader' succeeded -- so if some other error occured
+                # that didn't trip the $@ test but still crashed out
+                # of the eval, then the script would quite happily
+                # continue, and when it eventually died (e.g. because
+                # of a bad connection), it would respawn multiple
+                # times (as many times as it had failed to fork) and
+                # it would succeed in reconnecting as many times as
+                # had been configured nicks...
+
+                eval {
+                    $0 =~ m/^(.*)$/os; # untaint $0 so that we can call it below:
+                    exec { $1 } ($1, '--abort'); # do not call shutdown handlers
+                    # the previous line works because exec() bypasses
+                    # the perl object garbarge collection and simply
+                    # deallocates all the memory in one go. This means
+                    # the shutdown handlers (DESTROY and so on) are
+                    # never called for this fork. This is good,
+                    # because otherwise we would disconnect from IRC
+                    # at this point!
+                };
+
+                $self->debug("failed to shutdown cleanly!!! $@");
+                exit(1); # exit in case exec($0) failed
+
+            }
+        } else {
+            $self->debug("failed to fork: $!");
+        }
+    } else {
+        $self->debug("failed to open pipe: $!");
+    }
+    return 1;
+}
+
+# registerDataHandle - eventually calls DataAvailable
+sub registerDataHandle {
+    my $self = shift;
+    my ($event, $handle, $details) = @_;
+    ${$handle}->{'BotModules_Module'} = $self;
+    ${$handle}->{'BotModules_Event'} = $event;
+    ${$handle}->{'BotModules_Details'} = $details;
+    $irc->addfh($handle, \&::bot_select_data_available);
+    my $fileno = fileno($handle);
+    $self->debug("listening to filehandle or socket $fileno");
+}
+
+# getURI - Downloads a file and then calls GotURI
+sub getURI {
+    my $self = shift;
+    my ($event, $uri, @data) = @_;
+    $self->spawnChild($event, 'wget', ['--quiet', '--passive', '--user-agent="Mozilla/5.0 (compatible; mozbot)"',  '--output-document=-', $uri], 'URI', [$uri, @data]);
+}
+
+# returns a reference to a module -- DO NOT STORE THIS REFERENCE!!!
+sub getModule {
+    my $self = shift;
+    return &::getModule(@_);
+}
+
+# returns a reference to @msgqueue
+# manipulating this is probably not a good idea. In particular,
+# don't add anything to this array (use the appropriate methods
+# instead, those that use &::sendmsg, below).
+sub getMessageQueue {
+    my $self = shift;
+    return \@msgqueue;
+}
+
+# returns the value of $helpline
+sub getHelpLine {
+    return $helpline;
+}
+
+# returns a sorted list of module names
+sub getModules {
+    return sort(@modulenames);
+}
+
+# returns a filename with path suitable to use for logging
+sub getLogFilename {
+    my $self = shift;
+    my($name) = @_;
+    return "$LOGFILEDIR/$name";
+}
+
+# tellAdmin - may try to talk to an admin.
+# NO GUARANTEES! This will PROBABLY NOT reach anyone!
+sub tellAdmin {
+    my $self = shift;
+    my ($event, $data) = @_;
+    if ($lastadmin) {
+        $self->debug("Trying to tell admin '$lastadmin' this: $data");
+        &::sendmsg($event->{'bot'}, $lastadmin, $data);
+    } else {
+        $self->debug("Wanted to tell an admin '$data', but I've never seen one.");
+    }
+}
+
+# ctcpSend - Sends a CTCP message to someone
+sub ctcpSend {
+    my $self = shift;
+    my ($event, $type, $data) = @_;
+    &::sendmsg($event->{'bot'}, $event->{'target'}, [$type, $data], 'ctcpSend');
+}
+
+# ctcpReply - Sends a CTCP reply to someone
+sub ctcpReply {
+    my $self = shift;
+    my ($event, $type, $data) = @_;
+    unless (defined($type)) {
+        cluck('No type passed to ctcpReply - ignored');
+    }
+    if (defined($data)) {
+        &::sendmsg($event->{'bot'}, $event->{'from'}, "$type $data", 'ctcpReply');
+    } else {
+        &::sendmsg($event->{'bot'}, $event->{'from'}, $type, 'ctcpReply');
+    }
+}
+
+# notice - Sends a notice to a channel or person
+sub notice {
+    my $self = shift;
+    my ($event, $data) = @_;
+    &::sendmsg($event->{'bot'}, $event->{'target'}, $data, 'notice');
+}
+
+# say - Sends a message to the channel
+sub say {
+    my $self = shift;
+    my ($event, $data) = @_;
+    return unless defined $event->{'target'};
+    $data =~ s/^\Q$event->{'target'}\E: //gs;
+    &::sendmsg($event->{'bot'}, $event->{'target'}, $data);
+}
+
+# privsay - Sends message to person or channel directly
+# only use this if its time-senstive, otherwise you should use say
+sub privsay {
+	my $self = shift;
+    my ($event, $data) = @_;
+	return unless defined $event->{'target'};
+	$data =~ s/^\Q$event->{'target'}\E: //gs;
+	$event->{'bot'}->privmsg($event->{'target'}, $data);
+}
+
+# announce - Sends a message to every channel
+sub announce {
+    my $self = shift;
+    my ($event, $data) = @_;
+    foreach (@{$self->{'channels'}}) {
+        &::sendmsg($event->{'bot'}, $_, $data);
+    }
+}
+
+# directSay - Sends a message to the person who spoke
+sub directSay {
+    my $self = shift;
+    my ($event, $data) = @_;
+    &::sendmsg($event->{'bot'}, $event->{'from'}, $data);
+}
+
+# channelSay - Sends a message to the channel the message came from, IFF it came from a channel.
+sub channelSay {
+    my $self = shift;
+    my ($event, $data) = @_;
+    &::sendmsg($event->{'bot'}, $event->{'channel'}, $data) if $event->{'channel'};
+}
+
+# -- #mozilla was here --
+#       timeless: it's focal review time, and they are working out
+#              where to allocate the money.
+#       timeless: needless to say i have a vested interest in this.
+#        there's money in this?
+#    richb yes; leaf always
+#        how come nobody told me?
+#    because leaf doesn't need money
+#    for leaf it grows on trees
+#        *wince*
+
+# emote - Sends an emote to the channel
+sub emote {
+    my $self = shift;
+    my ($event, $data) = @_;
+    &::sendmsg($event->{'bot'}, $event->{'target'}, $data, 'me');
+}
+
+# directEmote - Sends an emote to the person who spoke
+sub directEmote {
+    my $self = shift;
+    my ($event, $data) = @_;
+    &::sendmsg($event->{'bot'}, $event->{'from'}, $data, 'me');
+}
+
+# sayOrEmote - calls say() or emote() depending on whether the string starts with /me or not.
+sub sayOrEmote {
+    my $self = shift;
+    my ($event, $data) = @_;
+    if ($data =~ /^\/me\s+/osi) {
+        $data =~ s/^\/me\s+//gosi;
+        $self->emote($event, $data);
+    } else {
+        $self->say($event, $data);
+    }
+}
+
+# directSayOrEmote - as sayOrEmote() but calls the direct versions instead
+sub directSayOrEmote {
+    my $self = shift;
+    my ($event, $data) = @_;
+    if ($data =~ /^\/me\s+/osi) {
+        $data =~ s/^\/me\s+//gosi;
+        $self->directEmote($event, $data);
+    } else {
+        $self->directSay($event, $data);
+    }
+}
+
+# isAdmin - Returns true if the person is an admin
+sub isAdmin {
+    my $self = shift;
+    my ($event) = @_;
+    return (($event->{'userName'}) and (($event->{'userFlags'} & 1) == 1));
+}
+
+# setAway - Set the bot's 'away' flag. A blank message will mark the bot as back.
+# Note: If you need this you are doing something wrong!!!
+sub setAway {
+    my $self = shift;
+    my ($event, $message) = @_;
+    $event->{'bot'}->away($message);
+}
+
+# setNick - Set the bot's nick.
+# Note: Best not to use this too much, especially not based on user input,
+# as it is not throttled. XXX
+sub setNick {
+    my $self = shift;
+    my ($event, $value) = @_;
+    $event->{'bot'}->nick($value);
+}
+
+sub mode {
+    my $self = shift;
+    my ($event, $channel, $mode, $arg) = @_;
+    $event->{'bot'}->mode($channel, $mode, $arg);
+}
+
+sub kick {
+    my $self = shift;
+    my ($event, $channel, $who, $reason) = @_;
+    $event->{'bot'}->kick($channel, $who, $reason);
+}
+
+sub invite {
+    my $self = shift;
+    my ($event, $who, $channel) = @_;
+    $event->{'bot'}->invite($who, $channel);
+}
+
+# pretty printer for turning lists of varying length strings into
+# lists of roughly equal length strings without losing any data
+sub prettyPrint {
+    my $self = shift;
+    my ($preferredLineLength, $prefix, $indent, $divider, @input) = @_;
+    # sort numerically descending by length
+    @input = sort {length($b) <=> length($a)} @input;
+    # if we have a prefix defined, it goes first (duh)
+    unshift(@input, $prefix) if defined($prefix);
+    my @output;
+    my $index;
+    while (@input) {
+        push(@output, $indent . shift(@input));
+        $index = 0;
+        while (($index <= $#input) and
+               ((length($output[$#output]) + length($input[$#input])) < $preferredLineLength)) {
+            # does this one fit?
+            if ((length($output[$#output]) + length($input[$index])) < $preferredLineLength) {
+                if (defined($prefix)) {
+                    # don't stick the divider between the prefix and the first item
+                    undef($prefix);
+                } else {
+                    $output[$#output] .= $divider;
+                }
+                $output[$#output] .= splice(@input, $index, 1);
+            } else {
+                $index++;
+            }
+        }
+    }
+    return @output;
+}
+
+# wordWrap routines which takes a list and wraps it. A less pretty version
+# of prettyPrinter, but it keeps the order.
+sub wordWrap {
+    my $self = shift;
+    my ($preferredLineLength, $prefix, $indent, $divider, @input) = @_;
+    unshift(@input, $prefix) if defined($prefix);
+    $indent = '' unless defined($indent);
+    my @output;
+    while (@input) {
+        push(@output, $indent . shift(@input));
+        while (($#input >= 0) and
+               ((length($output[$#output]) + length($input[0])) < $preferredLineLength)) {
+            $output[$#output] .= $divider . shift(@input);
+        }
+    }
+    return @output;
+}
+
+sub unescapeXML {
+    my $self = shift;
+    my ($string) = @_;
+    $string =~ s/'/'/gos;
+    $string =~ s/"/"/gos;
+    $string =~ s/<//gos;
+    $string =~ s/&/&/gos;
+    $string =~ s/&\#(\d+);/convertASCIICode($1)/ges;
+    return $string;
+}
+
+sub convertASCIICode {
+    my $code = shift;
+    return chr($code) if ($code > 31 and $code < 127);
+    return "&#$code;";
+}
+
+sub days {
+    my $self = shift;
+    my ($then) = @_;
+    return &::days($then);
+}
+
+# return the argument if it is a valid regular expression,
+# otherwise quotes the argument and returns that.
+sub sanitizeRegexp {
+    my $self = shift;
+    my ($regexp) = @_;
+    if (defined($regexp)) {
+        eval {
+            '' =~ /$regexp/;
+        };
+        $self->debug("regexp |$regexp| returned error |$@|, quoting...") if $@;
+        return $@ ? quotemeta($regexp) : $regexp;
+    } else {
+        $self->debug("blank regexp, returning wildcard regexp //...");
+        return '';
+    }
+}
+
+
+# MODULE INTERFACE (override these)
+
+# Initialise - Called when the module is loaded
+sub Initialise {
+    my $self = shift;
+}
+
+# Schedule - Called after bot is set up, to set up any scheduled tasks
+# use $self->schedule($event, $delay, $times, $data)
+# where $times is 1 for a single event, -1 for recurring events,
+# and a +ve number for an event that occurs that many times.
+sub Schedule {
+    my $self = shift;
+    my ($event) = @_;
+}
+
+# JoinedIRC - Called before joining any channels (but after module is setup)
+# this does not get called for dynamically loaded modules
+sub JoinedIRC {
+    my $self = shift;
+    my ($event) = @_;
+}
+
+sub JoinedChannel {
+    my $self = shift;
+    my ($event, $channel) = @_;
+    if ($self->{'autojoin'}) {
+        push(@{$self->{'channels'}}, $channel)
+          unless ((scalar(grep $_ eq $channel, @{$self->{'channels'}})) or
+                  (scalar(grep $_ eq $channel, @{$self->{'channelsBlocked'}})));
+        $self->saveConfig();
+    }
+}
+
+# Called by the Admin module's Kicked and SpottedPart handlers
+sub PartedChannel {
+    my $self = shift;
+    my ($event, $channel) = @_;
+    if ($self->{'autojoin'}) {
+        my %channels = map { $_ => 1 } @{$self->{'channels'}};
+        if ($channels{$channel}) {
+            delete($channels{$channel});
+            @{$self->{'channels'}} = keys %channels;
+            $self->saveConfig();
+        }
+    }
+}
+
+sub InChannel {
+    my $self = shift;
+    my ($event) = @_;
+    return scalar(grep $_ eq $event->{'channel'}, @{$self->{'channels'}});
+    # XXX could be optimised - cache the list into a hash.
+}
+
+sub IsBanned {
+    my $self = shift;
+    my ($event) = @_;
+    return 0 if scalar(grep { $_ = $self->sanitizeRegexp($_); $event->{'user'} =~ /^$_$/ } @{$self->{'allowusers'}});
+    return      scalar(grep { $_ = $self->sanitizeRegexp($_); $event->{'user'} =~ /^$_$/ } @{$self->{'denyusers'}});
+}
+
+# Baffled - Called for messages prefixed by the bot's nick which we don't understand
+sub Baffled {
+    my $self = shift;
+    my ($event, $message) = @_;
+    return 1;
+}
+
+# Told - Called for messages prefixed by the bot's nick
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    return 1;
+}
+
+# Noticed - Called for notice messages
+sub Noticed {
+    my $self = shift;
+    my ($event, $message) = @_;
+    return 1;
+}
+
+# Heard - Called for all messages
+sub Heard {
+    my $self = shift;
+    my ($event, $message) = @_;
+    return 1;
+}
+
+# Felt - Called for all emotes containing bot's nick
+sub Felt {
+    my $self = shift;
+    my ($event, $message) = @_;
+    return 1;
+}
+
+# -- #mozilla was here --
+# * bryner tries to imagine the need for NS_TWIPS_TO_MILES
+# bryner: yeah, that isn't even a metric unit. should
+#              be NS_TWIPS_TO_KILOMETERS
+#      there's that too
+# oh
+# really?
+#      yep
+# o_O
+#      for when we use mozilla for surveying and such
+#   lol
+
+# BTW. They aren't kidding. See:
+# http://lxr.mozilla.org/seamonkey/search?string=NS_TWIPS_TO_KILOMETERS
+
+# Saw - Called for all emotes
+sub Saw {
+    my $self = shift;
+    my ($event, $message) = @_;
+    return 1;
+}
+
+# Invited - Called when bot is invited into another channel
+sub Invited {
+    my $self = shift;
+    my ($event, $channel) = @_;
+    return 1;
+}
+
+# Kicked - Called when bot is kicked out of a channel
+sub Kicked {
+    my $self = shift;
+    my ($event, $channel) = @_;
+    return 1;
+}
+
+# ModeChange - Called when channel or bot has a mode flag changed
+sub ModeChange {
+    my $self = shift;
+    my ($event, $what, $change, $who) = @_;
+    return 1;
+}
+
+# GotOpped - Called when bot is opped
+sub GotOpped {
+    my $self = shift;
+    my ($event, $channel, $who) = @_;
+    return 1;
+}
+
+# GotDeopped - Called when bot is deopped
+sub GotDeopped {
+    my $self = shift;
+    my ($event, $channel, $who) = @_;
+    return 1;
+}
+
+# SpottedNickChange - Called when someone changes their nick
+# Remember that you cannot use directSay here, since $event
+# has the details of the old nick. And 'say' is useless
+# since the channel is the old userhost string... XXX
+sub SpottedNickChange {
+    my $self = shift;
+    my ($event, $from, $to) = @_;
+    return 1;
+}
+
+# Authed - Called when someone authenticates with us.
+# Remember that you cannot use say here, since this
+# cannot actually be done in a channel...
+sub Authed {
+    my $self = shift;
+    my ($event, $who) = @_;
+    return 1;
+}
+
+# SpottedTopicChange - Called when someone thinks someone else said something funny
+sub SpottedTopicChange {
+    my $self = shift;
+    my ($event, $channel, $new) = @_;
+    return 1;
+}
+
+# SpottedJoin - Called when someone joins a channel
+sub SpottedJoin {
+    my $self = shift;
+    my ($event, $channel, $who) = @_;
+    return 1;
+}
+
+# SpottedPart - Called when someone leaves a channel
+sub SpottedPart {
+    my $self = shift;
+    my ($event, $channel, $who) = @_;
+    return 1;
+}
+
+# SpottedKick - Called when someone leaves a channel forcibly
+sub SpottedKick {
+    my $self = shift;
+    my ($event, $channel, $who) = @_;
+    return 1;
+}
+
+# SpottedQuit - Called when someone leaves a server
+# can't use say or directSay: no channel involved, and
+# user has quit (obviously). XXX
+sub SpottedQuit {
+    my $self = shift;
+    my ($event, $who, $why) = @_;
+    return 1;
+}
+
+# CTCPPing - Called when we receive a CTCP Ping.
+sub CTCPPing {
+    my $self = shift;
+    my ($event, $who, $what) = @_;
+    return 1;
+}
+
+# CTCPVersion - Called when we receive a CTCP Version.
+sub CTCPVersion {
+    my $self = shift;
+    my ($event, $who, $what) = @_;
+    return 1;
+}
+
+# CTCPSource - Called when we receive a CTCP Source.
+sub CTCPSource {
+    my $self = shift;
+    my ($event, $who, $what) = @_;
+    return 1;
+}
+
+# SpottedOpping - Called when someone is opped
+sub SpottedOpping {
+    my $self = shift;
+    my ($event, $channel, $who) = @_;
+    return 1;
+}
+
+# SpottedDeopping - Called when someone is... deopped, maybe?
+sub SpottedDeopping {
+    my $self = shift;
+    my ($event, $channel, $who) = @_;
+    return 1;
+}
+
+# Scheduled - Called when a scheduled timer triggers
+sub Scheduled {
+    my $self = shift;
+    my ($event, @data) = @_;
+    if (ref($data[0]) eq 'CODE') {
+        &{$data[0]}($event, @data);
+    } else {
+        $self->debug('Unhandled scheduled event... :-/');
+    }
+}
+
+# ChildCompleted - Called when a child process has quit
+sub ChildCompleted {
+    my $self = shift;
+    my ($event, $type, $output, @data) = @_;
+    if ($type eq 'URI') {
+        my $uri = shift(@data);
+        $self->GotURI($event, $uri, $output, @data);
+    }
+}
+
+# DataAvailable - Called when a handle registered with
+# registerDataHandle has made data available
+sub DataAvailable {
+    my $self = shift;
+    my ($event, $handle, $data, $close) = @_;
+    # do nothing
+}
+
+# GotURI - Called when a requested URI has been downloaded
+sub GotURI {
+    my $self = shift;
+    my ($event, $uri, $contents, @data) = @_;
+}
+
+# Help - Called to fully explain the module (return hash of command/description pairs)
+# the string given for the '' key should be a module description
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    return {};
+}
+
+# RegisterConfig - Called when initialised, should call registerVariables
+sub RegisterConfig {
+    my $self = shift;
+    $self->registerVariables(
+      # [ name, save?, settable?, value ]
+        ['channels',        1, 1, []],
+        ['channelsBlocked', 1, 1, []], # the channels in which this module will not autojoin regardless
+        ['autojoin',        1, 1, 1],
+        ['allowusers',      1, 1, []],
+        ['denyusers',       1, 1, []],
+    );
+}
+
+# Set - called to set a variable to a particular value.
+sub Set {
+    my $self = shift;
+    my ($event, $variable, $value) = @_;
+    if ($self->{'_variables'}->{$variable}) {
+        if ((not defined($self->{$variable})) or (not ref($self->{$variable}))) {
+            $self->{$variable} = $value;
+        } elsif (ref($self->{$variable}) eq 'SCALAR') {
+            ${$self->{$variable}} = $value;
+        } elsif (ref($self->{$variable}) eq 'ARRAY') {
+            if ($value =~ /^([-+])(.*)$/so) {
+                if ($1 eq '+') {
+                    push(@{$self->{$variable}}, $2);
+                } else {
+                    # We don't want to change the reference!!!
+                    # Other variables might be pointing to there,
+                    # it is *those* vars that affect the app.
+                    my @oldvalue = @{$self->{$variable}};
+                    @{$self->{$variable}} = ();
+                    foreach (@oldvalue) {
+                        push(@{$self->{$variable}}, $_) unless ($2 eq $_);
+                    }
+                    # XXX no feedback if nothing is done
+                }
+            } else {
+                return 3; # not the right format dude!
+            }
+        } elsif (ref($self->{$variable}) eq 'HASH') {
+            if ($value =~ /^\+(.)(.*)\1(.*)$/so) {
+                $self->{$variable}->{$2} = $3;
+                return -2 if $1 =~ /[a-zA-Z]/so;
+            } elsif ($value =~ /^\-(.*)$/so) {
+                # XXX no feedback if nothing is done
+                delete($self->{$variable}->{$1});
+            } else {
+                return 4; # not the right format dude!
+            }
+        } else {
+            return 1; # please to not be trying to set coderefs or arrayrefs or hashrefs or ...
+        }
+    } else {
+        return 2; # please to not be trying to set variables I not understand!
+    }
+    $self->saveConfig();
+    return 0;
+}
+
+# Get - called to get a particular variable
+sub Get {
+    my $self = shift;
+    my ($event, $variable) = @_;
+    return $self->{$variable};
+}
+
+# Log - Called for every event
+sub Log {
+    my $self = shift;
+    my ($event) = @_;
+}
+
+# Log - Called for every event
+sub Unload {
+    my $self = shift;
+}
+
+
+################################
+# Admin Module                 #
+################################
+
+package BotModules::Admin;
+use vars qw(@ISA);
+@ISA = qw(BotModules);
+1;
+
+# Initialise - Called when the module is loaded
+sub Initialise {
+    my $self = shift;
+    $self->{'_fileModifiedTimes'} = {};
+    $self->{'_static'} = 1;
+}
+
+# RegisterConfig - Called when initialised, should call registerVariables
+sub RegisterConfig {
+    my $self = shift;
+    $self->SUPER::RegisterConfig(@_);
+    $self->registerVariables(
+      # [ name, save?, settable?, value ]
+        ['allowInviting', 1, 1, 1], # by default, anyone can invite a bot into their channel
+        ['allowChannelAdmin', 1, 1, 0], # by default, one cannot admin from a channel
+        ['sourceCodeCheckDelay', 1, 1, 20], # by default, wait 20 seconds between source code checks
+        ['files', 1, 1, [$0, 'lib/Mails.pm', 'lib/Configuration.pm', 'lib/IO/SecurePipe.pm']], # files to check for source code changes
+        ['channels', 0, 0, undef], # remove the 'channels' internal variable...
+        ['autojoin', 0, 0, 0], # remove the 'autojoin' internal variable...
+        ['errorMessagesMaxLines', 1, 1, 5], # by default, only have 5 lines in error messages, trim middle if more
+    );
+    # now add in all the global variables...
+    foreach (keys %configStructure) {
+        $self->registerVariables([$configStructure{$_}[0], 0, 1, $configStructure{$_}[1]]) if (ref($configStructure{$_}[1]) =~ /^(?:SCALAR|ARRAY|HASH)$/go);
+    }
+}
+
+# saveConfig - make sure we also save the main config variables...
+sub saveConfig {
+    my $self = shift;
+    $self->SUPER::saveConfig(@_);
+    &Configuration::Save($cfgfile, &::configStructure());
+}
+
+# Set - called to set a variable to a particular value.
+sub Set {
+    my $self = shift;
+    my ($event, $variable, $value) = @_;
+    # First let's special case some magic variables...
+    if ($variable eq 'currentnick') {
+        $self->setNick($event, $value);
+        $self->say($event, "Attempted to change nick to '$value'.");
+        return -1;
+    } elsif ($variable eq 'nicks') {
+        if ($value =~ /^([-+])(.*)$/so) {
+            if ($1 eq '+') {
+                # check it isn't there already and is not ''
+                my $value = $2;
+                if ($value eq '') {
+                    $self->say($event, "The empty string is not a valid nick.");
+                    return -1;
+                }
+                my $thenick = 0;
+                $thenick++ while (($thenick < @nicks) and ($value ne $nicks[$thenick]));
+                if ($thenick < @nicks) {
+                    $self->say($event, "That nick (value) is already on the list of possible nicks.");
+                    return -1;
+                }
+            } else {
+                if ($2 eq $nicks[$nick]) {
+                    $self->say($event, "You cannot remove the current nick ('$nicks[$nick]') from the list of allowed nicks... Change the 'currentnick' variable first!");
+                    return -1;
+                }
+            }
+        }
+    } elsif ($variable eq 'umode') {
+        $self->mode($event, $nicks[$nick], $value, '');
+        $self->say($event, "Attempted to change current umode to '$value'.");
+    }
+    return $self->SUPER::Set($event, $variable, $value);
+}
+
+# Get - called to get a particular variable.
+sub Get {
+    my $self = shift;
+    my ($event, $variable) = @_;
+    # First let's special case some magic variables...
+    if ($variable eq 'currentnick') {
+        return $event->{'nick'};
+    } elsif ($variable eq 'users') {
+        my @users = sort keys %users;
+        return \@users;
+    } else {
+        # else, check for known global variables...
+        my $configStructure = &::configStructure();
+        if (defined($configStructure->{$variable})) {
+            return $configStructure->{$variable};
+        } else {
+            return $self->SUPER::Get($event, $variable);
+        }
+    }
+}
+
+# Schedule - called when bot connects to a server, to install any schedulers
+# use $self->schedule($event, $delay, $times, $data)
+# where $times is 1 for a single event, -1 for recurring events,
+# and a +ve number for an event that occurs that many times.
+sub Schedule {
+    my $self = shift;
+    my ($event) = @_;
+    $self->schedule($event, \$self->{'sourceCodeCheckDelay'}, -1, {'action'=>'source'});
+    $self->SUPER::Schedule($event);
+}
+
+sub Help {
+    my $self = shift;
+    my ($event) = @_;
+    my $result = {
+        'auth' => 'Authenticate yourself. Append the word \'quiet\' after your password if you don\'t want confirmation. Syntax: auth   [quiet]',
+        'password' => 'Change your password: password   ',
+        'newuser' => 'Registers a new username and password (with no privileges). Syntax: newuser   ',
+    };
+    if ($self->isAdmin($event)) {
+        $result->{''} = 'The administration module is used to perform tasks that fundamentally affect the bot.';
+        $result->{'shutdown'} = 'Shuts the bot down completely.';
+        $result->{'shutup'} = 'Clears the output queue (you actually have to say \'shutup please\' or nothing will happen).';
+        $result->{'restart'} = 'Shuts the bot down completely then restarts it, so that any source changes take effect.';
+        $result->{'cycle'} = 'Makes the bot disconnect from the server then try to reconnect.';
+        $result->{'changepassword'} = 'Change a user\'s password: changepassword   ',
+        $result->{'vars'} = 'Manage variables: vars [ [ [\'\']]], say \'vars\' for more details.';
+        $result->{'join'} = 'Makes the bot attempt to join a channel. The same effect can be achieved using /invite. Syntax: join ';
+        $result->{'part'} = 'Makes the bot leave a channel. The same effect can be achieved using /kick. Syntax: part ';
+        $result->{'load'} = 'Loads a module from disk, if it is not already loaded: load ';
+        $result->{'unload'} = 'Unloads a module from memory: load ';
+        $result->{'reload'} = 'Unloads and then loads a module: reload ';
+        $result->{'bless'} = 'Sets the \'admin\' flag on a registered user. Syntax: bless ';
+        $result->{'unbless'} = 'Resets the \'admin\' flag on a registered user. Syntax: unbless ';
+        $result->{'deleteuser'} = 'Deletes a user from the bot. Syntax: deleteuser ',
+    }
+    return $result;
+}
+
+# Told - Called for messages prefixed by the bot's nick
+sub Told {
+    my $self = shift;
+    my ($event, $message) = @_;
+    return $self->SUPER::Told(@_) unless $self->{allowChannelAdmin} or $event->{channel} eq '';
+    if ($message =~ /^\s*auth\s+($variablepattern)\s+($variablepattern)(\s+quiet)?\s*$/osi) {
+        if (not $event->{'channel'}) {
+            if (defined($users{$1})) {
+                if (&::checkPassword($2, $users{$1})) {
+                    $authenticatedUsers{$event->{'user'}} = $1;
+                    if (not defined($3)) {
+                        $self->directSay($event, "Hi $1!");
+                    }
+                    &::do($event->{'bot'}, $event->{'_event'}, 'Authed'); # hack hack hack
+                } else {
+                    $self->directSay($event, "No...");
+                }
+            } else {
+                $self->directSay($event, "You have not been added as a user yet. Try the \'newuser\' command (see \'help newuser\' for details).");
+            }
+        }
+    } elsif ($message =~ /^\s*password\s+($variablepattern)\s+($variablepattern)\s+($variablepattern)\s*$/osi) {
+        if (not $event->{'channel'}) {
+            if ($authenticatedUsers{$event->{'user'}}) {
+                if ($2 ne $3) {
+                    $self->say($event, 'New passwords did not match. Try again.');
+                } elsif (&::checkPassword($1, $users{$authenticatedUsers{$event->{'user'}}})) {
+                    $users{$authenticatedUsers{$event->{'user'}}} = &::newPassword($2);
+                    delete($authenticatedUsers{$event->{'user'}});
+                    $self->say($event, 'Password changed. Please reauthenticate.');
+                    $self->saveConfig();
+                } else {
+                    delete($authenticatedUsers{$event->{'user'}});
+                    $self->say($event, 'That is not your current password. Please reauthenticate.');
+                }
+            }
+        }
+    } elsif ($message =~ /^\s*new\s*user\s+($variablepattern)\s+($variablepattern)\s+($variablepattern)\s*$/osi) {
+        if (not $event->{'channel'}) {
+            if (defined($users{$1})) {
+                $self->say($event, 'That user already exists in my list, you can\'t add them again!');
+            } elsif ( $2 ne $3 ) {
+                $self->say($event, 'New passwords did not match. Try again.');
+            } elsif ($1) {
+                $users{$1} = &::newPassword($2);
+                $userFlags{$1} = 0;
+                $self->directSay($event, "New user '$1' added with password '$2' and no rights.");
+                $self->saveConfig();
+            } else {
+                $self->say($event, 'That is not a valid user name.');
+            }
+        }
+    } elsif ($self->isAdmin($event)) {
+        if ($message =~ /^\s*(?:shutdown,?\s+please)\s*[?!.]*\s*$/osi) {
+            $self->say($event, 'But of course. Have a nice day!');
+            my $reason = 'I was told to shutdown by '.$event->{'from'}.'. :-( ';
+            # XXX should do something like &::do($event->{'bot'}, $event->{'_event'}, 'SpottedQuit'); # hack hack hack
+            #     ...but it should have the right channel/nick/reason info
+            # XXX we don't unload the modules here?
+            $event->{'bot'}->quit($reason);
+            exit(0); # prevents any other events happening...
+        } elsif ($message =~ /^\s*shutdown/osi) {
+            $self->say($event, 'If you really want me to shutdown, use the magic word.');
+            $self->schedule($event, 7, 1, 'i.e., please.');
+        } elsif ($message =~ /^\s*(?:restart,?\s+please)\s*[?!.]*\s*$/osi) {
+            $self->Restart($event, "I was told to restart by $event->{'from'} -- brb");
+        } elsif ($message =~ /^\s*restart/osi) {
+            $self->say($event, 'If you really want me to restart, use the magic word.');
+            $self->schedule($event, 7, 1, 'i.e., please.');
+        } elsif ($message =~ /^\s*delete\s*user\s+($variablepattern)\s*$/osi) {
+            if (not defined($users{$1})) {
+                $self->say($event, "I don't know of a user called '$1', sorry.");
+            } else {
+                # check user is not last admin
+                my $doomedUser = $1;
+                my $count;
+                if (($userFlags{$doomedUser} & 1) == 1) {
+                    # deleting an admin. Count how many are left.
+                    $count = 0;
+                    foreach my $user (keys %users) {
+                        ++$count if ($user ne $doomedUser and
+                                     ($userFlags{$user} & 1) == 1);
+                    }
+                } else {
+                    # not deleting an admin. We know there is an admin in there, it's
+                    # the user doing the deleting. So we're safe.
+                    $count = 1;
+                }
+                if ($count) {
+                    $self->deleteUser($doomedUser);
+                    $self->say($event, "User '$doomedUser' deleted.");
+                } else {
+                    $self->say($event, "Can't delete user '$doomedUser', that would leave you with no admins!");
+                }
+            }
+        } elsif ($message =~ /^\s*change\s*password\s+($variablepattern)\s+($variablepattern)\s+($variablepattern)\s*$/osi) {
+            if (not defined($users{$1})) {
+                $self->say($event, "I don't know of a user called '$1', sorry.");
+            } elsif ($2 ne $3) {
+                $self->say($event, 'New passwords did not match. Try again.');
+            } else {
+                $users{$1} = &::newPassword($2);
+                my $count = 0;
+                foreach my $user (keys %authenticatedUsers) {
+                    if ($authenticatedUsers{$user} eq $1) {
+                        delete($authenticatedUsers{$user});
+                        ++$count;
+                    }
+                }
+                if ($count) {
+                    $self->say($event, "Password changed for user '$1'. They must reauthenticate.");
+                } else {
+                    $self->say($event, "Password changed for user '$1'.");
+                }
+                $self->saveConfig();
+            }
+        } elsif ($message =~ /^\s*(?:shut\s*up,?\s+please)\s*[?!.]*\s*$/osi) {
+            my $lost = @msgqueue;
+            @msgqueue = ();
+            if ($lost) {
+                $self->say($event, "Ok, threw away $lost messages.");
+            } else {
+                $self->say($event, 'But I wasn\'t saying anything!');
+            }
+        } elsif ($message =~ /^\s*cycle(?:\s+please)?\s*[?!.]*\s*$/osi) {
+            my $reason = 'I was told to cycle by '.$event->{'from'}.'. BRB!';
+            # XXX should do something like &::do($event->{'bot'}, $event->{'_event'}, 'SpottedQuit'); # hack hack hack
+            #     ...but it should have the right channel/nick/reason info
+            # XXX we don't unload the modules here?
+            $event->{'bot'}->quit($reason);
+            &Configuration::Get($cfgfile, &::configStructure());
+        } elsif ($message =~ /^\s*join\s+([&#+][^\s]+)(?:\s+please)?\s*[?!.]*\s*$/osi) {
+            $self->Invited($event, $1);
+        } elsif ($message =~ /^\s*part\s+([&#+][^\s]+)(?:\s+please)?\s*[?!.]*\s*$/osi) {
+            $event->{'bot'}->part("$1 :I was told to leave by $event->{'from'}. :-(");
+        } elsif ($message =~ /^\s*bless\s+('?)($variablepattern)\1\s*$/osi) {
+            if (defined($users{$2})) {
+                $userFlags{$2} = $userFlags{$2} || 1;
+                $self->saveConfig();
+                $self->say($event, "Ok, $2 is now an admin.");
+            } else {
+                $self->say($event, 'I don\'t know that user. Try the \'newuser\' command (see \'help newuser\' for details).');
+            }
+        } elsif ($message =~ /^\s*unbless\s+('?)($variablepattern)\1\s*$/osi) {
+            if (defined($users{$2})) {
+                $userFlags{$2} = $userFlags{$2} &~ 1;
+                $self->saveConfig();
+                $self->say($event, "Ok, $2 is now a mundane luser.");
+            } else {
+                $self->say($event, 'I don\'t know that user. Check your spelling!');
+            }
+        } elsif ($message =~ /^\s*load\s+('?)($variablepattern)\1\s*$/osi) {
+            $self->LoadModule($event, $2, 1);
+        } elsif ($message =~ /^\s*reload\s+('?)($variablepattern)\1\s*$/osi) {
+            $self->ReloadModule($event, $2, 1);
+        } elsif ($message =~ /^\s*unload\s+('?)($variablepattern)\1\s*$/osi) {
+            $self->UnloadModule($event, $2, 1);
+        } elsif ($message =~ /^\s*vars(?:\s+($variablepattern)(?:\s+($variablepattern)(?:\s+'(.*)')?)?|(.*))?\s*$/osi) {
+            $self->Vars($event, $1, $2, $3, $4);
+        } else {
+            return $self->SUPER::Told(@_);
+        }
+    } else {
+        return $self->SUPER::Told(@_);
+    }
+    return 0; # if made it here then we did it!
+}
+
+sub Scheduled {
+    my $self = shift;
+    my ($event, $type) = @_;
+    if ((ref($type) eq 'HASH') and ($type->{'action'} eq 'source')) {
+        $self->CheckSource($event);
+    } elsif (ref($type)) {
+        $self->SUPER::Scheduled(@_);
+    } else {
+        $self->directSay($event, $type);
+    }
+}
+
+# remove any (other) temporary administrators when an admin authenticates
+sub Authed {
+    my $self = shift;
+    my ($event, $who) = @_;
+    if ($self->isAdmin($event)) {
+        foreach (keys %userFlags) {
+            if ((($userFlags{$_} & 2) == 2) and ($authenticatedUsers{$event->{'user'}} ne $_)) {
+                $self->deleteUser($_);
+                $self->directSay($event, "Temporary administrator '$_' removed from user list.");
+            }
+        }
+    }
+    return $self->SUPER::Authed(@_); # this should not stop anything else happening
+}
+
+# SpottedQuit - Called when someone leaves a server
+sub SpottedQuit {
+    my $self = shift;
+    my ($event, $who, $why) = @_;
+    delete($authenticatedUsers{$event->{'user'}});
+    # XXX this doesn't deal with a user who has authenticated twice.
+    return $self->SUPER::SpottedQuit(@_);
+}
+
+sub CheckSource {
+    my $self = shift;
+    my ($event) = @_;
+    foreach my $file (@{$self->{'files'}}) {
+        my $lastModifiedTime = $self->{'_fileModifiedTimes'}->{$file};
+        my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks)
+            = stat($file);
+        $self->{'_fileModifiedTimes'}->{$file} = $mtime;
+        if (defined($lastModifiedTime) and ($mtime > $lastModifiedTime)) {
+            $self->debug("Noticed that source code of $file had changed");
+            # compile new bot using perl -cwT XXX
+            if (1) { # XXX replace 1 with "did compile succeed" test
+                $self->Restart($event, 'someone seems to have changed my source code. brb, unless I get a compile error!');
+            } else {
+                # tellAdmin that it did not compile XXX
+                # debug that it did not compile
+            }
+        }
+    }
+    my @updatedModules;
+    foreach my $module (@modules) {
+        if ($module->{'_filename'}) {
+            my $lastModifiedTime = $module->{'_fileModificationTime'};
+            my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks)
+                = stat($module->{'_filename'});
+            $module->{'_fileModificationTime'} = $mtime;
+            if (defined($lastModifiedTime) and ($mtime > $lastModifiedTime)) {
+                push(@updatedModules, $module->{'_name'});
+            }
+        }
+    }
+    foreach my $module (@updatedModules) {
+        $self->ReloadModule($event, $module, 0);
+    }
+}
+
+sub Restart {
+    my $self = shift;
+    my ($event, $reason) = @_;
+    # XXX should do something like &::do($event->{'bot'}, $event->{'_event'}, 'SpottedQuit'); # hack hack hack
+    #     ...but it should have the right channel/nick/reason info
+    #     ...and it is broken if called from CheckSource, which is a
+    #     scheduled event handler, since $event is then a very basic
+    #     incomplete hash.
+    # XXX we don't unload modules here?
+    $event->{'bot'}->quit($reason);
+    # Note that `exec' will not call our `END' blocks, nor will it
+    # call any `DESTROY' methods in our objects. So we fork a child to
+    # do that first.
+    my $parent = $$;
+    my $child = fork();
+    if (defined($child)) {
+        if ($child) {
+            # we are the parent process who is
+            # about to exec($0), so wait for
+            # child to shutdown.
+            $self->debug("spawned $child to handle shutdown...");
+            waitpid($child, 0);
+        } else {
+            # we are the child process who is
+            # in charge of shutting down cleanly.
+            $self->debug("initiating shutdown for parent process $parent...");
+            exit(0);
+        }
+    } else {
+        $self->debug("failed to fork: $!");
+    }
+    $self->debug("About to defer to a new $0 process...");
+    # we have done our best to shutdown, so go for it!
+    eval {
+        $0 =~ m/^(.*)$/os; # untaint $0 so that we can call it below (as $1)
+        if ($CHROOT) {
+            exec { $1 } ($1, '--assume-chrooted', $cfgfile);
+        } else {
+            exec { $1 } ($1, $cfgfile);
+        }
+        # I am told (by some nice people in #perl on Efnet) that our
+        # memory is all cleared up for us. So don't worry that even
+        # though we don't call DESTROY in _this_ instance, we leave
+        # memory behind.
+    };
+    $self->debug("That failed!!! Bailing out to prevent all hell from breaking loose! $@ :-|");
+    exit(1); # we never get here unless exec fails
+}
+
+# handles the 'vars' command
+sub Vars {
+    my $self = shift;
+    my ($event, $modulename, $variable, $value, $nonsense) = @_;
+    if (defined($modulename)) {
+        my $module = $self->getModule($modulename);
+        if (defined($module)) {
+            if (defined($variable)) {
+                if (defined($value)) {
+                    my $result = $module->Set($event, $variable, $value);
+                    if ((not defined($result)) or ($result == 0)) {
+                        $self->say($event, "Variable '$variable' in module '$modulename' has changed.");
+                    } elsif ($result == 1) {
+                        $self->say($event, "Variable '$variable' is of type ".ref($module->{$variable}).' and I do not know how to set that kind of variable!');
+                    } elsif ($result == 2) { # we don't know that variable!
+                        if ($module->{$variable}) { # well we do, but only to read
+                            $self->say($event, "Variable '$variable' in module '$modulename' is read-only, sorry.");
+                        } else { # not known
+                            $self->say($event, "Module '$modulename' does not have a variable '$variable' as far as I can tell.");
+                        }
+                    } elsif ($result == 3) {
+                        $self->say($event, "Variable '$variable' is a list. To add to a list, please use the '+' symbol before the value (vars   '+'). To remove from a list, use the '-' symbol (vars   '-').");
+                    } elsif ($result == 4) {
+                        $self->say($event, "Variable '$variable' is a hash. To add to a hash, please use the '+' symbol before the '|key|value' pair (vars   '+||').  The separator symbol ('|' in this example) could be anything. To remove from a list, use the '-' symbol (vars   '-').");
+                    } elsif ($result == -1) {
+                        # already reported success
+                    } elsif ($result == -2) {
+                        $self->say($event, "Variable '$variable' in module '$modulename' has changed, but may not be what you expect since it appears to me that you used a letter to delimit the sections. I hope that is what you meant to do...");
+                    } elsif ($result > 0) { # negative = success
+                        $self->say($event, "Variable '$variable' in module '$modulename' could not be set for some reason unknown to me.");
+                    }
+                } else { # else give variable's current value
+                    $value = $module->Get($event, $variable);
+                    if (defined($value)) {
+                        my $type = ref($value);
+                        if ($type eq 'SCALAR') {
+                            $self->say($event, "Variable '$variable' in module '$modulename' is set to: '$$value'");
+                        } elsif ($type eq 'ARRAY') {
+                            # XXX need a 'maximum number of items' feature to prevent flooding ourselves to pieces (or is shutup please enough?)
+                            if (@$value) {
+                                local $" = '\', \'';
+                                $self->say($event, "Variable '$variable' in module '$modulename' is a list with the following values: '@$value'");
+                            } else {
+                                $self->say($event, "Variable '$variable' in module '$modulename' is an empty list.");
+                            }
+                        } elsif ($type eq 'HASH') {
+                            # XXX need a 'maximum number of items' feature to prevent flooding ourselves to pieces (or is shutup please enough?)
+                            $self->say($event, "Variable '$variable' in module '$modulename' is a hash with the following values:");
+                            foreach (sort keys %$value) {
+                                $self->say($event, "  '$_' => '".($value->{$_}).'\' ');
+                            }
+                            $self->say($event, "End of dump of variable '$variable'.");
+                        } else {
+                            $self->say($event, "Variable '$variable' in module '$modulename' is set to: '$value'");
+                        }
+                    } else { # we don't know that variable
+                        if ($module->{'_variables'}->{$variable}) { # well we do, but only to write
+                            $self->say($event, "Variable '$variable' in module '$modulename' is write-only, sorry.");
+                        } else { # not known
+                            $self->say($event, "Module '$modulename' does not have a variable '$variable' as far as I can tell.");
+                        }
+                    }
+                }
+            } else { # else list variables
+                my @variables;
+                # then enumerate its variables
+                foreach my $variable (sort keys %{$module->{'_variables'}}) {
+                    push(@variables, $variable) if $module->{'_variables'}->{$variable};
+                }
+                # then list 'em
+                if (@variables) {
+                    local $" = '\', \'';
+                    $self->say($event, "Module '$modulename' has the following published variables: '@variables'");
+                } else {
+                    $self->say($event, "Module '$modulename' has no settable variables.");
+                }
+            }
+        } else { # complain no module
+            $self->say($event, "I didn't recognise that module name ('$modulename'). Try just 'vars' on its own for help.");
+        }
+    } elsif ($nonsense) {
+        $self->say($event, 'I didn\'t quite understand that. Try just \'vars\' on its own for help.');
+        $self->say($event, 'If you are trying to set a variable, don\'t forget the quotes around the value!');
+    } else { # else give help
+        $self->say($event, 'The \'vars\' command gives you an interface to the module variables in the bot.');
+        $self->say($event, 'To list the variables in a module: vars ');
+        $self->say($event, 'To get the value of a variable: vars  ');
+        $self->say($event, 'To set the value of a variable: vars   \'\'');
+        $self->say($event, 'Note the quotes around the value. They are required. If the value contains quotes itself, that is fine.');
+    }
+}
+
+# This is also called when we are messaged a 'join' command
+sub Invited {
+    my $self = shift;
+    my ($event, $channelName) = @_;
+    # $channelName is the name as requested and as should be /joined.
+    # This is important so that case is kept in the list of channels
+    # on the server should the bot join first.
+    my $channel = lc($channelName);
+    if (grep $_ eq $channel, @channels) {
+        $self->directSay($event, "I thought I was already *in* channel $channel! Oh well.");
+    }
+    if ($self->isAdmin($event) || $self->{'allowInviting'}) {
+        $self->debug("Joining $channel, since I was invited.");
+        if (defined($channelKeys{$channel})) {
+            $event->{'bot'}->join($channel, $channelKeys{$channel});
+        } else {
+            $event->{'bot'}->join($channel);
+        }
+    } else {
+        $self->debug($event->{'from'}." asked me to join $channel, but I refused.");
+        $self->directSay($event, "Please contact one of my administrators if you want me to join $channel.");
+        $self->tellAdmin($event, "Excuse me, but ".$event->{'from'}." asked me to join $channel. I thought you should know.");
+    }
+    return $self->SUPER::Invited($event, $channel);
+}
+
+sub Kicked {
+    my $self = shift;
+    my ($event, $channel) = @_;
+    $self->debug("kicked from $channel by ".$event->{'from'});
+    $self->debug('about to autopart modules...');
+    foreach (@modules) {
+        $_->PartedChannel($event, $channel);
+    }
+    return $self->SUPER::Kicked($event, $channel);
+}
+
+sub SpottedPart {
+    my $self = shift;
+    my ($event, $channel, $who) = @_;
+    if (lc $who eq lc $event->{'nick'}) {
+        $self->debug("parted $channel");
+        $self->debug('about to autopart modules...');
+        foreach (@modules) {
+            $_->PartedChannel($event, $channel);
+        }
+    }
+    return $self->SUPER::SpottedPart($event, $channel, $who);
+}
+
+sub PartedChannel {
+    my $self = shift;
+    my ($event, $channel) = @_;
+    $channel = lc($channel);
+    my %channels = map { $_ => 1 } @channels;
+    delete($channels{$channel});
+    @channels = keys %channels;
+    &Configuration::Save($cfgfile, &::configStructure(\@channels));
+    return $self->SUPER::PartedChannel($event, $channel);
+}
+
+sub LoadModule {
+    my $self = shift;
+    my ($event, $name, $requested) = @_;
+    my $newmodule = &::LoadModule($name);
+    if (ref($newmodule)) {
+        # configure module
+        $newmodule->{'channels'} = [@channels];
+        &Configuration::Get($cfgfile, $newmodule->configStructure());
+        eval {
+            $newmodule->Schedule($event);
+        };
+        if ($@) {
+            $self->debug("Warning: An error occured while loading the module:\n$@");
+            if ($requested) {
+                $self->say($event, "Warning: an error occured while loading module '$name'. Ignored.");
+            }
+        }
+        $newmodule->saveConfig();
+        $self->debug("Successfully loaded module '$name'.");
+        if ($requested) {
+            $self->say($event, "Loaded module '$name'.");
+        }
+    } else {
+        if ($requested) { # it failed, $newmodule contains error message
+            my @errors = split(/[\n\r]/os, $newmodule);
+            if (scalar(@errors) > $self->{'errorMessagesMaxLines'}) {
+                # remove lines from the middle if the log is too long
+                @errors = (@errors[0..int($self->{'errorMessagesMaxLines'} / 2)-1], '...', @errors[-(int($self->{'errorMessagesMaxLines'} / 2))..-1]);
+            }
+            local $" = "\n";
+            $self->say($event, "@errors");
+        }
+        $self->debug($newmodule);
+    }
+}
+
+sub UnloadModule {
+    my $self = shift;
+    my ($event, $name, $requested) = @_;
+    my $result = &::UnloadModule($name);
+    if (defined($result)) { # failed
+        if ($requested) {
+            $self->say($event, $result);
+        } else {
+            $self->debug($result);
+        }
+    } else {
+        if ($requested) {
+            $self->say($event, "Unloaded module '$name'.");
+        } else {
+            $self->debug("Successfully unloaded module '$name'.");
+        }
+    }
+}
+
+sub ReloadModule {
+    my $self = shift;
+    # XXX there used to be a memory leak around this code. It seems to be fixed
+    # now. However if your bot process suddenly balloons to 90M+, here would be a good
+    # place to start looking. Of course if that happens and you never reloaded modules
+    # then it is also a good time to remove this comment... ;-)
+    $self->UnloadModule(@_);
+    $self->LoadModule(@_);
+}
+
+sub deleteUser {
+    my $self = shift;
+    my ($who) = @_;
+    delete($userFlags{$who});
+    delete($users{$who});
+    # if they authenticated, remove the entry to prevent dangling links
+    foreach my $user (keys %authenticatedUsers) {
+        if ($authenticatedUsers{$user} eq $who) {
+            delete($authenticatedUsers{$user});
+        }
+    }
+    $self->saveConfig();
+}
+
+
+################################
+# Startup (aka main)           #
+################################
+
+package main;
+
+# -- #mozilla was here --
+#        is the bug with zilla hanging on startup on every
+#              platform fixed in today's nightlies?
+#        no
+#       heh
+#        NEVER
+#        we're shipping with it.
+#     helps hide our other bugs
+
+# Do this at the very end, so we can intersperse "my" initializations outside
+# of routines above and be assured that they will run.
+
+&debug('starting up command loop...');
+
+END { &debug('perl is shutting down...'); }
+
+$irc->start();
+
+# -- #mozilla was here --
+#       Maybe I'll file a bug about netcenter and that will
+#              get some attention
+#       "Browser won't render home.netscape.com.. because it
+#              won't start up"
+#     alecf how about "cant view banner ads - wont start up"
+#       even better
+#   all bugs are dependent on this one!
+
+# *** Disconnected from irc.mozilla.org
diff --git a/mozbot.pl.cfg b/mozbot.pl.cfg
new file mode 100644
index 0000000..f4f5c1b
--- /dev/null
+++ b/mozbot.pl.cfg
@@ -0,0 +1,243 @@
+channelKeys
+channels=#tu.sepm
+connectTimeout=120
+currentnick=0
+gender=female
+helpline=http://www.mozilla.org/projects/mozbot/
+ignoredTargets
+ignoredUsers
+modules=Admin
+modules=General
+modules=Greeting
+modules=Infobot
+modules=Parrot
+modules=Bugzilla
+nicks=bugbot
+owner=someone@jvales.net
+password=
+port=6667
+server=irc.somenet.org
+simpleIRCNameServer=
+sleep=60
+smtphost=mail.somenet.org
+ssl=no
+throttleTime=1.3
+userFlags="someone"=>1
+username=0
+users="someone"=>MyakYzeZfM6pg
+validUsernameServer=
+variablepattern=[-_:a-zA-Z0-9]+
+General::allowusers
+General::autojoin=1
+General::channels=#mozbot
+General::channels=#tu.sepm
+General::channelsBlocked
+General::denyusers
+General::helpStyle=compact
+General::preferredHelpLineLength=90
+Greeting::allowusers
+Greeting::apology=Apology accepted.
+Greeting::apology=thanks
+Greeting::apology=s'ok
+Greeting::apology=heh
+Greeting::apology=that's ok
+Greeting::apologyIndex=0
+Greeting::assumeThanksTime=10
+Greeting::autoGreetMute
+Greeting::autoGreetedBackoffTime=20
+Greeting::autoGreetings
+Greeting::autojoin=1
+Greeting::byes=seeya %
+Greeting::byes=bye %
+Greeting::byes=night %
+Greeting::byes=/me waves goodbye to %
+Greeting::byesIndex=0
+Greeting::channels=#mozbot
+Greeting::channels=#tu.sepm
+Greeting::channelsBlocked
+Greeting::denyusers
+Greeting::evil=c++ is evil
+Greeting::evil=/me mumbles something about c++ being evil
+Greeting::evil=c++ is e-- ah, nevermind.
+Greeting::evil=c++ sucks
+Greeting::evil=/me frowns at %
+Greeting::evilBackoffTime=36000
+Greeting::evilIndex=0
+Greeting::evilMute
+Greeting::greetings=hi %
+Greeting::greetings=yo %
+Greeting::greetings=salut %
+Greeting::greetings=%! dude!
+Greeting::greetings=%: hello
+Greeting::greetings=%
+Greeting::greetings=bonjour %
+Greeting::greetings=g'day mate
+Greeting::greetingsIndex=1
+Greeting::happy=:)
+Greeting::happy=/me smiles
+Greeting::happy=yay
+Greeting::happy=/me beams
+Greeting::happyIndex=0
+Greeting::hit=/me smacks %target
+Greeting::hit=/me hits %target over the head with a hammer
+Greeting::hit=/me trips %target up and laughs
+Greeting::hit=%target! look over there! *smack*
+Greeting::hit=/me pokes %target in the ribs
+Greeting::hitEnabled=1
+Greeting::hitIndex=0
+Greeting::hitProtected=""=>%source: Oh you'd like that, wouldn't you, you sadist pervert.
+Greeting::hitProtected="yourself"=>hey look everyone! %source likes to see others hurt themselves!
+Greeting::hitProtected="me"=>/me wacks %source in the legs with a crowbar
+Greeting::hitProtected="hixie"=>%target: %source wanted me to hurt you but don't worry, i wuv you, i'd never hurt you...
+Greeting::hitProtected="urself"=>oh my! %source can't even spell! It's written "yourself", moron!
+Greeting::hug=/me hugs %target
+Greeting::hug=%target: *hug*
+Greeting::hug=/me hugs %target lovingly
+Greeting::hug=%target: come 'ere! *hugs and kisses*
+Greeting::hugIndex=0
+Greeting::kinky=eep!
+Greeting::kinky=me-ow!
+Greeting::kinky=oh yeah! spank me baby!
+Greeting::kinky=/me tickles %
+Greeting::kinky=he-llo, baby!
+Greeting::kinkyIndex=0
+Greeting::lastEvil=0
+Greeting::listen=(*
+Greeting::listen=%: I'm listening.
+Greeting::listen=%?
+Greeting::listenIndex=0
+Greeting::ow=%!! stop it!!
+Greeting::ow=%? You want something?
+Greeting::ow=I'm working! Leave me alone!
+Greeting::ow=ow!
+Greeting::ow=Leave me out of it!
+Greeting::ow=%: mean!
+Greeting::owIndex=0
+Greeting::pat=/me patpats %target
+Greeting::pat=%target: yes dear, *pat* *pat*
+Greeting::pat=/me pats %target condescendingly
+Greeting::pat=%target: *pat* *pat*
+Greeting::patIndex=0
+Greeting::patProtected=""=>%source: what did I do now?
+Greeting::patProtected="yourself"=>%source: why? what did i do wrong?
+Greeting::rheetMaxEs=100
+Greeting::rheetbuffer=10
+Greeting::source=http://lxr.mozilla.org/mozilla/source/webtools/mozbot/
+Greeting::thanks=sure thing %
+Greeting::thanks=np
+Greeting::thanks=%: np
+Greeting::thanks=%: just doing my job!
+Greeting::thanksIndex=0
+Greeting::tickle=eep!
+Greeting::tickle=iiiih!
+Greeting::tickle=meep!
+Greeting::tickle=/me tickles % back
+Greeting::tickle=yelp!
+Greeting::tickleIndex=0
+Greeting::unhappy=:(
+Greeting::unhappy=/me sobs
+Greeting::unhappy=/me cries
+Greeting::unhappy=*sniff*
+Greeting::unhappy=but... but...
+Greeting::unhappy=/me is all sad
+Greeting::unhappyIndex=0
+Greeting::veryow=OOOOWWWW!!!
+Greeting::veryow=GETOFF!!!
+Greeting::veryow=/me fights back
+Greeting::veryow=Yikes! I'm being attacked!!
+Greeting::veryow=/me hits % over the head with a 2-by-4
+Greeting::veryowIndex=0
+Greeting::vhappy=OOoh! %!
+Greeting::vhappy=I love you too, %.
+Greeting::vhappyIndex=0
+Greeting::whoami=I am a bot. /msg me the word 'help' for a list of commands.
+Greeting::yousuck=%: no, *you* suck!
+Greeting::yousuck=/me pouts
+Greeting::yousuck=/me cries
+Greeting::yousuck=/me . o O ( now what have i done... )
+Greeting::yousuckIndex=0
+Infobot::allowusers
+Infobot::autoEdit
+Infobot::autoHelp
+Infobot::autoIgnore
+Infobot::autoLearn=*
+Infobot::autojoin=1
+Infobot::channels=#mozbot
+Infobot::channels=#tu.sepm
+Infobot::channelsBlocked
+Infobot::denyusers
+Infobot::dunnoTimeToLive=604800
+Infobot::eagerToHelp=1
+Infobot::friendBots
+Infobot::maxInChannel=200
+Infobot::neverEdit
+Infobot::neverHelp
+Infobot::neverLearn
+Infobot::noIdeaDelay=2
+Infobot::prefixes=
+Infobot::prefixes=I have heard that 
+Infobot::prefixes=
+Infobot::prefixes=Maybe 
+Infobot::prefixes=I seem to recall that 
+Infobot::prefixes=
+Infobot::prefixes=iirc, 
+Infobot::prefixes=
+Infobot::prefixes=Was it not... er, someone, who said: 
+Infobot::prefixes=
+Infobot::prefixes=Well, 
+Infobot::prefixes=um... 
+Infobot::prefixes=Oh, I know this one! 
+Infobot::prefixes=
+Infobot::prefixes=everyone knows that! 
+Infobot::prefixes=
+Infobot::prefixes=hmm... I think 
+Infobot::prefixes=well, duh. 
+Infobot::pruneDelay=120
+Infobot::queryTimeToLive=600
+Infobot::teachers
+Parrot::allowusers
+Parrot::autojoin=1
+Parrot::channels=#mozbot
+Parrot::channels=#tu.sepm
+Parrot::channelsBlocked
+Parrot::denyusers
+Admin::allowChannelAdmin=0
+Admin::allowInviting=1
+Admin::allowusers
+Admin::channelsBlocked
+Admin::denyusers
+Admin::errorMessagesMaxLines=5
+Admin::files=./mozbot.pl
+Admin::files=lib/Mails.pm
+Admin::files=lib/Configuration.pm
+Admin::files=lib/IO/SecurePipe.pm
+Admin::sourceCodeCheckDelay=20
+Bugzilla::allowusers
+Bugzilla::autojoin=1
+Bugzilla::backoffTime=1
+Bugzilla::bugsDWIMQueryChannelDefault
+Bugzilla::bugsDWIMQueryDefault=short_desc_type=substring&short_desc=
+Bugzilla::bugsURI=http://sepm.jvales.net/bugzilla/
+Bugzilla::channelMuteFields
+Bugzilla::channels=#mozbot
+Bugzilla::channels=#tu.sepm
+Bugzilla::channelsBlocked
+Bugzilla::denyusers
+Bugzilla::ignoreCommentsFrom=|
+Bugzilla::ignoreCommentsTo=
+Bugzilla::mailIgnore
+Bugzilla::mutes=
+Bugzilla::productMuteFields
+Bugzilla::productReportChannels="Panda"=>#tu.sepm
+Bugzilla::reportBugDetails=1
+Bugzilla::reportComponent=all
+Bugzilla::reportFields=Resolution
+Bugzilla::reportFields=Flag
+Bugzilla::reportFields=Attachment Flag
+Bugzilla::reportFields=NewBug
+Bugzilla::reportFields=NewAttach
+Bugzilla::reportFields=Status
+Bugzilla::reportFields=Summary
+Bugzilla::reportFields=Priority
+Bugzilla::skipPrefixFor
+Bugzilla::updateDelay=1
diff --git a/run-mozbot-chrooted b/run-mozbot-chrooted
new file mode 100644
index 0000000..5e242ab
--- /dev/null
+++ b/run-mozbot-chrooted
@@ -0,0 +1,5 @@
+export PATH=/bin
+./mozbot.pl --chroot /config/default
+
+# NOTE. This file requires that you follow the steps described in the
+# included INSTALL file.
diff --git a/run-mozbot-from-crontab b/run-mozbot-from-crontab
new file mode 100644
index 0000000..dc7804d
--- /dev/null
+++ b/run-mozbot-from-crontab
@@ -0,0 +1,22 @@
+#!/bin/bash
+#
+# run-mozbot-from-crontab: Script for restarting mozbot from crontab
+# Originally written by Joel Thornton 
+#
+# This is good to use in your crontab for rebooting the bot
+# automagically upon its untimely demise. Use a line such as this in
+# your crontab:
+#
+# 0,5,10,15,20,25,30,35,40,45,50,55 * * * * $HOME/mozbot/run-mozbot-from-crontab
+#
+# Change the paths to your mozbot accordingly above and in the next
+# line.
+
+cd $HOME/mozbot
+
+# Create an empty .pid file first if it doesn't exist.
+touch ./mozbot.pid
+
+ps -C mozbot.pl -o pid= | grep "`cat ./mozbot.pid`" ||
+( ( ./mozbot.pl >& /dev/null & ) ;
+  ps -C mozbot.pl -o pid= | head --lines=1 > ./mozbot.pid )
diff --git a/uuidgen/CVS/Entries b/uuidgen/CVS/Entries
new file mode 100644
index 0000000..00e89e0
--- /dev/null
+++ b/uuidgen/CVS/Entries
@@ -0,0 +1,7 @@
+/Makefile/1.1/Wed Aug 25 16:38:58 1999//TMOZBOT-2_6
+/main.c/1.1/Wed Aug 25 16:38:59 1999//TMOZBOT-2_6
+/md5.c/1.1/Wed Aug 25 16:38:59 1999//TMOZBOT-2_6
+/md5.h/1.1/Wed Aug 25 16:39:00 1999//TMOZBOT-2_6
+/token.c/1.1/Wed Aug 25 16:39:00 1999//TMOZBOT-2_6
+/token.h/1.1/Wed Aug 25 16:39:01 1999//TMOZBOT-2_6
+D
diff --git a/uuidgen/CVS/Repository b/uuidgen/CVS/Repository
new file mode 100644
index 0000000..855386a
--- /dev/null
+++ b/uuidgen/CVS/Repository
@@ -0,0 +1 @@
+mozilla/webtools/mozbot/uuidgen
diff --git a/uuidgen/CVS/Root b/uuidgen/CVS/Root
new file mode 100644
index 0000000..cdb6f4a
--- /dev/null
+++ b/uuidgen/CVS/Root
@@ -0,0 +1 @@
+:pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot
diff --git a/uuidgen/CVS/Tag b/uuidgen/CVS/Tag
new file mode 100644
index 0000000..0fe9246
--- /dev/null
+++ b/uuidgen/CVS/Tag
@@ -0,0 +1 @@
+NMOZBOT-2_6
diff --git a/uuidgen/Makefile b/uuidgen/Makefile
new file mode 100644
index 0000000..0612bdd
--- /dev/null
+++ b/uuidgen/Makefile
@@ -0,0 +1,17 @@
+CFLAGS=-g
+
+OBJS=md5.o token.o main.o
+
+all: $(OBJS) uuidgen
+
+uuidgen: $(OBJS)
+	gcc -o uuidgen $(OBJS)
+
+md5.o: md5.c md5.h
+
+token.o: token.c token.h
+
+main.o: main.c
+
+clean:
+	rm -f *.o *~ core uuidgen
diff --git a/uuidgen/main.c b/uuidgen/main.c
new file mode 100644
index 0000000..a0677c2
--- /dev/null
+++ b/uuidgen/main.c
@@ -0,0 +1,17 @@
+/* copyright?  hah!  it's 10 lines of code! */
+
+#include 
+#include "token.h"
+
+int main(int argc, char **argv) {
+  uuid_state state;
+  uuid_t uuid;
+  char output[1024];
+
+  create_uuid_state(&state);
+  create_token(&state, &uuid);
+  format_token(output, &uuid);
+
+  printf("%s\n", output);
+  
+}
diff --git a/uuidgen/md5.c b/uuidgen/md5.c
new file mode 100644
index 0000000..fe27c45
--- /dev/null
+++ b/uuidgen/md5.c
@@ -0,0 +1,263 @@
+/*
+ * This code implements the MD5 message-digest algorithm.
+ * The algorithm is due to Ron Rivest.	This code was
+ * written by Colin Plumb in 1993, no copyright is claimed.
+ * This code is in the public domain; do with it what you wish.
+ *
+ * Equivalent code is available from RSA Data Security, Inc.
+ * This code has been tested against that, and is equivalent,
+ * except that you don't need to include two pages of legalese
+ * with every copy.
+ *
+ * To compute the message digest of a chunk of bytes, declare an
+ * MD5Context structure, pass it to MD5Init, call MD5Update as
+ * needed on buffers full of bytes, and then call MD5Final, which
+ * will fill a supplied 16-byte array with the digest.
+ */
+
+/* Brutally hacked by John Walker back from ANSI C to K&R (no
+   prototypes) to maintain the tradition that Netfone will compile
+   with Sun's original "cc". */
+
+#include 		 /* for memcpy() */
+#include "md5.h"
+
+#ifdef sgi
+#define HIGHFIRST
+#endif
+
+#ifdef sun
+#define HIGHFIRST
+#endif
+
+#ifndef HIGHFIRST
+#define byteReverse(buf, len)	/* Nothing */
+#else
+/*
+ * Note: this code is harmless on little-endian machines.
+ */
+void byteReverse(buf, longs)
+    unsigned char *buf; unsigned longs;
+{
+    uint32 t;
+    do {
+	t = (uint32) ((unsigned) buf[3] << 8 | buf[2]) << 16 |
+	    ((unsigned) buf[1] << 8 | buf[0]);
+	*(uint32 *) buf = t;
+	buf += 4;
+    } while (--longs);
+}
+#endif
+
+/*
+ * Start MD5 accumulation.  Set bit count to 0 and buffer to mysterious
+ * initialization constants.
+ */
+void MD5Init(ctx)
+    struct MD5Context *ctx;
+{
+    ctx->buf[0] = 0x67452301;
+    ctx->buf[1] = 0xefcdab89;
+    ctx->buf[2] = 0x98badcfe;
+    ctx->buf[3] = 0x10325476;
+
+    ctx->bits[0] = 0;
+    ctx->bits[1] = 0;
+}
+
+/*
+ * Update context to reflect the concatenation of another buffer full
+ * of bytes.
+ */
+void MD5Update(ctx, buf, len)
+    struct MD5Context *ctx; unsigned char *buf; unsigned len;
+{
+    uint32 t;
+
+    /* Update bitcount */
+
+    t = ctx->bits[0];
+    if ((ctx->bits[0] = t + ((uint32) len << 3)) < t)
+	ctx->bits[1]++; 	/* Carry from low to high */
+    ctx->bits[1] += len >> 29;
+
+    t = (t >> 3) & 0x3f;	/* Bytes already in shsInfo->data */
+
+    /* Handle any leading odd-sized chunks */
+
+    if (t) {
+	unsigned char *p = (unsigned char *) ctx->in + t;
+
+	t = 64 - t;
+	if (len < t) {
+	    memcpy(p, buf, len);
+	    return;
+	}
+	memcpy(p, buf, t);
+	byteReverse(ctx->in, 16);
+	MD5Transform(ctx->buf, (uint32 *) ctx->in);
+	buf += t;
+	len -= t;
+    }
+    /* Process data in 64-byte chunks */
+
+    while (len >= 64) {
+	memcpy(ctx->in, buf, 64);
+	byteReverse(ctx->in, 16);
+	MD5Transform(ctx->buf, (uint32 *) ctx->in);
+	buf += 64;
+	len -= 64;
+    }
+
+    /* Handle any remaining bytes of data. */
+
+    memcpy(ctx->in, buf, len);
+}
+
+/*
+ * Final wrapup - pad to 64-byte boundary with the bit pattern 
+ * 1 0* (64-bit count of bits processed, MSB-first)
+ */
+void MD5Final(digest, ctx)
+    unsigned char digest[16]; struct MD5Context *ctx;
+{
+    unsigned count;
+    unsigned char *p;
+
+    /* Compute number of bytes mod 64 */
+    count = (ctx->bits[0] >> 3) & 0x3F;
+
+    /* Set the first char of padding to 0x80.  This is safe since there is
+       always at least one byte free */
+    p = ctx->in + count;
+    *p++ = 0x80;
+
+    /* Bytes of padding needed to make 64 bytes */
+    count = 64 - 1 - count;
+
+    /* Pad out to 56 mod 64 */
+    if (count < 8) {
+	/* Two lots of padding:  Pad the first block to 64 bytes */
+	memset(p, 0, count);
+	byteReverse(ctx->in, 16);
+	MD5Transform(ctx->buf, (uint32 *) ctx->in);
+
+	/* Now fill the next block with 56 bytes */
+	memset(ctx->in, 0, 56);
+    } else {
+	/* Pad block to 56 bytes */
+	memset(p, 0, count - 8);
+    }
+    byteReverse(ctx->in, 14);
+
+    /* Append length in bits and transform */
+    ((uint32 *) ctx->in)[14] = ctx->bits[0];
+    ((uint32 *) ctx->in)[15] = ctx->bits[1];
+
+    MD5Transform(ctx->buf, (uint32 *) ctx->in);
+    byteReverse((unsigned char *) ctx->buf, 4);
+    memcpy(digest, ctx->buf, 16);
+    memset(ctx, 0, sizeof(ctx));        /* In case it's sensitive */
+}
+
+
+/* The four core functions - F1 is optimized somewhat */
+
+/* #define F1(x, y, z) (x & y | ~x & z) */
+#define F1(x, y, z) (z ^ (x & (y ^ z)))
+#define F2(x, y, z) F1(z, x, y)
+#define F3(x, y, z) (x ^ y ^ z)
+#define F4(x, y, z) (y ^ (x | ~z))
+
+/* This is the central step in the MD5 algorithm. */
+#define MD5STEP(f, w, x, y, z, data, s) \
+	( w += f(x, y, z) + data,  w = w<>(32-s),  w += x )
+
+/*
+ * The core of the MD5 algorithm, this alters an existing MD5 hash to
+ * reflect the addition of 16 longwords of new data.  MD5Update blocks
+ * the data and converts bytes into longwords for this routine.
+ */
+void MD5Transform(buf, in)
+    uint32 buf[4]; uint32 in[16];
+{
+    register uint32 a, b, c, d;
+
+    a = buf[0];
+    b = buf[1];
+    c = buf[2];
+    d = buf[3];
+
+    MD5STEP(F1, a, b, c, d, in[0] + 0xd76aa478, 7);
+    MD5STEP(F1, d, a, b, c, in[1] + 0xe8c7b756, 12);
+    MD5STEP(F1, c, d, a, b, in[2] + 0x242070db, 17);
+    MD5STEP(F1, b, c, d, a, in[3] + 0xc1bdceee, 22);
+    MD5STEP(F1, a, b, c, d, in[4] + 0xf57c0faf, 7);
+    MD5STEP(F1, d, a, b, c, in[5] + 0x4787c62a, 12);
+    MD5STEP(F1, c, d, a, b, in[6] + 0xa8304613, 17);
+    MD5STEP(F1, b, c, d, a, in[7] + 0xfd469501, 22);
+    MD5STEP(F1, a, b, c, d, in[8] + 0x698098d8, 7);
+    MD5STEP(F1, d, a, b, c, in[9] + 0x8b44f7af, 12);
+    MD5STEP(F1, c, d, a, b, in[10] + 0xffff5bb1, 17);
+    MD5STEP(F1, b, c, d, a, in[11] + 0x895cd7be, 22);
+    MD5STEP(F1, a, b, c, d, in[12] + 0x6b901122, 7);
+    MD5STEP(F1, d, a, b, c, in[13] + 0xfd987193, 12);
+    MD5STEP(F1, c, d, a, b, in[14] + 0xa679438e, 17);
+    MD5STEP(F1, b, c, d, a, in[15] + 0x49b40821, 22);
+
+    MD5STEP(F2, a, b, c, d, in[1] + 0xf61e2562, 5);
+    MD5STEP(F2, d, a, b, c, in[6] + 0xc040b340, 9);
+    MD5STEP(F2, c, d, a, b, in[11] + 0x265e5a51, 14);
+    MD5STEP(F2, b, c, d, a, in[0] + 0xe9b6c7aa, 20);
+    MD5STEP(F2, a, b, c, d, in[5] + 0xd62f105d, 5);
+    MD5STEP(F2, d, a, b, c, in[10] + 0x02441453, 9);
+    MD5STEP(F2, c, d, a, b, in[15] + 0xd8a1e681, 14);
+    MD5STEP(F2, b, c, d, a, in[4] + 0xe7d3fbc8, 20);
+    MD5STEP(F2, a, b, c, d, in[9] + 0x21e1cde6, 5);
+    MD5STEP(F2, d, a, b, c, in[14] + 0xc33707d6, 9);
+    MD5STEP(F2, c, d, a, b, in[3] + 0xf4d50d87, 14);
+    MD5STEP(F2, b, c, d, a, in[8] + 0x455a14ed, 20);
+    MD5STEP(F2, a, b, c, d, in[13] + 0xa9e3e905, 5);
+    MD5STEP(F2, d, a, b, c, in[2] + 0xfcefa3f8, 9);
+    MD5STEP(F2, c, d, a, b, in[7] + 0x676f02d9, 14);
+    MD5STEP(F2, b, c, d, a, in[12] + 0x8d2a4c8a, 20);
+
+    MD5STEP(F3, a, b, c, d, in[5] + 0xfffa3942, 4);
+    MD5STEP(F3, d, a, b, c, in[8] + 0x8771f681, 11);
+    MD5STEP(F3, c, d, a, b, in[11] + 0x6d9d6122, 16);
+    MD5STEP(F3, b, c, d, a, in[14] + 0xfde5380c, 23);
+    MD5STEP(F3, a, b, c, d, in[1] + 0xa4beea44, 4);
+    MD5STEP(F3, d, a, b, c, in[4] + 0x4bdecfa9, 11);
+    MD5STEP(F3, c, d, a, b, in[7] + 0xf6bb4b60, 16);
+    MD5STEP(F3, b, c, d, a, in[10] + 0xbebfbc70, 23);
+    MD5STEP(F3, a, b, c, d, in[13] + 0x289b7ec6, 4);
+    MD5STEP(F3, d, a, b, c, in[0] + 0xeaa127fa, 11);
+    MD5STEP(F3, c, d, a, b, in[3] + 0xd4ef3085, 16);
+    MD5STEP(F3, b, c, d, a, in[6] + 0x04881d05, 23);
+    MD5STEP(F3, a, b, c, d, in[9] + 0xd9d4d039, 4);
+    MD5STEP(F3, d, a, b, c, in[12] + 0xe6db99e5, 11);
+    MD5STEP(F3, c, d, a, b, in[15] + 0x1fa27cf8, 16);
+    MD5STEP(F3, b, c, d, a, in[2] + 0xc4ac5665, 23);
+
+    MD5STEP(F4, a, b, c, d, in[0] + 0xf4292244, 6);
+    MD5STEP(F4, d, a, b, c, in[7] + 0x432aff97, 10);
+    MD5STEP(F4, c, d, a, b, in[14] + 0xab9423a7, 15);
+    MD5STEP(F4, b, c, d, a, in[5] + 0xfc93a039, 21);
+    MD5STEP(F4, a, b, c, d, in[12] + 0x655b59c3, 6);
+    MD5STEP(F4, d, a, b, c, in[3] + 0x8f0ccc92, 10);
+    MD5STEP(F4, c, d, a, b, in[10] + 0xffeff47d, 15);
+    MD5STEP(F4, b, c, d, a, in[1] + 0x85845dd1, 21);
+    MD5STEP(F4, a, b, c, d, in[8] + 0x6fa87e4f, 6);
+    MD5STEP(F4, d, a, b, c, in[15] + 0xfe2ce6e0, 10);
+    MD5STEP(F4, c, d, a, b, in[6] + 0xa3014314, 15);
+    MD5STEP(F4, b, c, d, a, in[13] + 0x4e0811a1, 21);
+    MD5STEP(F4, a, b, c, d, in[4] + 0xf7537e82, 6);
+    MD5STEP(F4, d, a, b, c, in[11] + 0xbd3af235, 10);
+    MD5STEP(F4, c, d, a, b, in[2] + 0x2ad7d2bb, 15);
+    MD5STEP(F4, b, c, d, a, in[9] + 0xeb86d391, 21);
+
+    buf[0] += a;
+    buf[1] += b;
+    buf[2] += c;
+    buf[3] += d;
+}
diff --git a/uuidgen/md5.h b/uuidgen/md5.h
new file mode 100644
index 0000000..25c0756
--- /dev/null
+++ b/uuidgen/md5.h
@@ -0,0 +1,26 @@
+#ifndef MD5_H
+#define MD5_H
+
+#ifdef __alpha
+typedef unsigned int uint32;
+#else
+typedef unsigned long uint32;
+#endif
+
+struct MD5Context {
+        uint32 buf[4];
+        uint32 bits[2];
+        unsigned char in[64];
+};
+
+extern void MD5Init();
+extern void MD5Update();
+extern void MD5Final();
+extern void MD5Transform();
+
+/*
+ * This is needed to make RSAREF happy on some MS-DOS compilers.
+ */
+typedef struct MD5Context MD5_CTX;
+
+#endif /* !MD5_H */
diff --git a/uuidgen/token.c b/uuidgen/token.c
new file mode 100644
index 0000000..2b175f1
--- /dev/null
+++ b/uuidgen/token.c
@@ -0,0 +1,356 @@
+/*
+** Copyright (C) 1998-1999 Greg Stein. All Rights Reserved.
+**
+** By using this file, you agree to the terms and conditions set forth in
+** the LICENSE.html file which can be found at the top level of the mod_dav
+** distribution or at http://www.webdav.org/mod_dav/license-1.html.
+**
+** Contact information:
+**   Greg Stein, PO Box 3151, Redmond, WA, 98073
+**   gstein@lyra.org, http://www.webdav.org/mod_dav/
+*/
+
+/*
+** DAV opaquelocktoken scheme implementation
+**
+** Written 5/99 by Keith Wannamaker, wannamak@us.ibm.com
+** Adapted from ISO/DCE RPC spec and a former Internet Draft
+** by Leach and Salz:
+** http://www.ics.uci.edu/pub/ietf/webdav/uuid-guid/draft-leach-uuids-guids-01
+**
+** Portions of the code are covered by the following license:
+**
+** Copyright (c) 1990- 1993, 1996 Open Software Foundation, Inc.
+** Copyright (c) 1989 by Hewlett-Packard Company, Palo Alto, Ca. &
+** Digital Equipment Corporation, Maynard, Mass.
+** Copyright (c) 1998 Microsoft.
+** To anyone who acknowledges that this file is provided "AS IS"
+** without any express or implied warranty: permission to use, copy,
+** modify, and distribute this file for any purpose is hereby
+** granted without fee, provided that the above copyright notices and
+** this notice appears in all source code copies, and that none of
+** the names of Open Software Foundation, Inc., Hewlett-Packard
+** Company, or Digital Equipment Corporation be used in advertising
+** or publicity pertaining to distribution of the software without
+** specific, written prior permission.  Neither Open Software
+** Foundation, Inc., Hewlett-Packard Company, Microsoft, nor Digital Equipment
+** Corporation makes any representations about the suitability of
+** this software for any purpose.
+*/
+
+#include 
+#include 
+#include 
+#include 
+
+#include "md5.h"
+#include "token.h"
+
+#ifdef WIN32
+#include 
+#else
+#include 
+#include 
+#include 
+#endif
+
+/* set the following to the number of 100ns ticks of the actual resolution of
+   your system's clock */
+#define UUIDS_PER_TICK 1024
+
+/* Set this to what your compiler uses for 64 bit data type */
+#ifdef WIN32
+#define unsigned64_t unsigned __int64
+#define I64(C) C
+#else
+#define unsigned64_t unsigned long long
+#define I64(C) C##LL
+#endif
+
+typedef unsigned64_t uuid_time_t;
+
+const uuid_t null_locktoken = {0};
+
+static void format_uuid_v1(uuid_t * uuid, unsigned16 clockseq, uuid_time_t timestamp, uuid_node_t node);
+static void get_current_time(uuid_time_t * timestamp);
+static unsigned16 true_random(void);
+static void get_pseudo_node_identifier(uuid_node_t *node);
+static void get_system_time(uuid_time_t *uuid_time);
+static void get_random_info(unsigned char seed[16]);
+
+
+/* dav_create_opaquelocktoken - generates a UUID version 1 token.
+ *   Clock_sequence and node_address set to pseudo-random
+ *   numbers during init.  
+ *
+ *   Should postpend pid to account for non-seralized creation?
+ */
+int create_token(uuid_state *st, uuid_t *u)
+{
+    uuid_time_t timestamp;
+    
+    get_current_time(×tamp);
+    format_uuid_v1(u, st->cs, timestamp, st->node);
+    
+    return 1;
+}
+
+/*
+ * dav_create_uuid_state - seed UUID state with pseudorandom data
+ */
+void create_uuid_state(uuid_state *st)
+{
+    st->cs = true_random();
+    get_pseudo_node_identifier(&st->node);
+}
+
+/*
+ * dav_format_opaquelocktoken - generates a text representation
+ *    of an opaquelocktoken
+ */
+void format_token(char *target, const uuid_t *u)
+{
+  sprintf(target, "%08lx-%04x-%04x-%02x%02x-%02x%02x%02x%02x%02x%02x",
+	  u->time_low, u->time_mid, u->time_hi_and_version,
+	  u->clock_seq_hi_and_reserved, u->clock_seq_low,
+	  u->node[0], u->node[1], u->node[2],
+	  u->node[3], u->node[4], u->node[5]);
+}
+
+/* convert a pair of hex digits to an integer value [0,255] */
+static int dav_parse_hexpair(const char *s)
+{
+    int result;
+    int temp;
+
+    result = s[0] - '0';
+    if (result > 48)
+	result = (result - 39) << 4;
+    else if (result > 16)
+	result = (result - 7) << 4;
+    else
+	result = result << 4;
+
+    temp = s[1] - '0';
+    if (temp > 48)
+	result |= temp - 39;
+    else if (temp > 16)
+	result |= temp - 7;
+    else
+	result |= temp;
+
+    return result;
+}
+
+/* dav_parse_locktoken:  Parses string produced from
+ *    dav_format_opaquelocktoken back into a uuid_t
+ *    structure.  On failure, return DAV_IF_ERROR_PARSE,
+ *    else DAV_IF_ERROR_NONE.
+ */
+int parse_token(const char *char_token, uuid_t *bin_token)
+{
+    int i;
+
+    for (i = 0; i < 36; ++i) {
+	char c = char_token[i];
+	if (!isxdigit(c) &&
+	    !(c == '-' && (i == 8 || i == 13 || i == 18 || i == 23)))
+	    return -1;
+    }
+    if (char_token[36] != '\0')
+	return -1;
+
+    bin_token->time_low =
+	(dav_parse_hexpair(&char_token[0]) << 24) |
+	(dav_parse_hexpair(&char_token[2]) << 16) |
+	(dav_parse_hexpair(&char_token[4]) << 8) |
+	dav_parse_hexpair(&char_token[6]);
+
+    bin_token->time_mid =
+	(dav_parse_hexpair(&char_token[9]) << 8) |
+	dav_parse_hexpair(&char_token[11]);
+
+    bin_token->time_hi_and_version =
+	(dav_parse_hexpair(&char_token[14]) << 8) |
+	dav_parse_hexpair(&char_token[16]);
+
+    bin_token->clock_seq_hi_and_reserved = dav_parse_hexpair(&char_token[19]);
+    bin_token->clock_seq_low = dav_parse_hexpair(&char_token[21]);
+
+    for (i = 6; i--;)
+	bin_token->node[i] = dav_parse_hexpair(&char_token[i*2+24]);
+
+    return -1;
+}
+
+/* dav_compare_opaquelocktoken:
+ *    < 0 : a < b
+ *   == 0 : a = b
+ *    > 0 : a > b
+ */
+int compare_token(const uuid_t a, const uuid_t b)
+{
+    return memcmp(&a, &b, sizeof(uuid_t));
+}
+
+/* format_uuid_v1 -- make a UUID from the timestamp, clockseq, and node ID */
+static void format_uuid_v1(uuid_t * uuid, unsigned16 clock_seq,
+			   uuid_time_t timestamp, uuid_node_t node)
+{
+    /* Construct a version 1 uuid with the information we've gathered
+     * plus a few constants. */
+    uuid->time_low = (unsigned long)(timestamp & 0xFFFFFFFF);
+    uuid->time_mid = (unsigned short)((timestamp >> 32) & 0xFFFF);
+    uuid->time_hi_and_version = (unsigned short)((timestamp >> 48) & 0x0FFF);
+    uuid->time_hi_and_version |= (1 << 12);
+    uuid->clock_seq_low = clock_seq & 0xFF;
+    uuid->clock_seq_hi_and_reserved = (clock_seq & 0x3F00) >> 8;
+    uuid->clock_seq_hi_and_reserved |= 0x80;
+    memcpy(&uuid->node, &node, sizeof uuid->node);
+}
+
+/* get-current_time -- get time as 60 bit 100ns ticks since whenever.
+   Compensate for the fact that real clock resolution is less than 100ns. */
+static void get_current_time(uuid_time_t * timestamp)
+{
+    uuid_time_t         time_now;
+    static uuid_time_t  time_last;
+    static unsigned16   uuids_this_tick;
+    static int          inited = 0;
+    
+    if (!inited) {
+        get_system_time(&time_now);
+        uuids_this_tick = UUIDS_PER_TICK;
+        inited = 1;
+    };
+	
+    while (1) {
+	get_system_time(&time_now);
+        
+	/* if clock reading changed since last UUID generated... */
+	if (time_last != time_now) {
+	    /* reset count of uuids gen'd with this clock reading */
+	    uuids_this_tick = 0;
+	    break;
+	};
+	if (uuids_this_tick < UUIDS_PER_TICK) {
+	    uuids_this_tick++;
+	    break;
+	};        /* going too fast for our clock; spin */
+    };    /* add the count of uuids to low order bits of the clock reading */
+
+    *timestamp = time_now + uuids_this_tick;
+}
+
+/* true_random -- generate a crypto-quality random number.
+   This sample doesn't do that. */
+static unsigned16 true_random(void)
+{
+    uuid_time_t time_now;
+
+    get_system_time(&time_now);
+    time_now = time_now/UUIDS_PER_TICK;
+    srand((unsigned int)(((time_now >> 32) ^ time_now)&0xffffffff));
+
+    return rand();
+}
+
+/* This sample implementation generates a random node ID   *
+ * in lieu of a system dependent call to get IEEE node ID. */
+static void get_pseudo_node_identifier(uuid_node_t *node)
+{
+    unsigned char seed[16];
+
+    get_random_info(seed);
+    seed[0] |= 0x80;
+    memcpy(node, seed, sizeof(*node));
+}
+
+/* system dependent call to get the current system time.
+   Returned as 100ns ticks since Oct 15, 1582, but resolution may be
+   less than 100ns.  */
+
+#ifdef WIN32
+
+static void get_system_time(uuid_time_t *uuid_time)
+{
+    ULARGE_INTEGER time;
+
+    GetSystemTimeAsFileTime((FILETIME *)&time);
+
+    /* NT keeps time in FILETIME format which is 100ns ticks since
+       Jan 1, 1601.  UUIDs use time in 100ns ticks since Oct 15, 1582.
+       The difference is 17 Days in Oct + 30 (Nov) + 31 (Dec)
+       + 18 years and 5 leap days.    */
+	
+    time.QuadPart +=
+	(unsigned __int64) (1000*1000*10)       // seconds
+	* (unsigned __int64) (60 * 60 * 24)       // days
+	* (unsigned __int64) (17+30+31+365*18+5); // # of days
+    *uuid_time = time.QuadPart;
+}
+
+static void get_random_info(unsigned char seed[16])
+{
+    MD5_CTX c;
+    struct {
+        MEMORYSTATUS m;
+        SYSTEM_INFO s;
+        FILETIME t;
+        LARGE_INTEGER pc;
+        DWORD tc;
+        DWORD l;
+        char hostname[MAX_COMPUTERNAME_LENGTH + 1];
+
+    } r;
+    
+    MD5Init(&c);    /* memory usage stats */
+    GlobalMemoryStatus(&r.m);    /* random system stats */
+    GetSystemInfo(&r.s);    /* 100ns resolution (nominally) time of day */
+    GetSystemTimeAsFileTime(&r.t);    /* high resolution performance counter */
+    QueryPerformanceCounter(&r.pc);    /* milliseconds since last boot */
+    r.tc = GetTickCount();
+    r.l = MAX_COMPUTERNAME_LENGTH + 1;
+
+    GetComputerName(r.hostname, &r.l );
+    MD5Update(&c, (const unsigned char *) &r, sizeof(r));
+    MD5Final(seed, &c);
+}
+
+#else /* WIN32 */
+
+static void get_system_time(uuid_time_t *uuid_time)
+{
+    struct timeval tp;
+
+    gettimeofday(&tp, (struct timezone *)0);
+
+    /* Offset between UUID formatted times and Unix formatted times.
+       UUID UTC base time is October 15, 1582.
+       Unix base time is January 1, 1970.      */
+    *uuid_time = (tp.tv_sec * 10000000) + (tp.tv_usec * 10) +
+        I64(0x01B21DD213814000);
+}
+ 
+static void get_random_info(unsigned char seed[16])
+{
+    MD5_CTX c;
+    /* Leech & Salz use Linux-specific struct sysinfo;
+     * replace with pid/tid for portability (in the spirit of mod_unique_id) */
+    struct {
+	/* Add thread id here, if applicable, when we get to pthread or apr */
+	pid_t pid;
+        struct timeval t;
+        char hostname[257];
+
+    } r;
+
+    MD5Init(&c);
+    r.pid = getpid();
+    gettimeofday(&r.t, (struct timezone *)0);
+    gethostname(r.hostname, 256);
+    MD5Update(&c, (const unsigned char *)&r, sizeof(r));
+    MD5Final(seed, &c);
+}
+
+#endif /* WIN32 */
diff --git a/uuidgen/token.h b/uuidgen/token.h
new file mode 100644
index 0000000..2388431
--- /dev/null
+++ b/uuidgen/token.h
@@ -0,0 +1,80 @@
+/*
+** Copyright (C) 1998-1999 Greg Stein. All Rights Reserved.
+**
+** By using this file, you agree to the terms and conditions set forth in
+** the LICENSE.html file which can be found at the top level of the mod_dav
+** distribution or at http://www.webdav.org/mod_dav/license-1.html.
+**
+** Contact information:
+**   Greg Stein, PO Box 3151, Redmond, WA, 98073
+**   gstein@lyra.org, http://www.webdav.org/mod_dav/
+*/
+
+/*
+** DAV opaquelocktoken scheme implementation
+**
+** Written 5/99 by Keith Wannamaker, wannamak@us.ibm.com
+** Adapted from ISO/DCE RPC spec and a former Internet Draft
+** by Leach and Salz:
+** http://www.ics.uci.edu/pub/ietf/webdav/uuid-guid/draft-leach-uuids-guids-01
+**
+** Portions of the code are covered by the following license:
+**
+** Copyright (c) 1990- 1993, 1996 Open Software Foundation, Inc.
+** Copyright (c) 1989 by Hewlett-Packard Company, Palo Alto, Ca. &
+** Digital Equipment Corporation, Maynard, Mass.
+** Copyright (c) 1998 Microsoft.
+** To anyone who acknowledges that this file is provided "AS IS"
+** without any express or implied warranty: permission to use, copy,
+** modify, and distribute this file for any purpose is hereby
+** granted without fee, provided that the above copyright notices and
+** this notice appears in all source code copies, and that none of
+** the names of Open Software Foundation, Inc., Hewlett-Packard
+** Company, or Digital Equipment Corporation be used in advertising
+** or publicity pertaining to distribution of the software without
+** specific, written prior permission.  Neither Open Software
+** Foundation, Inc., Hewlett-Packard Company, Microsoft, nor Digital Equipment
+** Corporation makes any representations about the suitability of
+** this software for any purpose.
+*/
+
+#ifndef _TOKEN_H_
+#define _TOKEN_H_
+
+typedef unsigned long   unsigned32;
+typedef unsigned short  unsigned16;
+typedef unsigned char   unsigned8;
+
+typedef struct {
+    char nodeID[6];
+} uuid_node_t;
+
+#undef uuid_t
+
+typedef struct _uuid_t
+{
+    unsigned32	time_low;
+    unsigned16	time_mid;
+    unsigned16	time_hi_and_version;
+    unsigned8	clock_seq_hi_and_reserved;
+    unsigned8	clock_seq_low;
+    unsigned8	node[6];
+} uuid_t;
+
+/* data type for UUID generator persistent state */
+	
+typedef struct {
+    uuid_node_t node;     /* saved node ID */
+    unsigned16 cs;        /* saved clock sequence */
+} uuid_state;
+
+extern const uuid_t null_locktoken;
+
+/* in dav_opaquelock.c */
+int create_token(uuid_state *st, uuid_t *u);
+void create_uuid_state(uuid_state *st);
+void format_token(char *target, const uuid_t *u);
+int compare_token(const uuid_t a, const uuid_t b);
+int parse_token(const char *char_token, uuid_t *bin_token);
+
+#endif /* _TOKEN_H_ */
-- 
2.43.0