File Coverage

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