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   313730 use 5.008001;
  6         55  
3 6     6   25 use utf8;
  6         8  
  6         24  
4 6     6   130 use Carp;
  6         7  
  6         266  
5 6     6   26 use Exporter 'import';
  6         9  
  6         352  
6             our @EXPORT_OK = qw( $All @List @Types );
7              
8 6     6   2151 use Moose;
  6         1891725  
  6         30  
9 6     6   35362 use Moose::Util::TypeConstraints;
  6         13  
  6         46  
10              
11             enum 'Countries' => [qw( en ja ca fr )];
12             has lang => ( is => 'ro', isa => 'Countries', required => 1, default => 'ja' );
13              
14 6     6   13300 use YAML::XS;
  6         11523  
  6         299  
15 6     6   1714 use File::Share 'dist_dir';
  6         87076  
  6         435  
16             my $dir = $ENV{'USER'} eq 'yuki.yoshida'? 'share': dist_dir('Data-Pokemon-Go');
17              
18 6     6   2140 use Data::Pokemon::Go::Relation;
  6         15  
  6         331  
19             our @Types = @Data::Pokemon::Go::Role::Types::All;
20 6     6   2427 use Data::Pokemon::Go::Skill;
  6         45  
  6         1830  
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   41 no Moose;
  6         9  
  6         32  
52              
53             sub exists {
54 2122     2122 0 1043571 my $self = shift;
55 2122         3027 my $name = shift;
56 2122   100     6323 my $form = shift || undef;
57              
58 2122 100 66     11596 if ( not defined $form and defined $name and $name =~ /^(\w+)\((\w+)\)$/ ){
      100        
59 173         1160 return CORE::exists $All->{"$1($2)"};
60             }
61 1949         48445 my $fullname = $All->{$name}{'Name'}{$self->lang()};
62 1949 50       3533 return 0 unless defined $fullname;
63 1949 100       5275 return 1 unless $form;
64 2         6 $fullname .= "($form)";
65 2         8 return CORE::exists $All->{$fullname};
66             }
67              
68             sub id {
69 2117     2117 0 5655 my $self = shift;
70 2117         3501 my $name = $self->name();
71 2117         4455 my $id = $All->{$name}{ID};
72 2117 50       5627 carp "'ID' may be invalid: $id" unless $id =~ /^\d{3}$/;
73 2117         6724 return $id;
74             }
75              
76             sub types {
77 6227     6227 0 10163 my $self = shift;
78 6227         13384 my $name = $self->name();
79 6227         12934 my $typesref = $All->{$name}{Types};
80 6227 50       12452 carp "'Types' may be invalid: $typesref" unless ref $typesref eq 'ARRAY';
81 6227         82521 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 685     685 0 1015 my $self = shift;
112 685         1309 return Data::Pokemon::Go::Relation->new( types => $self->types() )->effective();
113             };
114              
115             sub invalid {
116 685     685 0 918 my $self = shift;
117 685         1251 return Data::Pokemon::Go::Relation->new( types => $self->types() )->invalid();
118             };
119              
120             sub advantage {
121 685     685 0 908 my $self = shift;
122 685         1344 return Data::Pokemon::Go::Relation->new( types => $self->types() )->advantage();
123             };
124              
125             sub disadvantage {
126 685     685 0 911 my $self = shift;
127 685         1226 return Data::Pokemon::Go::Relation->new( types => $self->types() )->disadvantage();
128             };
129              
130             sub recommended {
131 1370     1370 0 3309 my $self = shift;
132 1370         2802 return Data::Pokemon::Go::Relation->new( types => $self->types() )->recommended();
133             };
134              
135             sub stamina {
136 1725     1725 0 2176 my $self = shift;
137 1725         3451 my $name = $self->name();
138 1725 50       3979 croak "'Stamina' is undefined for $name" unless exists $All->{$name}{'Stamina'};
139 1725         5008 return $All->{$name}{Stamina};
140             }
141              
142             sub attack {
143 1725     1725 0 1943 my $self = shift;
144 1725         3362 my $name = $self->name();
145 1725 50       3783 croak "'Attack' is undefined for $name" unless exists $All->{$name}{'Attack'};
146 1725         5182 return $All->{$name}{Attack};
147             }
148              
149             sub defense {
150 1725     1725 0 2119 my $self = shift;
151 1725         3102 my $name = $self->name();
152 1725 50       3392 croak "'Defense' is undefined for $name" unless exists $All->{$name}{'Defense'};
153 1725         4389 return $All->{$name}{Defense};
154             }
155              
156             sub max {
157 1040     1040 0 302871 my $self = shift;
158 1040         1249 my $when = shift;
159 1040 50       4641 croak "Unvalid param $when into sub max()"
160             unless $when =~ /(:?Boosted|Hatched|Grown)/;
161              
162 1040         2600 my $name = $self->name();
163 1040 50       2989 croak "'$when' is undefined for $name" unless exists $All->{$name}{'MAXCP'}{$when};
164 1040         4469 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 685     685 0 883 my $self = shift;
175 685         1535 my $name = $self->name();
176 685         1629 return $All->{$name}{'isNotAvailable'};
177             }
178              
179             sub hasOtherForm {
180 642     642 0 1145 my $self = shift;
181 642         835 my $name = $self->name();
182 642         1038 return $All->{$name}{'hasOtherForm'};
183             }
184              
185             sub hasForms {
186 747     747 0 1491 my $self = shift;
187 747         996 my $name = $self->name();
188 747 100       1885 return exists $All->{$name}{'Form'}? $All->{$name}{'Form'} : 0;
189             }
190              
191             sub get_fullname {
192 4795     4795 0 52332 my $self = shift;
193 4795         4061 my $ref = shift;
194 4795         7923 my $fullname = $self->get_Pokemon_name($ref);
195 4795 100       6476 $fullname .= '(' . $ref->{'Form'} . ')' if exists $ref->{'Form'};
196 4795         6370 return $fullname;
197             }
198              
199             sub get_Pokemon_name {
200 4857     4857 0 4332 my $self = shift;
201 4857         4386 my $ref = shift;
202 4857         86445 my $lang = $self->lang();
203 4857 50       7879 croak "No name for $lang" unless exists $ref->{'Name'}{$lang};
204 4857         6639 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