gecko-dev/webtools/mozbot/BotModules/Insult.bm

################################
# 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 <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)
           '' => '%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))];
}