root/veekun/trunk/lib/Vee/Controller/Dex.pm @ 406

Revision 406, 45.5 KB (checked in by eevee, 22 months ago)

Database refactoring. Renamed columns and tables to be more consistent and more readable. (#58)
Line 
1package Vee::Controller::Dex;
2
3use strict;
4use warnings;
5use base 'Catalyst::Controller';
6
7use Vee::Dex;
8use String::Approx 'adist';
9use JSON;
10use Scalar::Util qw/weaken/;
11use List::Util qw/first min max sum/;
12use List::MoreUtils qw/uniq/;
13use Storable qw/dclone/;
14use Data::Dumper;
15
16# TODO: move this somewhere shared
17my $MAX_WILDCARD_RESULTS = 10;  # maximum wildcard matches per category
18my $MAX_LEARNERS = 50;  # maximum learners per method on a move page
19
20=head1 NAME
21
22Vee::Controller::Dex - Pokedex Controller
23
24=head1 SYNOPSIS
25
26See L<Vee>
27
28=head1 DESCRIPTION
29
30Catalyst Controller for Pokedex lookup, pages, and listings.
31
32=cut
33
34=head1 METHODS
35
36=cut
37
38=head2 auto
39
40Injects the hash of useful Pokedex variables into the stash for TT use.
41
42=cut
43
44sub auto : Private {
45    my ($self, $c) = @_;
46    my $s = $c->stash;
47   
48    $s->{extra_css} = ['dex'];
49    $s->{nav}{help} = $c->uri_for('/dex');
50
51    # TODO: kinda hacky!  move this elsewhere, where it won't leak?
52    weaken $c;
53    $s->{dex_uri} = sub { $_[1] = lc $_[1] unless ref $_[1]; $c->uri('Dex', @_) };
54
55    $c->stash( %Vee::Dex::all );
56
57    return 1;
58}
59
60=head2 lookup
61
62=cut
63
64sub lookup_path : Path('lookup') : Args(1) {
65    my ($self, $c) = @_;
66    $c->detach('lookup');
67}
68
69sub lookup : Path : Args(0) {
70    my ($self, $c) = @_;
71
72    my $entry;
73    if ($c->req->args->[0]) {
74        # /dex/Eevee
75        $entry = $c->req->args->[0];
76    } elsif (exists $c->req->params->{entry}) {
77        # /dex?entry=Eevee
78        $entry = $c->req->params->{entry};
79    } elsif (scalar (keys %{$c->req->query_parameters}) == 0 && $ENV{QUERY_STRING}) {
80        # /dex?Eevee
81        # TODO: not sure I even like this; possibly remove it (or do a redirect) since path works
82        $entry = $ENV{QUERY_STRING};
83    }
84
85    # if this was reached by just /dex, then skip to the static code
86    if (not defined $entry) {
87        $c->detach(
88            '/default',
89            [ $self->action_namespace($c), @{ $c->req->args } ]
90        );
91    # ...or berate the user
92    } elsif (not $entry) {
93        $c->vee_abort('Please enter a Pok&eacute;mon, move, type, etc to look up.');
94    }
95
96    # easter egg
97    if ($entry =~ /^annon (.+)$/) { $c->detach('egg_annon', [ $1, 'icons' ]) }
98    if ($entry =~ /^ANNON (.+)$/) { $c->detach('egg_annon', [ $1, 'dp' ]) }
99
100    # branch if wildcards detected
101    if ($entry =~ /[?*]/) {
102        $c->detach('lookup_wildcard', [ $entry ]);
103    }
104
105    # some special possibilities
106    if    ($entry =~ /^tm ?(\d{1,2})$/i) { $c->res->redirect( $c->uri('Dex', 'tms', $1      ) ); return }
107    elsif ($entry =~ /^hm ?(\d{1,2})$/i) { $c->res->redirect( $c->uri('Dex', 'tms', $1 + 100) ); return }
108    elsif ($entry =~ /^random(?: (pokemon|move|type))?$/i) {
109        my $type = $1 || 'pokemon';
110        my $url = $c->uri('Dex', plural($type), 'random');
111        $url .= '/' . $c->session->{last_pokemon_view}
112            if $type eq 'pokemon'
113            and $c->session->{last_pokemon_view};
114        $c->res->redirect($url);
115        return;
116    }
117
118    # the usual suspects
119    # we have this giant hash of possible fuzzy matches lying around, so why not use it?
120    my $fuzzy_value = $FuzzyMatches{ lc $entry };
121    if ($fuzzy_value) {
122        my $url = $c->uri('Dex', plural($fuzzy_value->{type}), lc $fuzzy_value->{name});
123        $url .= '/' . $c->session->{last_pokemon_view}
124            if $fuzzy_value->{type} eq 'pokemon'
125            and $c->session->{last_pokemon_view};
126        $c->res->redirect($url);
127        return;
128    }
129
130    # if that didn't work, use the accessor functions...
131    my $result;
132    for my $class (qw/pokemon move type/) {
133        no strict 'refs';
134        $result = &{"get_$class"}($entry);
135        use strict 'refs';
136        next unless $result;
137
138        if (ref $result eq 'SCALAR') {
139            $c->vee_abort('"', $entry, qq'" is an invalid query.  $$result');
140        }
141
142        my ($name, $suffix);
143        if ($class eq 'pokemon') {
144            $name = lc $PokemonNames[$result];
145            $suffix = '/' . $c->session->{last_pokemon_view} if $c->session->{last_pokemon_view};
146        } elsif ($class eq 'move') {
147            $name = lc $MoveData[$result]->name;
148        } else {
149            $name = $result;
150        }
151
152        $c->res->redirect( $c->uri('Dex', plural($class), $name) . $suffix );
153        return;
154    }
155   
156    # STILL nothing
157    if (!$result) {
158        $c->detach('lookup_fuzzy', [ $entry ]);
159    }
160   
161}
162
163=head2 lookup_wildcard
164
165Searches through names using wildcards.
166
167=cut
168
169sub lookup_wildcard : Private {
170    my ($self, $c, $entry) = @_;
171    my $s = $c->stash;
172   
173    $s->{page_title} = 'Wildcard Lookup';
174    $s->{crumbs}     = [ '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>', 'Wildcard Lookup' ];
175   
176    (my $test = $entry) =~ s/[^-_ 0-9a-zA-Z]//g;
177    if (2 > length $test) {
178        $c->vee_abort('Your entry ', $entry, ' is too vague.  Please try to tone down the use of wildcards.');
179        die;
180    }
181   
182    my $orig = $entry;
183
184    # cleanse all special characters and change ?/* to regex notation
185    $entry =~ s/([^-_ 0-9a-zA-Z])/\\$1/g;
186    $entry =~ s/\\\?/./g;
187    $entry =~ s/\\\*/.*/g;
188
189    my $re = qr/^$entry$/i;
190    my (%results, %overflow);
191   
192    # Arrange the results by type
193    my @keys = grep { $_ =~ $re } keys %FuzzyMatches;
194    for my $key (@keys) {
195        my $type  = $FuzzyMatches{$key}{type};
196        my $array = ($results{$type} ||= []);
197
198        push @$array, $FuzzyMatches{$key};
199    }
200
201    # Sort by name, for lack of anything particularly better
202    for my $type (keys %results) {
203        my $array = $results{$type};
204        @$array = sort {
205            $a->{name} cmp $b->{name}
206        } @$array;
207
208        # Don't go crazy listing matches
209        if (@$array > $MAX_WILDCARD_RESULTS) {
210            @$array = @$array[ 0 .. $MAX_WILDCARD_RESULTS - 1 ];
211            $overflow{$type} = 1;
212        }
213    }
214
215    my $total = @keys;
216    $c->vee_stop('No match for ', $orig, ' was found.  You may wish to try the <a href="' . $c->uri('Dex', 'pokemon_list') . '">Pok&eacute;mon list</a>, <a href="' . $c->uri('Dex', 'move_list') . '">move list</a>, <a href="' . $c->uri('Dex', 'type_list') . '">type list</a>, etc. to find what you are looking for.') unless $total;
217   
218    $s->{entry}    = $orig;
219    $s->{results}  = \%results;
220    $s->{overflow} = \%overflow;
221    $s->{template} = 'dex/lookup/wildcard.tt';
222}
223
224=head2 lookup_fuzzy
225
226Fuzzy search for when all else fails.
227
228=cut
229
230sub lookup_fuzzy : Private {
231    my ($self, $c, $entry) = @_;
232    my $s = $c->stash;
233   
234    $s->{page_title} = 'Fuzzy Lookup';
235   
236    if (4 > length $entry) {
237        $c->vee_stop('There is nothing in the database with a name of ', $entry, ', and fuzzy lookup can only be done with between four and twenty-four characters.');
238    }
239   
240    my @results = get_fuzzy($entry);
241
242    if (!@results) {
243        $c->vee_stop('No match for ', $entry, ' was found.  You may wish to try the <a href="' . $c->uri('Dex', 'pokemon_list') . '">Pok&eacute;mon list</a>, <a href="' . $c->uri('Dex', 'move_list') . '">move list</a>, or <a href="' . $c->uri('Dex', 'type_list') . '">type list</a> to find what you are looking for.');
244    }
245
246    # check to see if we only got one real result, regardless of how many languages it's in
247    my @uniques = uniq map { join "\n", @$_{qw/ type id /} } @results;
248    if (@uniques == 1) {
249        $c->flash->{info_msg} = 'You entered ' . $c->vee_cleanse($entry) . ", but there is no page with that name.  This page is the only close match.";
250        $c->res->redirect( $c->uri('Dex', plural( $results[0]{type} ), lc $results[0]{name}) );
251        return;
252    }
253
254    @results = @results[0 .. 19] if @results > 20;
255
256    $s->{entry} = $c->vee_cleanse($entry);
257    $s->{results} = \@results;
258    $s->{template} = 'dex/lookup/fuzzy.tt';
259}
260
261################################################################################
262
263=head2 ability_list
264
265=cut
266
267sub ability_list : Path('abilities') : Args(0) {
268    my ($self, $c) = @_;
269    my $s = $c->stash;
270   
271    $s->{page_title} = 'Ability List';
272    $s->{crumbs}     = [ '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>', 'Abilities' ];
273
274    $s->{template} = 'dex/list/abilities.tt';
275    $c->forward('/cache');
276
277    $s->{abilities_rs} = $c->model('DBIC::Abilities')->search({
278        'me.id' => { '<' => 200 },
279    }, {
280        order_by  => 'me.id ASC',
281        group_by  => 'me.id',
282        join      => 'pokemon_abilities',
283        '+select' => 'COUNT(DISTINCT pokemon_abilities.pokemon_id)',
284        '+as'     => 'pokemon_count',
285    });
286}
287
288=head2 abilities
289
290=cut
291
292sub abilities : Local : Args(1) {
293    my ($self, $c, $abil_name) = @_;
294    my $s = $c->stash;
295
296    my $row = $c->model('DBIC::Abilities')->find({ name => $abil_name })
297        or $c->vee_abort('No such ability ', $abil_name, '.');
298   
299    $s->{page_title} = $row->name . ' - Ability #' . $row->id;
300    $s->{crumbs}     = [
301        '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>',
302        '<a href="' . $c->uri('Dex', 'ability_list') . '">Abilities</a>',
303        $row->name,
304    ];
305
306    add_rel_links( $c,
307        ($row->id - 2) % $#AbilityNames + 1,
308        ($row->id + 0) % $#AbilityNames + 1,
309        sub { {
310            id    => $_[0],
311            title => $AbilityNames[ $_[0] ],
312            url   => $c->uri('Dex', 'abilities', lc $AbilityNames[ $_[0] ]),
313        } }
314    );
315
316    $s->{template} = 'dex/page/ability.tt';
317#    $c->forward('/cache'); -- TODO: necessary?
318
319    $s->{this}       = $row;
320    $s->{generation} = $row->id <= 76 ? 2 : 3;  # TODO: better
321
322    $s->{pokemon}    = [
323        $row->pokemon(undef, { distinct => 1, order_by => 'name' })
324    ];
325}
326
327################################################################################
328
329=head2 tm_list
330
331=cut
332
333sub tm_list : Path('tms') : Args(0) {
334    my ($self, $c) = @_;
335   
336    $c->stash->{page_title} = 'TM List';
337    $c->stash->{crumbs}     = [ '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>', 'TMs' ];
338
339    $c->stash->{template}   = 'dex/list/tms.tt';
340    $c->forward('/cache', [ $c->req->params->{gen} ]);
341}
342
343=head2 tms
344
345=cut
346
347sub tms : Local : Args(1) {
348    my ($self, $c) = @_;
349    my $s = $c->stash;
350
351    my $id = $c->req->args->[0];
352    my @tms = $c->model('DBIC::Machines')->search({ id => $id });
353   
354    # check to see if there is only one move, ever, that corresponds to this TM
355    my %set = map { $_->move_id => 1 } @tms;
356
357    if (!@tms) {
358        $c->vee_abort('There is no TM with a number of ', $id, '.  If you were looking for an HM, they have 100 added to the numbers.');
359    } elsif (1 == scalar keys %set) {
360        # TODO: remove this?
361        $c->res->redirect( $c->uri('Dex', 'moves', lc $MoveData[ $tms[0]->move_id ]->name) );
362    }
363
364    $s->{page_title} = tm_name($id);
365    $s->{crumbs}     = [
366        '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>',
367        '<a href="' . $c->uri('Dex', 'tm_list') . '">TMs</a>',
368        tm_name($id),
369    ];
370
371    $s->{tm_id} = $id;
372    $s->{tms} = \@tms;
373
374    $s->{template} = 'dex/page/tm.tt';
375}
376
377################################################################################
378
379=head2 pokemon_list
380
381=cut
382
383my @pokemon_lists = ( 0 .. $#Generations, qw/ national johto hoenn sinnoh / );
384
385sub pokemon_list : Path('pokemon') : Args(0) {
386    my ($self, $c) = @_;
387    my $s = $c->stash;
388   
389    my $gen = $c->req->params->{gen};
390    if (not defined $gen or not Vee::Utils::in($gen => @pokemon_lists)) {
391        $gen = $#Generations;
392    }
393    $s->{gen} = $gen;
394
395    $s->{page_title} = 'Pok&eacute;mon List';
396    $s->{crumbs}     = [ '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>', 'Pok&eacute;mon' ];
397
398    $s->{template} = 'dex/list/pokemon.tt';
399    $c->forward('/cache', [ $gen ]);
400
401    my (%query, @extra_order, %search_params);
402    if (Vee::Utils::isnum($gen)) {
403        %query = (
404            'pokemon.id' => {
405                -between => [
406                    ($gen ? $Generations[$gen - 1]{maxid} : 0) + 1,
407                    $Generations[$gen]{maxid}
408                ]
409            },
410        );
411        $s->{dim} = sub {
412            $gen != ( grep { $Generations[$_]{maxid} >= $_[0]->id } 0 .. $#Generations )[0]
413        };
414        %search_params = ( generation => $gen );
415    } elsif ($gen eq 'national') {
416        # no limiting, nothing dimmed
417        $s->{dim} = sub { 0 };
418
419        # teensy hack to force a search for everything
420        %search_params = ( sort => 'id' );
421    } else {
422        # belongs in this dex iff it has a number for this gen
423        my $col = "id_$gen";
424        %query  = (
425            "pokemon.$col" => { '!=', 0 },
426        );
427        $s->{dim} = sub {
428            not $_[0]->$col
429        };
430
431        # sort by the base's regional id first, which will get them in the right
432        # chain order for this region, and then let the normal id sorting sort
433        # them within each chain
434        @extra_order = "MIN(pokemon.$col) ASC";
435
436        # grab the gen number from @Generations
437        %search_params = (
438            basedex => grep {
439                $gen eq lc $Generations[$_]{region}
440            } 1 .. $#Generations
441        );
442
443        $s->{region_column} = $col;
444    }
445
446    $s->{search_params} = \%search_params;
447
448    # in this query:
449    #   'pokemon' is a *join* that lists Pokemon from the selected generation
450    #   'me' is the table we are selecting from, listing Pokemon related to any from 'pokemon'
451    $s->{pokemon_rs} = $c->model('DBIC::Pokemon')->search({
452        'me.id'      => { '<=', $Generations[-1]{maxid} },
453        %query,
454    }, {
455        join     => { evo_chain => 'pokemon' },
456        prefetch => { pokemon_abilities => 'ability' },
457        group_by => [ 'me.id', 'pokemon_abilities.ability_id' ],
458        order_by => [ @extra_order, "pokemon.id ASC", "FIND_IN_SET('baby', me.flags) DESC", 'me.id ASC' ],
459    });
460}
461
462=head2 pokemon
463
464=cut
465
466# order of games; only used in move table really, otherwise it would be in Vee::Dex
467my %column_order;
468{
469    my $i = -1;
470    %column_order = map { $i++; $_ => $i } qw/rb y gs c rusa frlg dp/;
471}
472
473sub pokemon : Local : Args(1) {
474    my ($self, $c) = @_;
475    my $s = $c->stash;
476
477    # TODO: hm this kinda blows; give up on get_row imo
478    my $row = get_row($c, 'Pokemon', undef, $c->req->params->{alt_form});
479    # TODO: log these in case the links are my fault
480    $c->vee_abort('There is no such Pok&eacute;mon ', $c->req->args->[0], '.  If you are messing with my URLs, please stop.  If you came here via a link, please inform its owner that it is invalid.') unless $row;
481
482    delete $c->session->{last_pokemon_view};
483
484    $s->{page_title}  = $row->name . ' - Pok&eacute;mon #' . $row->real_pokemon_id;
485    $s->{page_header} = $row->name;
486    $s->{extra_js}    = ['dexutils'];
487    $s->{link_name}   = 'dex';
488    $s->{crumbs}      = [
489        '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>',
490        '<a href="' . $c->uri('Dex', 'pokemon_list') . '">Pok&eacute;mon</a>',
491        $row->name,
492    ];
493
494    add_rel_links( $c,
495        ($row->id - 2) % $Generations[-1]{maxid} + 1,
496        ($row->id + 0) % $Generations[-1]{maxid} + 1,
497        sub { {
498            id    => $_[0],
499            title => $PokemonNames[ $_[0] ],
500            url   => $c->uri('Dex', 'pokemon', lc $PokemonNames[ $_[0] ]),
501        } }
502    );
503
504    $s->{template} = 'dex/page/pokemon.tt';
505    $c->forward('/cache', [ $row->id ]);
506
507    $s->{this}       = $row;
508    $s->{pid}        = Vee::Utils::pad($row->id, 3);
509    $s->{generation} = my $generation = ( grep { $Generations[$_]{maxid} >= $row->real_pokemon_id } 0 .. $#Generations )[0];
510
511    # alt forms
512    if ($row->alt_form) {
513        my @alts;
514        my $alt_rs = $c->model('DBIC::Pokemon')->search({
515            real_pokemon_id  => $row->real_pokemon_id,
516        }, {
517            columns  => ['alt_form'],
518            order_by => 'id',
519        });
520        while (my $alt_row = $alt_rs->next) {
521            push @alts, $alt_row->alt_form;
522        }
523        $s->{alternate_forms} = \@alts;
524    }
525       
526    # evolution chain
527    my @family = $row->evo_chain->pokemon( \'id = real_pokemon_id', { columns => [qw/id evo_parent_id evo_method evo_param/] } );
528    my %evtrees;
529    $evtrees{$_->id} = { id => $_->id, parent => $_->evo_parent_id, method => $_->evo_method, param => $_->evo_param, children => [] } for @family;
530    push @{ $evtrees{ $_->{parent} }{children} }, $_ for sort { $a->{id} <=> $b->{id} } grep { $_->{parent} } values %evtrees;
531    for my $node (values %evtrees) { add_evolution_desc($node, $row->evo_chain) }
532    $s->{evtree} = ( grep { !$_->{parent} } values %evtrees )[0];  # should only be one with no parent: the root
533    calculate_tree_width($s->{evtree});
534
535    # type effectiveness
536    $s->{type_effects} = { map { $_ => type_effect($_, $row->type1, $row->type2) } @TypeNames };
537
538    # statistics
539    calculate_stats($c, $row);
540   
541    # breeding
542    my $compat_rs = $c->model('DBIC::Pokemon')->search({
543        'breeds.breed' => [ map { $_->breed } $row->breeds ], 
544    }, {
545        join     => 'breeds',
546    });
547    $s->{compatibility}{all}  = $compat_rs->count;
548    # TODO: this is actually wrong; fix when bug #88 is fixed please
549    $s->{compatibility}{base} = $compat_rs->search({ evo_parent_id => 0 })->count;
550
551    # held items
552    $s->{held_items} = [ $row->pokemon_items(undef, { order_by => 'rarity DESC', prefetch => 'item' }) ];
553
554    # wee bit of flavor text
555    $s->{flavors} = {
556        map { $_->generation => $_->text } $row->flavors
557    };
558
559    my %new_encounters;
560    my @new_encounters = $row->sane_encounters;
561    $s->{new_encounters} = \@new_encounters;
562
563    # moves from here down
564    # slurp everything this Pokemon can learn, complete with egg moves if necessary
565    my $moves_rs = $c->model('DBIC::PokemonMoves')->search( {
566        pokemon_id => $row->id,
567    } );
568   
569    my %moves = (
570        level => [],
571        egg => [],
572        tutor => [],
573        machine => [],
574        other => [],
575    );
576    while (my $move_row = $moves_rs->next) {
577        my $table_row = {
578            move_id => $move_row->move_id,
579            level => $move_row->level,
580            versions => { map { $_ => $move_row->level || 1 } split /,/, $move_row->versions },
581        };
582
583        my $method = $move_row->method;
584        if (!Vee::Utils::in($method, qw/level egg tutor machine/)) {
585            $table_row->{method} = $method;
586            $method = 'other';
587        }
588
589        push @{ $moves{$method} }, $table_row;
590    }
591   
592    # sorting go!
593    @{ $moves{$_} } = sort {
594        $a->{level} <=> $b->{level} or
595        $MoveData[ $a->{move_id} ]->name cmp $MoveData[ $b->{move_id} ]->name
596    } @{ $moves{$_} } for qw/ level egg machine /;
597   
598    # column reduction
599    my %move_columns = ( dp => 1 );
600   
601    my @column_pairs = ( [qw/rb y/], [qw/gs c/], [qw/rusa frlg/] );
602    my @column_deletions = (1) x @column_pairs;
603   
604    for my $move (@{ $moves{level} }, @{ $moves{egg} }, @{ $moves{machine} }) {
605        for my $p (0 .. $#column_pairs) {
606            $column_deletions[$p] = 0 if ($move->{versions}{ $column_pairs[$p][0] } || 0) != ($move->{versions}{ $column_pairs[$p][1] } || 0);
607        }
608    }
609    for my $p (0 .. $#column_pairs) {
610        next unless $generation <= $p;
611        $move_columns{ $column_pairs[$p][0] } = 1;
612        $move_columns{ $column_pairs[$p][1] } = 1 unless $column_deletions[$p];
613    }
614       
615    $s->{move_columns} = [ sort { $column_order{$a} <=> $column_order{$b} } keys %move_columns ];
616    $s->{move_columns_inv} = \%move_columns;
617
618    # The following mess is the code to compact the level move display as much
619    # as humanly possible.  This is the third incarnation of the code, and it
620    # is the most efficient, well-written, and well-documented version so far.
621    # I am quite pleased with it.  Enjoy.
622
623    # This is for slight ease of typing, as well as reading with coloring.
624    my $lev_moves = $moves{level};
625
626    # Continue to run through the list as long as we are still doing something.
627    # There should be no possible way that this creates an infinite loop.
628    my $merges;
629    do {
630        $merges = 0;
631        my $i = -1;
632        while (++$i <= $#$lev_moves) {  # shouldn't use a for since the size of the array changes
633            # find the next row index with the same move id
634            my $next_idx = first { $lev_moves->[$_]{move_id} == $lev_moves->[$i]{move_id} } $i + 1 .. $#$lev_moves;
635            next if not defined $next_idx;
636
637            # make the following mess easier to read/write
638            my $this = $lev_moves->[$i];
639            my $next = $lev_moves->[$next_idx];
640
641            # Ensure there are no level-up moves between these two that have the
642            # same version, as that would wreck the ordering.
643            # Note that there need to be TWO checks; one going in each direction.
644            # For example:
645            #   1 - Tail Whip
646            #   2 - Bubble
647            #   - 3 Tail Whip
648            # It is illegal to move the first Tail Whip forwards, but the last one
649            # can be moved backwards with no problems.
650            my ($forward_ok, $backward_ok) = (1, 1);
651            my %versions = map { $_ => 1 } keys(%{ $this->{versions} }), keys(%{ $next->{versions} });
652            for my $version (keys %versions) {
653                for my $mid_idx ($i + 1 .. $next_idx - 1) {
654                    next if not defined $lev_moves->[$mid_idx]{versions}{$version};
655                    $forward_ok  = 0 if defined $this->{versions}{$version} &&
656                        $lev_moves->[$mid_idx]{versions}{$version} > $this->{versions}{$version};
657
658                    $backward_ok = 0 if defined $next->{versions}{$version} &&
659                        $lev_moves->[$mid_idx]{versions}{$version} < $next->{versions}{$version};
660                }
661            }
662            next if not $forward_ok and not $backward_ok;
663
664            # merge one row into the other, forward by default (this is arbitrary)
665            my ($from, $into, $from_idx) = $forward_ok ? ($this, $next, $i) : ($next, $this, $next_idx);
666            for my $version (keys %{ $from->{versions} }) {
667                next if exists $into->{versions}{$version};
668                $into->{versions}{$version} = $from->{versions}{$version};
669                delete $from->{versions}{$version};
670                $merges++;
671            }
672            if (scalar keys %{ $from->{versions} } == 0) { 
673                # only move id left, so delete this row and redo to hit the next one
674                splice @$lev_moves, $from_idx, 1;
675                redo;
676            }
677        }
678    } while ($merges);
679
680    $s->{moves} = \%moves;
681}
682
683sub pokemon_chain : Chained('/') : PathPart('dex/pokemon') : CaptureArgs(1) {;}
684
685=head2 flavor
686
687=cut
688
689sub flavor : Chained('pokemon_chain') : Args(0) {
690    my ($self, $c) = @_;
691    my $s = $c->stash;
692   
693    my $poke = $c->req->captures->[0];
694
695    my $row = get_row($c, 'Pokemon', $poke);
696    $c->vee_abort('There is no such Pok&eacute;mon ', $poke, '.  If you are messing with my URLs, please stop.  If you came here via a link, please inform its owner that it is invalid.') unless $row;
697
698    $c->session->{last_pokemon_view} = 'flavor';
699
700    $s->{this} = $row;
701    $s->{flavors} = {
702        map { $_->generation => $_->text } $row->flavors
703    };
704    $s->{generation} = ( grep { $Generations[$_]{maxid} >= $row->real_pokemon_id } 0 .. $#Generations )[0];
705
706    $s->{page_title} = $row->name . ' - Flavor Text and Images';
707    $s->{crumbs}     = [
708        '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>',
709        '<a href="' . $c->uri('Dex', 'pokemon_list') . '">Pok&eacute;mon</a>',
710        '<a href="' . $c->uri('Dex', 'pokemon', lc $row->name) . '">' . $row->name . '</a>',
711        'Flavor Text and Images',
712    ];
713
714    add_rel_links( $c,
715        ($row->id - 2) % $Generations[-1]{maxid} + 1,
716        ($row->id + 0) % $Generations[-1]{maxid} + 1,
717        sub { {
718            id    => $_[0],
719            title => $PokemonNames[ $_[0] ],
720            url   => $c->uri('Dex', 'pokemon', lc $PokemonNames[ $_[0] ]) . '/flavor',
721        } }
722    );
723
724    $s->{template} = 'dex/page/pokemon/flavor.tt';
725}
726
727################################################################################
728
729=head2 move_list
730
731=cut
732
733sub move_list : Path('moves') : Args(0) {
734    my ($self, $c) = @_;
735    my $s = $c->stash;
736
737    $s->{list} = undef;  # everything I need is in @MoveData
738   
739    $s->{page_title } = 'Move List';
740    $s->{crumbs     } = [ '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>', 'Moves' ];
741
742    $s->{template} = 'dex/list/moves.tt';
743}
744
745=head2 moves
746
747=cut
748
749sub moves : Local : Args(1) {
750    my ($self, $c) = @_;
751    my $s = $c->stash;
752
753    my $row = get_row($c, 'Moves');
754    $c->vee_abort('There is no such move ', $c->req->args->[0], '.  If you are messing with my URLs, please stop.  If you came here via a link, please inform its owner that it is invalid.') unless $row;
755
756    $s->{page_title } = $row->name . ' - Move #' . $row->id;
757    $s->{page_header} = $row->name;
758    $s->{link_name  } = 'dex';
759    $s->{crumbs     } = [
760        '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>',
761        '<a href="' . $c->uri('Dex', 'move_list') . '">Moves</a>',
762        $row->name,
763    ];
764
765    add_rel_links( $c,
766        ($row->id - 2) % $#MoveData + 1,
767        ($row->id + 0) % $#MoveData + 1,
768        sub { {
769            id    => $_[0],
770            title => $MoveData[ $_[0] ]->name,
771            url   => $c->uri('Dex', 'moves', lc $MoveData[ $_[0] ]->name),
772        } }
773    );
774
775    $s->{template} = 'dex/page/move.tt';
776    $c->forward('/cache', [ $row->id ]);
777   
778    $s->{this} = $row;
779    $s->{pid} = Vee::Utils::pad($row->id, 3);
780    $s->{generation} = my $generation = ( grep { $Generations[$_]{maxmoveid} >= $row->id } 0 .. $#Generations )[0];
781   
782    $s->{percentile} = defined $row->power
783        ? Vee::Utils::round( $c->model('DBIC::Moves')->count({ power => { '!=' => undef, '<' => $row->power } }) / $DamagingMoveCount * 100, 1 )
784        :'n/a';
785    $s->{tm_info} = { map { $_->generation => $_ } $c->model('DBIC::Machines')->search({ move_id => $row->id }) };
786
787    # status effect
788    my $status = $row->status;
789    if (!$status) {
790        $status = 'none'
791    } else {
792        my @s = split / /, $status;
793        for my $s (@s) {
794            if ($s =~ /^([a-z]+)((?:\+|-|\^)+)$/) {
795                $s = $MoveEffects{$1} . ' ' . $MoveAmounts{$2};
796            } else {
797                $s = $MoveEffects{$s};
798            }
799        }
800        $status = join ', ', @s;
801    }
802    $s->{status} = $status;
803
804    # contest stuffs
805    my $contest_family_rs = $c->model('DBIC::Moves')->search({ contest_effect_id => $row->contest_effect_id, id => { '!=', $row->id } }, { columns => [qw/id name contest_type/], order_by => 'name ASC' });
806    my %contest_family;
807    $s->{contest_family_count} = 0;
808    while (my $move = $contest_family_rs->next) {
809        push @{ $contest_family{ $move->contest_type } }, $move;
810        $s->{contest_family_count}++;
811    }
812    $s->{contest_family} = \%contest_family;
813    $s->{reverse_combos} = [ map { $_->id } $c->model('DBIC::Moves')->search(\( 'FIND_IN_SET(' . $row->id . ', combos)' ), { columns => ['id'], order_by => 'name ASC' }) ];
814
815    # Fetch list of Pokemon
816    my %pokemon_count;
817    my %valid_methods = map { $_ => 1 } qw/level egg tutor machine/;
818    my $pokemoves_rs = $c->model('DBIC::PokemonMoves')->search({ move_id => $row->id });
819    my %pokemon_hash;  # method => pokemon id => version => level
820    while (my $pm = $pokemoves_rs->next) {
821        my $method = 'other';
822        $method = $pm->method if $valid_methods{ $pm->method };
823        my @versions;
824
825        if ($method eq 'other') {
826            # XXX: this will break if there are more other moves than the max
827            @versions = ('all');
828        } else {
829            @versions = split /,/, $pm->versions;
830        }
831
832        for my $ver (@versions) {
833            $pokemon_hash{$method}{$pm->pokemon_id}{pokemon} ||= $pm->pokemon;
834            $pokemon_hash{$method}{$pm->pokemon_id}{$ver} = $pm->level || 1;
835        }
836        $pokemon_count{ $pm->pokemon_id } = 1;
837    }
838
839    my %learners;  # method => [ version => level, pokemon => pokemon ]
840    for my $method (keys %pokemon_hash) {
841        my @sorted_learners = sort {
842            $a->{pokemon}->name cmp $b->{pokemon}->name
843        } values %{ $pokemon_hash{$method} };
844       
845        if ($method ne 'level' and @sorted_learners > $MAX_LEARNERS) {
846            $learners{$method} = {};
847            for my $learner_hash (@sorted_learners) {
848                for my $version (keys %$learner_hash) {
849                    $learners{$method}{$version}++;
850                }
851            }
852        } else {
853            $learners{$method} = \@sorted_learners;
854        }
855    }
856
857    $s->{learners} = \%learners;
858    $s->{pokemon_count} = scalar keys %pokemon_count;
859}
860
861################################################################################
862
863=head2 type_list
864
865=cut
866
867sub type_list : Path('types') : Args(0) {
868    my ($self, $c) = @_;
869    my $s = $c->stash;
870   
871    $s->{list} = undef;  # everything I need is in %TypeData
872
873    $s->{page_title } = 'Type Chart';
874    $s->{crumbs     } = [ '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>', 'Types' ];
875
876    $s->{template} = 'dex/list/types.tt';
877}
878
879=head2 types
880
881=cut
882
883sub types : Local : Args(1) {
884    my ($self, $c) = @_;
885    my $s = $c->{stash};
886
887    my $row = get_row($c, 'Types');
888    $c->vee_abort('There is no such type ', $c->req->args->[0], '.  If you are messing with my URLs, please stop.  If you came here via a link, please inform its owner that it is invalid.')
889        unless $row;
890
891    $s->{page_title}  = ucfirst($row->name) . ' - Type #' . $s->{hid};
892    $s->{page_header} = ucfirst $row->name;
893    $s->{link_name}   = 'dex';
894    $s->{crumbs}      = [
895        '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>',
896        '<a href="' . $c->uri('Dex', 'type_list') . '">Types</a>',
897        $row->name,
898    ];
899   
900    $s->{template} = 'dex/page/type.tt';
901    $c->forward('/cache', [ $row->id ]);
902
903    $s->{hid}         = $row->internal_id + 1;
904    $s->{generation}  = ($row->name eq 'dark' || $row->name eq 'steel') ? 1 : 0;
905
906    $s->{this}       = $row;
907    $s->{moves_rs}   = $c->model('DBIC::Moves')->search({ type => $row->name }, { order_by => 'name ASC', columns => ['id'] });
908    $s->{pokemon_rs} = $c->model('DBIC::Pokemon')->search( {
909        id => { '<=', $Generations[-1]{maxid} },
910        -or => [ type1 => $row->name, type2 => $row->name ],
911    }, {
912        order_by => 'name ASC',
913        columns => [qw/ id name type1 type2 /],
914    } );
915}
916
917################################################################################
918
919=head2 location_list
920
921List of areas.  In D/P.
922
923=cut
924
925sub location_list : Path('locations') : Args(0) {
926    my ($self, $c) = @_;
927    my $s = $c->stash;
928
929    $s->{locations_rs} = $c->model('DBIC::Locations')->search(undef, { order_by => 'name' });
930
931    $s->{template} = 'dex/list/locations.tt';
932
933    $s->{page_title}  = 'Locations List';
934    $s->{breadcrumbs} = [ '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>', 'Locations' ];
935}
936
937=head2 locations
938
939Controller to display information about a location; so far, only D/P, and only
940the wild Pokemon there.
941
942=cut
943
944sub locations : Local : Args(1) {
945    my ($self, $c) = @_;
946    my $s = $c->stash;
947
948    my $row = $c->model('DBIC::Locations')->search({
949        name     => $c->req->args->[0],
950    })->single
951        or $c->vee_abort("No such location ", $c->req->args->[0], ".  I only have D/P so far, sorry!");
952
953    $s->{page_title} = $row->name;
954    $s->{crumbs}     = [
955        'Pok&eacute;dex',
956        '<a href="' . $c->uri('Dex', 'location_list') . '">Locations</a>',
957        $row->name,
958    ];
959
960    $s->{template} = 'dex/page/location.tt';
961    $c->forward('/cache', [ $row->id ]);
962
963    my %encounters;
964
965    my $sections_rs = $row->sections_rs;
966    while (my $section = $sections_rs->next) {
967        my $grouped_pokemon_rs = $section->encounters_rs( {
968            version  => 'diamond',
969        }, {
970            group_by => 'pokemon_id',
971        } );
972
973        while (my $enc_pokemon = $grouped_pokemon_rs->next) {
974            my $encounters_rs = $section->encounters_rs( {
975                version     => 'diamond',
976                pokemon_id  => $enc_pokemon->pokemon->id,
977            } );
978            $encounters_rs->reset;
979
980            push @{ $encounters{$section->name} }, Vee::Dex::EncounterSet->new(
981                $encounters_rs,
982                $enc_pokemon->pokemon,
983            );
984        }
985
986        @{ $encounters{$section->name} } = sort {
987            $a->pokemon->name cmp $b->pokemon->name
988        } @{ $encounters{$section->name} };
989    }
990
991    $s->{this}       = $row;
992    $s->{encounters} = \%encounters;
993}
994
995################################################################################
996
997=head2 item_list
998
999=cut
1000
1001sub item_list : Path('items') : Args(0) {
1002    my ($self, $c) = @_;
1003    my $s = $c->stash;
1004   
1005    $s->{page_title} = 'Item List';
1006    $s->{crumbs}     = [ '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>', 'Items' ];
1007
1008    $s->{template} = 'dex/list/items.tt';
1009    $c->forward('/cache');
1010
1011    my $items_rs = $c->model('DBIC::Items')->search(undef, {
1012        order_by  => 'me.name',
1013    });
1014
1015    # eh this sucks; TODO cache?
1016    my %item_categories;
1017    while (my $item = $items_rs->next) {
1018        push @{ $item_categories{$item->category} }, $item;
1019    }
1020
1021    $s->{item_categories} = \%item_categories;
1022}
1023
1024=head2 items
1025
1026=cut
1027
1028sub items : Local : Args(1) {
1029    my ($self, $c, $item_name) = @_;
1030    my $s = $c->stash;
1031
1032    my $row = $c->model('DBIC::Items')->find({
1033        name     => $item_name,
1034    }, {
1035        prefetch => { berry => [], pokemon_items => 'pokemon' },
1036    }) or $c->vee_abort('No such item ', $item_name, '.');
1037   
1038    $s->{page_title} = $row->name . ' - Item #' . $row->game_id;
1039    $s->{crumbs}     = [
1040        '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>',
1041        '<a href="' . $c->uri('Dex', 'item_list') . '">Items</a>',
1042        $row->name
1043    ];
1044
1045    add_rel_links( $c,
1046        ($row->id - 2) % $#ItemNames + 1,
1047        ($row->id + 0) % $#ItemNames + 1,
1048        sub { {
1049            id    => $_[0],
1050            title => $ItemNames[ $_[0] ],
1051            url   => $c->uri('Dex', 'items', lc $ItemNames[ $_[0] ]),
1052        } }
1053    );
1054
1055    $s->{template} = 'dex/page/item.tt';
1056#    $c->forward('/cache'); -- TODO: necessary?
1057
1058    $s->{this}       = $row;
1059    $s->{generation} = 3;
1060}
1061
1062=head2 berry_list
1063
1064=cut
1065
1066sub berry_list : Path('berries') : Args(0) {
1067    my ($self, $c) = @_;
1068    my $s = $c->stash;
1069
1070    $s->{berries_rs} = $c->model('DBIC::Berries')->search(undef, { prefetch => 'item' });
1071   
1072    $s->{page_title} = 'Berry List';
1073    $s->{crumbs}     = [
1074        '<a href="' . $c->uri('Dex') . '">Pok&eacute;dex</a>',
1075        '<a href="' . $c->uri('Dex', 'item_list') . '">Items</a>',
1076        'Berries'
1077    ];
1078
1079    $s->{template} = 'dex/list/berries.tt';
1080#    $c->forward('/cache'); -- TODO: necessary?
1081}
1082
1083################################################################################
1084
1085=head2 suggest
1086
1087Controller for Pokedex entry suggestions.
1088
1089=cut
1090
1091sub suggest : Local : Args(0) {
1092    my ($self, $c) = @_;
1093    my $search   = $c->req->params->{search} || '';
1094    my $type     = $c->req->params->{type};
1095    my $extended = $c->req->params->{extended};
1096    my @suggestions = ();
1097
1098    if ($search) {
1099        my $len       = length $search;
1100        my $lc_search = lc $search;
1101
1102        my @keys = grep { $lc_search eq substr $_, 0, $len } keys %FuzzyMatches;
1103
1104        # exclude foreign languages...
1105        # TODO: don't?
1106        @keys = grep { $_ eq lc $FuzzyMatches{$_}{name} } @keys;
1107
1108        if ($type) {
1109            @keys = grep { $FuzzyMatches{$_}{type} eq $type } @keys;
1110        }
1111
1112        @keys = sort @keys;
1113
1114        for my $key (@keys) {
1115            my $fuzzy_row = $FuzzyMatches{$key};
1116
1117            if (not $extended) {
1118                # Dummy mode; just slap the name on the list and go on
1119                push @suggestions, $fuzzy_row->{name};
1120                next;
1121            }
1122
1123            my $row = {
1124                label => $fuzzy_row->{name},
1125            };
1126
1127            if ($fuzzy_row->{type} eq 'pokemon') {
1128                $row->{image} = $c->uri_for( sprintf '/dex-images/icons/%03d.png', $fuzzy_row->{id} );
1129                $row->{bottom_align} = 1;
1130            } elsif ($fuzzy_row->{type} eq 'move') {
1131                $row->{image} = $c->uri_for( sprintf '/dex-images/gameui/%s.png', $MoveData[ $fuzzy_row->{id} ]->type );
1132            } elsif ($fuzzy_row->{type} eq 'type') {
1133                $row->{image} = $c->uri_for( sprintf '/dex-images/gameui/%s.png', $fuzzy_row->{name} );
1134            } elsif ($fuzzy_row->{type} eq 'item') {
1135                my $name = lc $fuzzy_row->{name};
1136                $name =~ tr/ /-/;
1137                $name =~ tr/-a-z0-9//cd;
1138                $row->{image} = $c->uri_for( sprintf '/dex-images/items/%s.png', $name );
1139                $row->{left_4px} = 1;
1140            }
1141
1142            # hack to stringify URIs to make JSON happy
1143            $row->{image} .= '' if $row->{image};
1144
1145            push @suggestions, $row;
1146        }
1147    }
1148   
1149    my $obj = [ $search, \@suggestions ];
1150
1151    $c->res->content_type('application/x-suggestions+json; charset=utf-8');
1152    $c->res->body( objToJson($obj) );
1153}
1154
1155################################################################################
1156
1157=head2 egg_annon
1158
1159Annondex easter egg.
1160
1161=cut
1162
1163sub egg_annon : Private {
1164    my ($self, $c, $string, $dir) = @_;
1165    my $s = $c->stash;
1166
1167    $s->{page_title} = 'Ooooeeeeoooo~';
1168
1169    $string = lc $string;
1170    $string =~ tr/a-z!? //cd;
1171    $s->{string}   = $string;
1172    $s->{dir}      = $dir;
1173    $s->{template} = 'dex/eggs/annon.tt';
1174}
1175
1176################################################################################
1177
1178=head2 get_row
1179
1180=cut
1181
1182sub get_row {
1183    my ($c, $table, $id, $alt_form) = @_;
1184    $id ||= $c->req->args->[0];
1185   
1186    my $rs = $c->model('DBIC')->resultset($table);
1187   
1188    my @extra;
1189    # n.b.: can ONLY prefetch one has_many here; DBIx::Class will refuse more due to cross-product effect
1190    if ($table eq 'Pokemon') { @extra = ( prefetch => [qw/evo_chain pokemon_moves/], order_by => 'pokemon_moves.move_id ASC' ) }
1191    elsif ($table eq 'Moves') { @extra = ( prefetch => 'pokemon_moves', order_by => 'pokemon_moves.pokemon_id ASC' ) }
1192   
1193    if ($id eq 'random') {
1194        if ($table eq 'Pokemon') { $id = $PokemonNames[ 1 + rand $#PokemonNames ] }
1195        elsif ($table eq 'Moves') { $id = $MoveData[ 1 + rand $#MoveData ]->name }
1196        elsif ($table eq 'Types') { $id = $TypeNames[ rand @TypeNames ] }
1197    }
1198
1199    $rs = $rs->search({ name => $id }, { @extra });
1200    $rs = $rs->search({ alt_form => $alt_form }) if $alt_form;
1201    return $rs->single;
1202}
1203
1204################################################################################
1205
1206=head2 add_rel_links
1207
1208Adds <link> tag information to the stash.
1209
1210TODO: Move this out of here into something more generic, link it up with the
1211breadcrumbs somehow, generally clean it up, refactor it for dex pages since
1212they end up having largely the same code everywhere.
1213
1214=cut
1215
1216sub add_rel_links {
1217    my ($c, $prev, $next, $generator) = @_;
1218    my $s = $c->stash;
1219
1220    $s->{nav}{start} = $generator->(1);
1221    $s->{nav}{prev}  = $generator->($prev) if defined $prev;
1222    $s->{nav}{next}  = $generator->($next) if defined $next;
1223}
1224
1225################################################################################
1226
1227=head2 calculate_tree_width
1228
1229Runs through an evolution chain tree (or similar, really) and assigns the
1230'width' param of each node the sum of the widths of its children.
1231
1232=cut
1233
1234sub calculate_tree_width {
1235    my $tree = shift;
1236    unless (@{ $tree->{children} }) {
1237        $tree->{width} = 1;
1238        return 1;
1239    }
1240   
1241    my $width = 0;
1242    for my $child (@{ $tree->{children} }) {
1243        calculate_tree_width($child);
1244        $width += $child->{width};
1245    }
1246    return $tree->{width} = $width;
1247}
1248
1249=head2 calculate_stats
1250
1251Adds stat percentiles and averages to the stash.
1252
1253=cut
1254
1255sub calculate_stats {
1256    my ($c, $row) = @_;
1257    # statistics
1258    # XXX: what a terrible fucking hack
1259    my $stat_average;
1260    $stat_average += $row->$_ for @StatColumns;
1261    $stat_average /= @StatColumns;
1262    $c->stash->{stat_average} = $stat_average;
1263   
1264    my %stat_percentiles;
1265    for my $stat (@StatColumns) {
1266        $stat_percentiles{$stat} = Vee::Utils::round(
1267            $c->model('DBIC::Pokemon')->count({
1268                id    => { '<=', $Generations[-1]{maxid} },
1269                $stat => { '<', $row->$stat }
1270            }) / $#PokemonNames * 100,
1271            1
1272        );
1273    }
1274    $stat_percentiles{average} = Vee::Utils::round( $c->model('DBIC::Pokemon')->count({ id => { '<=', $Generations[-1]{maxid} } , -and => \ "(stat_at + stat_de + stat_sa + stat_sd + stat_sp + stat_hp) / 6 < $stat_average" }) / $#PokemonNames * 100, 1 );
1275    $c->stash->{stat_percentiles} = \%stat_percentiles;
1276}
1277
1278=head2 get_locations
1279
1280Fetches the locations for a given Pokemon (row) and returns a hash.
1281
1282In: Pokemon db row
1283
1284Out: { location => { section => { method => { level => "a - b", rarity => x } } } }
1285
1286=cut
1287
1288sub get_locations {
1289    my ($pokemon) = @_;
1290
1291    my $encounters_rs = $pokemon->encounters_rs(undef, {
1292        prefetch  => 'location',
1293        group_by  => [qw/ location_id section method /],
1294
1295        # this minor hackery will essentially collapse multiple rows for a method into one short one we care about
1296        '+select' => [
1297            \ 'GROUP_CONCAT(rarity SEPARATOR " ") AS rarity',
1298            \ 'MIN(min_level) AS min_level',
1299            \ 'MAX(max_level) AS max_level',
1300        ],
1301        '+as'     => [qw/ rarity min_level max_level /],
1302    } );
1303
1304    my %locations;
1305    while (my $encounter = $encounters_rs->next) {
1306        my $level;
1307        if (not $encounter->min_level) {
1308            $level = '';
1309        } elsif ($encounter->min_level == $encounter->max_level) {
1310            $level = $encounter->min_level;
1311        } else {
1312            $level = $encounter->min_level . ' - ' . $encounter->max_level;
1313        }
1314
1315        $locations{ $encounter->location->name }{ $encounter->section }{ $encounter->method } = { level => $level, rarity => min $encounter->rarity };
1316    }
1317
1318    return \%locations;
1319}
1320
1321=head2 add_evolution_desc
1322
1323Adds a readable blurb to an evolution node, based on the method, param, and
1324chain.
1325
1326=cut
1327
1328sub add_evolution_desc {
1329    my ($node, $chain) = @_;
1330    if (@{$node->{children}} and $node->{children}[0]{id} < $node->{id}) {
1331        $node->{blurb} = 'Baby form';
1332        if ($chain->baby_item) {
1333            $node->{blurb} .= ' (mother must hold ' . $chain->baby_item . ')';
1334        }
1335        $node->{item} = 'lucky-egg';
1336
1337    } elsif (!$node->{parent}) {
1338        $node->{blurb} = 'Base form';
1339        $node->{item} = 'poke-ball';
1340
1341    } elsif ($node->{method} =~ /^item(male|female|)$/) {
1342        $node->{blurb} = "Use a $node->{param}";
1343        if ($1) {
1344            $node->{blurb} .= " on a $1";
1345        }
1346        ($node->{item} = lc $node->{param}) =~ tr/ /-/;
1347        $node->{item} =~ tr/-a-z0-9//cd;
1348
1349    } elsif ($node->{method} =~ /^level(male|female|)$/) {
1350        $node->{blurb} = 'Raise' . ($1 ? " a $1" : '') . " to level $node->{param}";
1351        $node->{item} = 'rare-candy';
1352
1353    } elsif ($node->{method} eq 'levelarea') {
1354        $node->{blurb} = "Level up while at $node->{param}";
1355        $node->{item} = 'town-map';
1356
1357    } elsif ($node->{method} eq 'trade') {
1358        $node->{blurb} = "Trade";
1359        if ($node->{param}) {
1360            $node->{blurb} .= " with $node->{param} attached" ;
1361            ($node->{item} = lc $node->{param}) =~ tr/ /-/;
1362            $node->{item} =~ tr/-a-z0-9//cd;
1363        } else {
1364            $node->{item} = 'gameui/trade';
1365        }
1366
1367    } elsif ($node->{method} =~ /^hold(day|night)$/) {
1368        $node->{blurb} = "Level up while holding $node->{param}";
1369        if ($1 eq 'day') {
1370            $node->{blurb} .= " during the day";
1371        } elsif ($1 eq 'night') {
1372            $node->{blurb} .= " at night";
1373        }
1374        ($node->{item} = lc $node->{param}) =~ tr/ /-/;
1375        $node->{item} =~ tr/-a-z0-9//cd;
1376
1377    } elsif ($node->{method} eq 'move') {
1378        $node->{blurb} = "Level up while knowing " . $MoveData[ $node->{param} ]->name;
1379        $node->{item} = 'tm-' . $MoveData[ $node->{param} ]->type;
1380
1381    } elsif ($node->{method} =~ /^happiness(day|night|)$/) {
1382        $node->{blurb} = "Happiness";
1383        if ($1 eq 'day') {
1384            $node->{blurb} .= " during the day";
1385        } elsif ($1 eq 'night') {
1386            $node->{blurb} .= " at night";
1387        }
1388        $node->{item} = 'heart-scale';
1389        if ($node->{param}) {
1390            $node->{blurb} .= ", or use $node->{param}";
1391            $node->{item} = $1 eq 'day' ? 'gameui/daytime' : 'gameui/night';
1392        }
1393
1394    } elsif ($node->{method} eq 'dnadigivolve') {
1395        $node->{blurb} = "Level up with a $PokemonNames[ $node->{param} ] in the party";
1396        $node->{item} = 'net-ball';
1397
1398    } elsif ($node->{method} eq 'divineintervention') {
1399        $node->{blurb} = "Appears in an empty belt slot after you get a $node->{param} by evolution";
1400        $node->{item} = 'leftovers';
1401
1402    } elsif ($node->{method} eq 'level+attack') {
1403        $node->{blurb} = "Raise to level $node->{param} when Attack &gt; Defense";
1404        $node->{item} = 'x-attack';
1405
1406    } elsif ($node->{method} eq 'level+defense') {
1407        $node->{blurb} = "Raise to level $node->{param} when Attack &lt; Defense";
1408        $node->{item} = 'x-defend';
1409
1410    } elsif ($node->{method} eq 'level+equal') {
1411        $node->{blurb} = "Raise to level $node->{param} when Attack = Defense";
1412        $node->{item} = 'x-speed';
1413
1414    } elsif ($node->{method} eq 'beauty') {
1415        $node->{blurb} = "Raise Beauty to at least 171 and raise one level";
1416        $node->{item} = 'blue-scarf';
1417
1418    } elsif ($node->{method} eq 'none') {
1419        $node->{blurb} = "Cannot be obtained by evolution";
1420        $node->{item} = 'everstone';
1421
1422    } else {
1423        $node->{blurb} = "Not recognized: " . $node->{method};
1424        $node->{blurb} .= " [ $node->{param} ]" if $node->{param};
1425        $node->{item} = 'parcel';
1426    }
1427
1428    $node->{item} = 'items/' . $node->{item}
1429        unless $node->{item} =~ m#/#;
1430}
1431
1432=head1 AUTHOR
1433
1434Maintainer: Alex "Eevee" Munroe (C<veekun@veekun.com>)
1435
1436See the included F<AUTHORS> file for a full list of contributers.
1437
1438=head1 LICENSE
1439
1440See the included F<LICENSE> file.
1441
1442=cut
1443
14441;
Note: See TracBrowser for help on using the browser.