File Coverage

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