Insult Generator. See bug 204356 for details.

webtools/mozbot/BotModules/Insult.bm

@@ -0,0 +1,125 @@
+################################
+# 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',
+'eagull 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 <who>\'',
+    };
+}
+
+# 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)
+           '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 $who = $1;
+        my $line;
+        if (defined($self->{'insultOverrides'}->{lc $who})) {
+            $line = $self->{'insultOverrides'}->{lc $who};
+        } else {
+            if (lc $who eq 'me') {
+                $who = $event->{'from'};
+            }
+            $line = $self->generateInsult();
+        }
+        $self->say($event, "$who: $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))];
+}