BotModules/Insult.bm

   1 ################################
   2 # Insult Module                #
   3 ################################
   4
   5 # This is basically a loose port of insultd, a random insult server,
   6 # for self-flagellating maniacs, written on 1991-12-09 by
   7 # garnett@colorado.edu. See http://insulthost.colorado.edu/
   8
   9 package BotModules::Insult;
  10 use vars qw(@ISA);
  11 @ISA = qw(BotModules);
  12 1;
  13
  14 our @adjectives = qw( acidic antique contemptible culturally-unsound
  15 despicable evil fermented festering foul fulminating humid impure
  16 inept inferior industrial left-over low-quality malodorous off-color
  17 penguin-molesting petrified pointy-nosed salty sausage-snorfling
  18 tasteless tempestuous tepid tofu-nibbling unintelligent unoriginal
  19 uninspiring weasel-smelling wretched spam-sucking egg-sucking decayed
  20 halfbaked infected squishy porous pickled coughed-up thick vapid
  21 hacked-up unmuzzled bawdy vain lumpish churlish fobbing rank craven
  22 puking jarring fly-bitten pox-marked fen-sucked spongy droning
  23 gleeking warped currish milk-livered surly mammering ill-borne
  24 beef-witted tickle-brained half-faced headless wayward rump-fed
  25 onion-eyed beslubbering villainous lewd-minded cockered full-gorged
  26 rude-snouted crook-pated pribbling dread-bolted fool-born puny fawning
  27 sheep-biting dankish goatish weather-bitten knotty-pated malt-wormy
  28 saucyspleened motley-mind it-fowling vassal-willed loggerheaded
  29 clapper-clawed frothy ruttish clouted common-kissing pignutted
  30 folly-fallen plume-plucked flap-mouthed swag-bellied dizzy-eyed
  31 gorbellied weedy reeky measled spur-galled mangled impertinent
  32 bootless toad-spotted hasty-witted horn-beat yeasty
  33 imp-bladdereddle-headed boil-brained tottering hedge-born
  34 hugger-muggered elf-skinned Microsoft-loving );
  35
  36 our @amounts = qw( accumulation bucket coagulation enema-bucketful gob
  37 half-mouthful heap mass mound petrification pile puddle stack
  38 thimbleful tongueful ooze quart bag plate ass-full assload );
  39
  40 our @nouns = ('bat toenails', 'bug spit', 'cat hair', 'chicken piss',
  41 'dog vomit', 'dung', 'fat woman\'s stomach-bile', 'fish heads',
  42 'guano', 'gunk', 'pond scum', 'rat retch', 'red dye number-9',
  43 'Sun IPC manuals', 'waffle-house grits', 'yoo-hoo', 'dog balls',
  44 'seagull puke', 'cat bladders', 'pus', 'urine samples', 'squirrel guts',
  45 'snake assholes', 'snake bait', 'buzzard gizzards', 'cat-hair-balls',
  46 'rat-farts', 'pods', 'armadillo snouts', 'entrails', 'snake snot',
  47 'eel ooze', 'slurpee-backwash', 'toxic waste', 'Stimpy-drool',
  48 'poopy', 'poop', 'craptacular carpet droppings', 'jizzum',
  49 'cold sores', 'anal warts', 'IE user');
  50
  51 sub Help {
  52     my $self = shift;
  53     my ($event) = @_;
  54     return {
  55         '' => 'Generate insults on the fly, for when you\'re too lazy to invent some yourself.',
  56         'insult' => 'Insults someone. Syntax: \'insult <who>\'',
  57     };
  58 }
  59
  60 # RegisterConfig - Called when initialised, should call registerVariables
  61 sub RegisterConfig {
  62     my $self = shift;
  63     $self->SUPER::RegisterConfig(@_);
  64     $self->registerVariables(
  65       # [ name, save?, settable? ]
  66       ['insultOverrides', 1, 1, { # overrides for the insults (keys must be lowercase)
  67            '' => '%source: exactly how stupid do you think i am?',
  68            'yourself' => '%source: nice try, fool',
  69            'urself' => '%source: at least learn to spell, you moronic noodle',
  70            'mozilla' => '%target: You are nothing but the best browser on the planet.',
  71            'mozilla.org' => '%target: You are nothing but the best caretaker Mozilla ever had.',
  72            'c++' => '%target: you are evil',
  73        }],
  74     );
  75 }
  76
  77 sub Told {
  78     my $self = shift;
  79     my ($event, $message) = @_;
  80     if ($message =~ /^\s*(?:will\s+you\s+)?(?:insult|harass)\s+(\S+?)(?:[\s,.]+please)?[\s.?!]*$/osi) {
  81         my $who = $1;
  82         my $line;
  83
  84         if (lc $who eq 'me') {
  85           $who = $event->{'from'};
  86         }
  87
  88         my $me = quotemeta($event->{'nick'});
  89         if ($who =~ m/^$me$/si and
  90             defined $self->{'insultOverrides'}->{''}) {
  91             $line = $self->{'insultOverrides'}->{''};
  92         } elsif (defined $self->{'insultOverrides'}->{lc $who}) {
  93             $line = $self->{'insultOverrides'}->{lc $who};
  94         } else {
  95             $line = $who . ': ' . $self->generateInsult();
  96         }
  97         $line =~ s/%source/$event->{'from'}/gos;
  98         $line =~ s/%target/$who/gos;
  99         $self->sayOrEmote($event, $line);
 100     } else {
 101         return $self->SUPER::Told(@_);
 102     }
 103     return 0; # we've dealt with it, no need to do anything else.
 104 }
 105
 106 sub generateInsult {
 107     my $self = shift;
 108     #
 109     # Insults are formed by making combinations of:
 110     #
 111     #    You are nothing but a(n) {adj} {amt} of {adj} {noun}
 112     #
 113     my $adj1 = $self->rand_idx(\@adjectives);
 114     my $adj2; # musn't be the same as $adj1
 115     my $count = @adjectives;
 116     if ($count > 1) {
 117         my $index = int(rand($count));
 118         if ($adjectives[$index] eq $adj1) {
 119             ++$index;
 120             $index = 0 if $index >= $count;
 121         }
 122         $adj2 = $adjectives[$index];
 123     } else {
 124         $adj2 = 'err... of... some';
 125     }
 126     my $amnt = $self->rand_idx(\@amounts);
 127     my $noun = $self->rand_idx(\@nouns);
 128     my $an = $adj1 =~ m/^[aeiou]/ois ? 'an' : 'a';
 129     return "You are nothing but $an $adj1 $amnt of $adj2 $noun.";
 130 }
 131
 132 sub rand_idx {
 133     my $self = shift;
 134     my($array) = @_;
 135     return $array->[int(rand(@$array))];
 136 }