File Coverage

blib/lib/Lingua/Shakespeare/Play.pm
Criterion Covered Total %
statement 60 71 84.5
branch 9 22 40.9
condition 2 5 40.0
subroutine 20 21 95.2
pod 0 18 0.0
total 91 137 66.4


line stmt bran cond sub pod time code
1             package Lingua::Shakespeare::Play;
2              
3 6     6   37 use Carp;
  6         14  
  6         545  
4 6     6   71 use strict;
  6         14  
  6         229  
5              
6 6     6   3718 use Lingua::Shakespeare::Character;
  6         185  
  6         5660  
7              
8             sub new {
9 6     6 0 28 bless {}
10             }
11              
12             sub declare_character {
13 39     39 0 59 my $self = shift;
14 39         59 my $name = shift;
15 39 50       168 carp "Duplicate declaration of $name"
16             if $self->{character}{lc $name};
17              
18 39         133 $self->{character}{lc $name} = Lingua::Shakespeare::Character->new($name);
19             }
20              
21             sub enter_scene {
22 12280     12280 0 16481 my $self = shift;
23 12280         18132 my $char = shift;
24              
25 12280 50       48572 carp $char->name . " is already on stage"
26             if $self->{stage}{$char};
27              
28 12280         68924 $self->{stage}{$char} = $char;
29             }
30              
31             sub activate_character {
32 14455     14455 0 34459 my $self = shift;
33 14455         31605 my $char = shift;
34              
35 14455 50       70917 croak $char->name . " is not on stage"
36             unless $self->{stage}{$char};
37              
38 14455         66890 $self->{active} = $char;
39             }
40              
41             sub first_person {
42 2380     2380 0 3621 my $self = shift;
43 2380         8860 $self->{active};
44             }
45              
46             sub second_person {
47 19990     19990 0 36083 my $self = shift;
48              
49 19990   50     83935 my $stage = $self->{stage} ||= {};
50 19990         32954 my $on_stage = keys %$stage;
51 19990         33895 my $active = $self->{active};
52              
53 19990 50 33     166087 return (grep { $_ != $active } values %$stage)[0]
  39980         242437  
54             if $on_stage == 2 and $active;
55              
56 0 0       0 croak "Nobody on stage"
57             unless $on_stage;
58              
59 0 0       0 croak "Only " . (values %$stage)[0]->name . " is on stage"
60             if $on_stage == 1;
61              
62 0 0       0 croak "More than two characters on stage"
63             if $on_stage > 2;
64              
65 0         0 croak "No active character";
66             }
67              
68             sub exit_scene {
69 9156     9156 0 16795 my $self = shift;
70 9156         10265 my $char = shift;
71              
72 9156 50       79355 carp $char->name . " is not on stage"
73             unless delete $self->{stage}{$char};
74              
75 9156 100       36120 if (my $active = $self->{active}) {
76 9131 100       78950 delete $self->{active} if $active == $char;
77             }
78             }
79              
80             sub int_twice {
81 1     1 0 2 my $self = shift;
82 1         2 my $value = shift;
83 1         4 2 * $value;
84             }
85              
86             sub int_square {
87 3     3 0 6 my $self = shift;
88 3         5 my $value = shift;
89 3         22 $value * $value;
90             }
91              
92             sub int_sqrt {
93 99     99 0 122 my $self = shift;
94 99         201 my $value = shift;
95 99         379 sqrt($value);
96             }
97              
98             sub int_cube {
99 3     3 0 4 my $self = shift;
100 3         5 my $value = shift;
101 3         14 $value * $value * $value;
102             }
103              
104             sub int_add {
105 9896     9896 0 12350 my $self = shift;
106 9896         66522 $_[0] + $_[1];
107             }
108              
109             sub int_mod {
110 236     236 0 278 my $self = shift;
111 236         555 $_[0] % $_[1];
112             }
113              
114             sub int_sub {
115 2823     2823 0 5876 my $self = shift;
116 2823         16406 $_[0] - $_[1];
117             }
118              
119             sub int_mul {
120 3     3 0 4 my $self = shift;
121 3         18 $_[0] * $_[1];
122             }
123              
124             sub int_div {
125 12     12 0 16 my $self = shift;
126 12         49 int($_[0] / $_[1]);
127             }
128              
129             sub int_factorial {
130 0     0 0 0 my $self = shift;
131 0         0 my $value = shift;
132              
133 0 0       0 if ($value == 0) {
134 0         0 $value = 1;
135             }
136 0         0 for (my $i = $value - 1; $i > 1; $i--) {
137 0         0 $value *= $i;
138             }
139              
140 0         0 $value;
141             }
142              
143              
144              
145             sub exit_scene_all {
146 1561     1561 0 3323 my $self = shift;
147 1561         3321 $self->{stage} = {};
148 1561         7572 delete $self->{active};
149             }
150              
151              
152             1;
153