view release on metacpan or  search on metacpan

lib/Bot/BasicBot/Pluggable/Module/Nickometer.pm  view on Meta::CPAN

package Bot::BasicBot::Pluggable::Module::Nickometer;

use strict;
use Bot::BasicBot::Pluggable::Module; 
use base qw(Bot::BasicBot::Pluggable::Module);


use Math::Trig;

sub said { 
    my ($self, $mess, $pri) = @_;

    my $body = $mess->{body}; 
    my $who  = $mess->{who};

    return unless ($pri == 2);
    return unless  $body =~ /^\s*(?:lame|nick)-?o-?meter(?: for)? (\S+)/i;

    my $term = $1; $term = $who if (lc($term) eq 'me');

    
    my $percentage = percentage($term);
    

    if ($percentage =~ /NaN/) {
           $percentage = "off the scale";
    } else {
        #    $percentage = sprintf("%0.4f", $percentage);
        $percentage =~ s/\.0+$//;
        $percentage .= '%';
    }
    
    return "'$term' is $percentage lame, $who";
}

sub help {
    return "Commands: 'nickometer <nick>'";
}


sub percentage {
    local $_ = shift;

    my $score = 0;
    
    # Deal with special cases (precede with \ to prevent de-k3wlt0k)
    my %special_cost = (
                      '69'                      => 500,
                      'dea?th'                  => 500,
                      'dark'                    => 400,
                      'n[i1]ght'                => 300,
                      'n[i1]te'                 => 500,
                      'fuck'                    => 500,
                      'sh[i1]t'                 => 500,
                      'coo[l1]'                 => 500,
                      'kew[l1]'                 => 500,
                      'lame'                    => 500,
                      'dood'                    => 500,
                      'dude'                    => 500,
                      '[l1](oo?|u)[sz]er'       => 500,
                      '[l1]eet'                 => 500,
                      'e[l1]ite'                => 500,
                      '[l1]ord'                 => 500,
                      'pron'                    => 1000,
                      'warez'                   => 1000,
                      'xx'                      => 100,
                      '\[rkx]0'                 => 1000,
                      '\0[rkx]'                 => 1000,
                     );



    foreach my $special (keys %special_cost) {
        my $special_pattern = $special;
        my $raw = ($special_pattern =~ s/^\\//);
        my $nick = $_;
          $nick =~ tr/023457+8/ozeasttb/ unless $raw;
        $score += $special_cost{$special} if $nick =~ /$special_pattern/i;
      }
  
      # Allow Perl referencing
      s/^\\([A-Za-z])/$1/;
  
      # Keep me safe from Pudge ;-)
      s/\^(pudge)/$1/i;