root/veekun/trunk/lib/Vee/Bot.pm

package Vee::Bot;

use strict;
use warnings;

use YAML;
use Vee::Schema;
use Vee::Dex;

# initialize database stuff, being careful not to get caught by reload
our $schema;
our $conf;
unless (defined $schema) {
    $conf = YAML::LoadFile('vee.yml');
    $schema = Vee::Schema->connect( @{ $conf->{'Model::DBIC'}{connect_info} }[0 .. 2] );
    REPLACEME("Connected to database");
    Vee::Dex::initialize($schema);
    REPLACEME("Loaded Pokedex variables");
}

# TODO: regexes if needed
our %command_map = (
    reload  => \&do_reload,
    dex     => \&do_pokedex,
    ivs     => \&do_ivcalc,
    eval    => \&do_eval,
    can     => \&do_can,
);

# ------------------------------------------------------------------------------

# Dispatch to various other subs, depending on what input we just got
sub dispatcher {
    my ($in) = @_;
 
    my ($command, $rest) = split /\s+/, $in, 2;
    my $reply;

    return unless $command_map{$command};

    my $ret = eval { 
        return $command_map{$command}->($rest);
    };

    if ($@) {
        warn $@;
        return "Flagrant error!  Sorry.";
    }

    return $ret;
}

# ------------------------------------------------------------------------------
# Pokedex lookup

sub do_pokedex {
    my ($entry) = @_;

    my $hashref = $FuzzyMatches{ lc $entry };

    if (not $hashref) {
        return "No Pokedex entry for $entry!";
    }

    if ($hashref->{type} eq 'pokemon') {
        my $pokemon = $schema->resultset('Pokemon')->find($hashref->{id});
        return
            sprintf "Pokémon number %d, %s.  Type: %s.  Abilities: %s.",
            $pokemon->id, $pokemon->name, $pokemon->type1 . ($pokemon->type2 && '/'.$pokemon->type2),
            join(' and ', map { $_->name } $pokemon->abilities);

    } elsif ($hashref->{type} eq 'ability') {
        my $ability = $schema->resultset('Abilities')->find($hashref->{id});
        return sprintf "%s: %s",
            $ability->name, $ability->description;

    } else {
        return "$hashref->{name} is $hashref->{type} number $hashref->{id}.";
    }
}

# ------------------------------------------------------------------------------
# Little IV calculator
# Code stolen and simplified from V::C::Dex::Utils

sub do_ivcalc {
    my ($entry) = @_;

    my ($nature, $pokemon_name, $level, $stats) = ($entry =~ /^
        for     \s+
        (\w+)   \s+
        (.+?)   \s+
        at      \s+
        l(?: evel \s+ )?
        (\d+)   \s+
        with
        ( (?: \s+ \d+ (?: \+ \d+ )? ){6} )
    $/ix);

    if (not defined $nature) {
        # didn't match
        return "Syntax for that command is 'ivs for {nature} {pokemon} " .
               "at level {level} with {hp} {atk} {def} {spatk} {spdef} {spd}'.  " .
               "You may specify EVs as +{effort} immediately after a stat.";
    }

    # I cheat here and use the special ' ' delimeter to avoid the leading empty
    # string I'd get otherwise.  It IS documented, trust me.
    my (@stats, @evs);
    for my $stat_string (split ' ', $stats) {
        my ($iv, $ev) = split /\+/, $stat_string;
        push @stats, $iv;
        push @evs,   $ev || 0;
    }

    my $pokemon_id = get_pokemon($pokemon_name)
        or return "No such Pokemon.";
    my $pokemon = $schema->resultset('Pokemon')->find($pokemon_id);

    if ($nature ne 'neutral' and not exists $Natures{$nature}) {
        return "No such nature.";
    }
    if ($level < 1 or $level > 100 or $level ne int $level) {
        return "Invalid level.";
    }

    # Actual calculation past here...

    my @nature_changes = (1) x @StatColumns;
    if (defined $Natures{$nature}) {
        $nature_changes[ $Natures{$nature}{up}   ] = 1.1;
        $nature_changes[ $Natures{$nature}{down} ] = 0.9;
    }

    my @ivs;
    for my $s (0 .. $#StatColumns) {
        my $stat = $StatColumns[$s];
        my $base = $pokemon->$stat;
        my $func = ($stat =~ /hp/) ? \&ingame_hp : \&ingame_stats;

        # This is longer but faster; grab just the endpoints
        my ($min, $max);
        for my $iv (0 .. 31) {
            my $calculated = $func->($base, $level, $iv, $evs[$s]);
            $calculated = int( $calculated * $nature_changes[$s] );
            if ($calculated == $stats[$s]) {
                $min = $iv;
                last;
            }
        }
        if (not defined $min) {
            $ivs[$s] = 'impossible';
            next;
        }

        for my $iv (reverse $min .. 31) {
            my $calculated = $func->($base, $level, $iv, $evs[$s]);
            $calculated = int( $calculated * $nature_changes[$s] );
            if ($calculated == $stats[$s]) {
                $max = $iv;
                last;
            }
        }
        if (not defined $max) {
            $ivs[$s] = 'impossible';
            next;
        }

        if ($min == $max) {
            $ivs[$s] = $min;
        } else {
            $ivs[$s] = [ $min, $max ];
        }
    }
    
    for my $s (0 .. $#StatColumns) {
        my $display = ref $ivs[$s] ? "$ivs[$s][0] - $ivs[$s][1]" : $ivs[$s];
        $ivs[$s] = "$StatShortNames[$s]: $display";
    }

    return join ' | ', @ivs;
}

# ------------------------------------------------------------------------------
# Test if a Pokemon can get a move
# can {pokemon} [learn] {move}

sub do_can {
    my ($entry) = @_;

    my ($pokemon_in, $move_in, $ver) = ($entry =~ /^(.+) learn (.+?)(?: in (\w+))?$/);
    my $pokemon_id = get_pokemon($pokemon_in);
    return "'$pokemon_in' is not a Pokemon." if not defined $pokemon_id;
    return $$pokemon_id if ref $pokemon_id;
    my $move_id    = get_move($move_in);
    return "'$move_in' is not a move." if not defined $move_id;
    return $$move_id if ref $move_id;

    # lol validation?
    if ($ver) {
        $ver =~ tr/a-z//cd;
    } else {
        $ver = 'dp';
    }

    my @pm = $schema->resultset('PokemonMoves')->search({
        pokemon_id => $pokemon_id,
        move_id    => $move_id,
        -nest      => \ "FIND_IN_SET('$ver', versions)",
    });

    if (@pm) {
        my %pm_map = map { $_->method => $_ } @pm;
        my @methods;
        if ($pm_map{level}) {
            push @methods, 'at level ' . $pm_map{level}->level;
        }
        if ($pm_map{egg}) {
            push @methods, 'via breeding';
        }
        if ($pm_map{machine}) {
            push @methods, 'from ' . tm_name( $MoveTMs{$move_id}[3] );
        }
        if ($pm_map{tutor}) {
            push @methods, 'from a move tutor';
        }
        return 'Yes: ' . join(', or ', @methods) . '.';
    }

    return "No.";
}

# ------------------------------------------------------------------------------
# Arbitrary code evaluation -- ENABLE WITH CAUTION

sub do_eval {
    my ($code) = @_;

    return "Lol no.";
}

# ------------------------------------------------------------------------------
# Reloader

sub do_reload {
    # muffle redef warnings
    local $SIG{__WARN__} = sub {
        warn "$_[0]" unless $_[0] =~ /^Subroutine .+ redefined/;
    };

    # pretend we haven't seen ourselves and require ourselves
    (my $filename = __PACKAGE__) =~ s|::|/|g;
    $filename .= '.pm';
    delete $INC{$filename};
    require $filename;

    # count the number of reloaded subroutines...  here be dragons
    my $pkg_ref;
    {
        no strict 'refs';
        $pkg_ref = \%{__PACKAGE__ . '::'};
    }
    my $sub_ct = grep {
        /^do_/ and defined *{ $pkg_ref->{$_} }{CODE}
    } keys %$pkg_ref;
    # end dragons

    return "Reloaded $sub_ct command@{[ $sub_ct > 1 && 's' ]}.";
}

# this needs to be a real logger or something
sub REPLACEME {
    warn shift;
}


1;