File Coverage

lib/Data/Pokemon/Go/Pokemon.pm
Criterion Covered Total %
statement 99 120 82.5
branch 17 26 65.3
condition 7 8 87.5
subroutine 28 31 90.3
pod 0 20 0.0
total 151 205 73.6


line stmt bran cond sub pod time code
1             package Data::Pokemon::Go::Pokemon;
2 6     6   388191 use 5.008001;
  6         69  
3 6     6   30 use utf8;
  6         11  
  6         33  
4 6     6   130 use Carp;
  6         10  
  6         443  
5 6     6   35 use Exporter 'import';
  6         10  
  6         409  
6             our @EXPORT_OK = qw( $All @List @Types );
7              
8 6     6   2657 use Moose;
  6         2349194  
  6         39  
9 6     6   45142 use Moose::Util::TypeConstraints;
  6         15  
  6         58  
10              
11             enum 'Countries' => [qw( en ja ca fr )];
12             has lang => ( is => 'ro', isa => 'Countries', required => 1, default => 'ja' );
13              
14 6     6   17043 use YAML::XS;
  6         14258  
  6         367  
15 6     6   2142 use File::Share 'dist_dir';
  6         107651  
  6         563  
16             my $dir = $ENV{'USER'} eq 'yuki.yoshida'? 'share': dist_dir('Data-Pokemon-Go');
17              
18 6     6   2559 use Data::Pokemon::Go::Relation;
  6         19  
  6         436  
19             our @Types = @Data::Pokemon::Go::Role::Types::All;
20 6     6   3243 use Data::Pokemon::Go::Skill;
  6         23  
  6         2388  
21              
22             my $skill = Data::Pokemon::Go::Skill->new();
23              
24             our $All = {};
25             our @List = ();
26             foreach my $region (qw|Kanto Johto Hoenn Sinnoh Unova Alola Galar|){
27             my $data = YAML::XS::LoadFile("$dir/$region.yaml");
28             map{
29             my $fullname = get_fullname( bless( { lang => 'ja' }, __PACKAGE__ ), $_ );
30             push @List, $fullname;
31             $All->{ $fullname } = $_;
32             } @$data;
33             }
34              
35             enum 'PokemonName' => \@List;
36             has name => ( is => 'rw', isa => 'PokemonName' );
37             before 'name' => sub {
38             my $self = shift;
39             my $name = shift;
40             my $form = shift || '';
41             if ( defined $name and $name =~ /^(\w+)\((\w+)\)$/ ){
42             $name = $1;
43             $form = $2;
44             }
45            
46             # croak "unvalid name: $name($form)"
47             # if defined $name and defined $form and not $self->exists($name) and not $self->exists( $name, $form );
48             };
49              
50             __PACKAGE__->meta->make_immutable;
51 6     6   57 no Moose;
  6         12  
  6         43  
52              
53             sub exists {
54 2127     2127 0 1216404 my $self = shift;
55 2127         4004 my $name = shift;
56 2127   100     7952 my $form = shift || undef;
57              
58 2127 100 66     14469 if ( not defined $form and defined $name and $name =~ /^(\w+)\((\w+)\)$/ ){
      100        
59 181         1571 return CORE::exists $All->{"$1($2)"};
60             }
61 1946         60113 my $fullname = $All->{$name}{'Name'}{$self->lang()};
62 1946 50       4171 return 0 unless defined $fullname;
63 1946 100       6659 return 1 unless $form;
64 2         7 $fullname .= "($form)";
65 2         12 return CORE::exists $All->{$fullname};
66             }
67              
68             sub id {
69 2122     2122 0 8374 my $self = shift;
70 2122         4320 my $name = $self->name();
71 2122         6815 my $id = $All->{$name}{ID};
72 2122 50       6755 carp "'ID' may be invalid: $id" unless $id =~ /^\d{3}$/;
73 2122         8275 return $id;
74             }
75              
76             sub types {
77 6238     6238 0 12337 my $self = shift;
78 6238         17852 my $name = $self->name();
79 6238         15756 my $typesref = $All->{$name}{Types};
80 6238 50       14746 carp "'Types' may be invalid: $typesref" unless ref $typesref eq 'ARRAY';
81 6238         103083 return $typesref;
82             }
83              
84             sub skill {
85 0     0 0 0 my $self = shift;
86 0         0 my $name = $self->name();
87 0         0 my $ref = $All->{$name}{Skill};
88 0         0 my @skill;
89 0         0 foreach my $name (@$ref) {
90 0         0 $skill->name($name);
91 0         0 $skill->own_type( $self->types() );
92 0         0 push @skill, $skill->as_string();
93             }
94 0         0 return @skill;
95             }
96              
97             sub special {
98 0     0 0 0 my $self = shift;
99 0         0 my $name = $self->name();
100 0         0 my $ref = $All->{$name}{Special};
101 0         0 my @skill;
102 0         0 foreach my $name (@$ref) {
103 0         0 $skill->name($name);
104 0         0 $skill->own_type( $self->types() );
105 0         0 push @skill, $skill->as_string();
106             }
107 0         0 return @skill;
108             }
109              
110             sub effective {
111 686     686 0 1492 my $self = shift;
112 686         1835 return Data::Pokemon::Go::Relation->new( types => $self->types() )->effective();
113             };
114              
115             sub invalid {
116 686     686 0 1191 my $self = shift;
117 686         1649 return Data::Pokemon::Go::Relation->new( types => $self->types() )->invalid();
118             };
119              
120             sub advantage {
121 686     686 0 1187 my $self = shift;
122 686         1784 return Data::Pokemon::Go::Relation->new( types => $self->types() )->advantage();
123             };
124              
125             sub disadvantage {
126 686     686 0 1284 my $self = shift;
127 686         1737 return Data::Pokemon::Go::Relation->new( types => $self->types() )->disadvantage();
128             };
129              
130             sub recommended {
131 1372     1372 0 4364 my $self = shift;
132 1372         3322 return Data::Pokemon::Go::Relation->new( types => $self->types() )->recommended();
133             };
134              
135             sub stamina {
136 1904     1904 0 2846 my $self = shift;
137 1904         4967 my $name = $self->name();
138 1904 50       5268 croak "'Stamina' is undefined for $name" unless exists $All->{$name}{'Stamina'};
139 1904         6657 return $All->{$name}{Stamina};
140             }
141              
142             sub attack {
143 1904     1904 0 2695 my $self = shift;
144 1904         4070 my $name = $self->name();
145 1904 50       5120 croak "'Attack' is undefined for $name" unless exists $All->{$name}{'Attack'};
146 1904         6163 return $All->{$name}{Attack};
147             }
148              
149             sub defense {
150 1904     1904 0 2681 my $self = shift;
151 1904         4334 my $name = $self->name();
152 1904 50       4708 croak "'Defense' is undefined for $name" unless exists $All->{$name}{'Defense'};
153 1904         5979 return $All->{$name}{Defense};
154             }
155              
156             sub max {
157 1218     1218 0 434970 my $self = shift;
158 1218         2058 my $when = shift;
159 1218 50       6484 croak "Unvalid param $when into sub max()"
160             unless $when =~ /(:?Boosted|Hatched|Grown)/;
161              
162 1218         3473 my $name = $self->name();
163 1218 50       4281 croak "'$when' is undefined for $name" unless exists $All->{$name}{'MAXCP'}{$when};
164 1218         6617 return $All->{$name}{'MAXCP'}{$when};
165             }
166              
167             sub isNotWild {
168 0     0 0 0 my $self = shift;
169 0         0 my $name = $self->name();
170 0         0 return $All->{$name}{'isNotWild'};
171             }
172              
173             sub isNotAvailable {
174 686     686 0 1006 my $self = shift;
175 686         1786 my $name = $self->name();
176 686         2056 return $All->{$name}{'isNotAvailable'};
177             }
178              
179             sub hasOtherForm {
180 641     641 0 1274 my $self = shift;
181 641         1027 my $name = $self->name();
182 641         1272 return $All->{$name}{'hasOtherForm'};
183             }
184              
185             sub hasForms {
186 750     750 0 1896 my $self = shift;
187 750         1294 my $name = $self->name();
188 750 100       2720 return exists $All->{$name}{'Form'}? $All->{$name}{'Form'} : 0;
189             }
190              
191             sub get_fullname {
192 4802     4802 0 65646 my $self = shift;
193 4802         4937 my $ref = shift;
194 4802         10067 my $fullname = $self->get_Pokemon_name($ref);
195 4802 100       8649 $fullname .= '(' . $ref->{'Form'} . ')' if exists $ref->{'Form'};
196 4802         7299 return $fullname;
197             }
198              
199             sub get_Pokemon_name {
200 4866     4866 0 6965 my $self = shift;
201 4866         6283 my $ref = shift;
202 4866         103234 my $lang = $self->lang();
203 4866 50       10467 croak "No name for $lang" unless exists $ref->{'Name'}{$lang};
204 4866         7996 return $ref->{'Name'}{$lang};
205             }
206              
207             1;
208             __END__
209              
210             =encoding utf-8
211              
212             =head1 NAME
213              
214             Data::Pokemon::Go::Pokemon - It's new $module
215              
216             =head1 SYNOPSIS
217              
218             use Data::Pokemon::Go::Pokemon;
219              
220             =head1 DESCRIPTION
221              
222             Data::Pokemon::Go::Pokemon is ...
223              
224             =head1 LICENSE
225              
226             Copyright (C) Yuki Yoshida.
227              
228             This library is free software; you can redistribute it and/or modify
229             it under the same terms as Perl itself.
230              
231             =head1 AUTHOR
232              
233             Yuki Yoshida E<lt>worthmine@gmail.comE<gt>
234              
235             =cut