File Coverage

blib/lib/App/ForKids/LogicalPuzzleGenerator/Variable/Animal.pm
Criterion Covered Total %
statement 12 39 30.7
branch 0 2 0.0
condition n/a
subroutine 4 13 30.7
pod 9 9 100.0
total 25 63 39.6


line stmt bran cond sub pod time code
1             package App::ForKids::LogicalPuzzleGenerator::Variable::Animal;
2              
3 1     1   6 use strict;
  1         2  
  1         23  
4 1     1   4 use warnings FATAL => 'all';
  1         1  
  1         23  
5 1     1   4 use Carp;
  1         2  
  1         37  
6 1     1   4 use base 'App::ForKids::LogicalPuzzleGenerator::Variable';
  1         2  
  1         405  
7              
8              
9              
10             =head1 NAME
11              
12             App::ForKids::LogicalPuzzleGenerator::Variable::Animal
13              
14             =head1 VERSION
15              
16             Version 0.01
17              
18             =cut
19              
20             our $VERSION = '0.01';
21              
22              
23             =head1 SYNOPSIS
24              
25             The module is used by the App::ForKids::LogicalPuzzleGenerator.
26              
27             use App::ForKids::LogicalPuzzleGenerator;
28              
29             =cut
30              
31             our @pets =
32             (
33             "dog",
34             "cat",
35             "parrot",
36             "owl",
37             "wolf",
38             "bat"
39             );
40              
41              
42              
43              
44             =head1 SUBROUTINES/METHODS
45              
46             =head2 new
47              
48             =cut
49              
50             sub new
51             {
52 0     0 1   my $class = shift;
53 0           my $this = $class->SUPER::new(@_);
54              
55             # select the pets
56 0           for my $i (0..$$this{amount_of_values}-1)
57             {
58 0           while (1)
59             {
60 0           my $value = $pets[int(rand()*@pets)];
61 0 0         if (!grep {$_ eq $value } @{$$this{selected_values}})
  0            
  0            
62             {
63 0           push @{$$this{selected_values}}, $value;
  0            
64 0           last;
65             }
66             }
67             }
68 0           return $this;
69             }
70              
71             =head2 get_description
72              
73             =cut
74              
75              
76             sub get_description
77             {
78 0     0 1   return "Each has a different pet";
79             }
80              
81             =head2 get_description_I
82              
83             =cut
84              
85             sub get_description_I
86             {
87 0     0 1   my ($this, $animal) = @_;
88 0           return sprintf("I have a %s.", $animal);
89             }
90              
91             =head2 get_description_I_dont
92              
93             =cut
94              
95              
96             sub get_description_I_dont
97             {
98 0     0 1   my ($this, $animal) = @_;
99 0           return sprintf("I don't have a %s.", $animal);
100             }
101              
102             =head2 get_description_he_does_not
103              
104             =cut
105              
106              
107             sub get_description_he_does_not
108             {
109 0     0 1   my ($this, $animal) = @_;
110 0           return sprintf("does not have a %s.", $animal);
111             }
112              
113              
114             =head2 get_description_the_one_who
115              
116             =cut
117              
118             sub get_description_the_one_who
119             {
120 0     0 1   my ($this, $animal) = @_;
121 0           return sprintf("The one who has a %s", $animal);
122             }
123              
124             =head2 get_description_X_does_not
125              
126             =cut
127              
128             sub get_description_X_does_not
129             {
130 0     0 1   my ($this, $who, $animal) = @_;
131 0           return sprintf("%s does not have a %s.", $who, $animal);
132             }
133              
134             =head2 get_description_he_likes
135              
136             =cut
137              
138              
139             sub get_description_he_likes
140             {
141 0     0 1   my ($this, $animal) = @_;
142 0           return sprintf("has a %s.", $animal);
143             }
144              
145             =head2 get_description_X
146              
147             =cut
148              
149             sub get_description_X
150             {
151 0     0 1   my ($this, $who, $animal) = @_;
152 0           return sprintf("%s has a %s.", $who, $animal);
153             }
154              
155              
156              
157             =head1 AUTHOR
158              
159             Pawel Biernacki, C<< >>
160              
161             =head1 BUGS
162              
163             Please report any bugs or feature requests to C, or through
164             the web interface at L. I will be notified, and then you'll
165             automatically be notified of progress on your bug as I make changes.
166              
167              
168             =cut
169              
170             1;