root/veekun/trunk/lib/Vee/Schema/Pokemon.pm @ 350

package Vee::Schema::Pokemon;

use strict;
use warnings;
use base 'DBIx::Class';

=head1 NAME

Vee::Schema::Pokemon - DBIC class for the C<pokemon> table

=cut

__PACKAGE__->load_components('Core');
__PACKAGE__->table('pokemon');
__PACKAGE__->add_columns(qw/
    id
    id_johto
    id_hoenn
    id_sinnoh

    name
    alt_form
    name_jp
    name_romaji

    evid
    evparent
    evmethod
    evparam

    height
    weight
    type1
    type2
    species
    color
    habitat

    stat_at
    stat_de
    stat_sa
    stat_sd
    stat_sp
    stat_hp

    effort
    oldgs
    caprate
    baseexp
    gender
    happiness
    root
    eventred
    eventblue
    notes
    flags
    real_id
/);
__PACKAGE__->set_primary_key('id');

__PACKAGE__->belongs_to(evchain => 'Vee::Schema::EvChains', 'evid');
__PACKAGE__->has_many(pokemoves => 'Vee::Schema::PokeMoves', 'pokeid');
__PACKAGE__->has_many(flavors => 'Vee::Schema::FlavorText', 'pokeid');
__PACKAGE__->has_many(encounters => 'Vee::Schema::LocationEncounters', 'pokemon_id');
__PACKAGE__->has_many(breeds => 'Vee::Schema::PokemonBreeds', 'pokeid');

__PACKAGE__->has_many(pokemon_abilities => 'Vee::Schema::PokemonAbilities', 'pokeid', { order_by => 'slot ASC' });
__PACKAGE__->many_to_many(abilities => 'pokemon_abilities', 'ability');

__PACKAGE__->has_many(pokemon_items => 'Vee::Schema::PokemonItems', 'pokemon_id');
__PACKAGE__->many_to_many(items => 'pokemon_items', 'item');

__PACKAGE__->might_have(parent => 'Vee::Schema::Pokemon', 'evparent');
__PACKAGE__->has_many(descendants => 'Vee::Schema::Pokemon', 'evparent');

=head1 METHODS

=head2 can_breed

Returns true if this Pokemon can breed, false otherwise.

=cut

sub can_breed {
    my ($self) = @_;

    return not grep { $_ == 15 } $self->breeding_groups;
}

=head2 can_breed

Returns a list of egg group codes.

=cut

# TODO: rename this 'breeds' and rename the above join
sub breeding_groups {
    my ($self) = @_;
    return map { $_->breed } $self->breeds;
}

=head2 can_breed

Returns the in-game breeding code for this Pokemon.

=cut

sub breeding_code {
    my ($self) = @_;
    my @breeds = sort $self->breeding_groups;
    @breeds = (@breeds) x 2 if @breeds == 1;  # need two digits!

    return $breeds[0] * 16 + $breeds[1];
}

=head2 can_breed_with($pokemon)

Returns true if this Pokemon can breed with the given Pokemon, false otherwise.

=cut

sub can_breed_with {
    my ($poke1, $poke2) = @_;
    my %breeds;

    # Egg groups cannot appear twice due to keying, so this is guaranteed to
    # work
    $breeds{$_}++ for $poke1->breeding_groups, $poke2->breeding_groups;
    delete $breeds{15};

    # Compatible if at least one egg group appears twice
    return grep { $_ > 1 } values %breeds;
}

=head1 SEE ALSO

L<Vee::Schema>, L<DBIx::Class>

=head1 AUTHOR

Maintainer: Alex "Eevee" Munroe (C<veekun@veekun.com>)

See the included F<AUTHORS> file for a full list of contributers.

=head1 LICENSE

See the included F<LICENSE> file.

=cut

1;