File Coverage

lib/Don/Mendo/Jornada.pm
Criterion Covered Total %
statement 61 65 93.8
branch 10 10 100.0
condition 3 6 50.0
subroutine 8 10 80.0
pod 6 6 100.0
total 88 97 90.7


line stmt bran cond sub pod time code
1             package Don::Mendo::Jornada;
2              
3 1     1   6 use warnings;
  1         3  
  1         27  
4 1     1   6 use strict;
  1         2  
  1         27  
5 1     1   6 use Carp;
  1         1  
  1         73  
6              
7             our $VERSION = "0.0.4";
8              
9             # Other recommended modules (uncomment to use):
10             # use IO::Prompt;
11             # use Perl6::Export;
12             # use Perl6::Slurp;
13             # use Perl6::Say;
14              
15 1     1   498 use Don::Mendo::Linea;
  1         2  
  1         831  
16              
17             # Module implementation here
18             sub new {
19 4     4 1 6 my $class = shift;
20 4   33     12 my $text = shift || croak "No text here!";
21 4         373 my @parts = split(/\n\n/, $text );
22 4         28 my $this_part = shift @parts;
23 4         6 my $intro;
24 4   66     25 while ( $this_part !~ / {5}[A-ZÑÍÁ y,]+\.–/ && @parts ) {
25 12         18 $intro .= $this_part;
26 12         59 $this_part = shift @parts;
27             }
28 4         13 unshift( @parts, $this_part);
29 4         266 my $lines = join( "\n\n", @parts );
30 4         19 my $self = { _text => $text,
31             _intro => $intro,
32             _linestext => $lines };
33              
34 4         1521 my @bits = ( $lines =~ / {5}([A-ZÑÍÁ y,]+)\.– (.+?)\n\n\n/gs );
35              
36 4         45 my $last_line;
37 4         10 while (@bits ) {
38 834         1059 my $actor = shift @bits;
39 834         888 my $this_line = shift @bits;
40 834 100       1724 if ( $this_line =~ /\.– / ){ #Missed split lines
41 45         344 my ($new_linea, $new_actor, $otra_linea) =
42             ($this_line =~ /(.+?) {5}([A-ZÑÍÁ y,]+)\.– (.+)/gs);
43 45         87 unshift @bits, ($new_actor, $otra_linea);
44 45         58 $this_line = $new_linea;
45             }
46 834         1803 my $line = new Don::Mendo::Linea( $actor, $this_line );
47 834         750 push @{$self->{'_lines'}}, $line;
  834         1279  
48 834 100       1373 if ( $last_line ) {
49 830         1500 $last_line->follows( $line );
50             } else {
51 4         6 $self->{'_first_line'} = $line;
52             }
53 834         1692 $last_line = $line;
54             }
55 4         103 bless $self, $class;
56            
57             }
58              
59             sub start {
60 0     0 1 0 my $self =shift;
61 0         0 return $self->{'_first_line'};
62             }
63              
64             sub text {
65 0     0 1 0 my $self = shift;
66 0         0 return $self->{'text'};
67             }
68              
69             sub lines_for_character {
70 4     4 1 14 my $self = shift;
71 4         153 my $character = uc( shift );
72 4 100       45 return $self->{'_lines'} if !$character;
73 2         3 my @these_lines;
74 2         2 for my $l (@{$self->{'_lines'}}) {
  2         5  
75 464 100       748 push(@these_lines, $l) if ($l->character() eq $character);
76             }
77 2         15 return \@these_lines;
78             }
79              
80             sub tell {
81 1     1 1 2 my $self = shift;
82 1         3 my $line = $self->{'_first_line'};
83 1         1 my $text;
84 1         2 do {
85 256         419 $text .= "\t".$line->character()." - ".$line->say()."\n\n";
86             }while ($line = $line->{'_follows'});
87 1         38 return $text;
88             }
89              
90             sub actors{
91 1     1 1 2 my $self = shift;
92 1         2 my %actors;
93 1         1 for my $l ( @{$self->{'_lines'}} ) {
  1         3  
94 256 100       407 if ( !$actors{$l->character()} ) {
95 18         32 $actors{$l->character()} = $l;
96             }
97             }
98 1         3 return \%actors;
99             }
100              
101             1; # Magic true value required at end of module
102              
103              
104             =head1 NAME
105              
106             Don::Mendo::Jornada - Each one of the acts of the Don Mendo play
107              
108             =head1 VERSION
109              
110             This document describes Don::Mendo::Jornada version 0.0.3.
111              
112              
113             =head1 SYNOPSIS
114              
115             use Don::Mendo::Jornada;
116              
117            
118             =head1 DESCRIPTION
119              
120             A "jornada" is the equivalent of an act, a part of the play taking
121             place in a single setup. Don Mendo has 4 acts, first one in
122             Magdalena's tower, second one in Don Mendo's prison, third one in
123             the king's camp, and the last in the cave.
124              
125             =head1 INTERFACE
126              
127             =head2 new( $text )
128              
129             Creates a new one, and sets up lines and bits and pieces inside
130              
131             my $jornada = new Don::Mendo::Jornada( $text );
132              
133             =head2 start()
134              
135             Returns the first character line (C)
136              
137             =head2 text()
138              
139             Returns the raw text of the jornada
140              
141             =head2 lines_for_character( [ $actor ] )
142              
143             Returns the lines for a particular actor, or all of them if void
144              
145             =head2 tell()
146              
147             Follows narrative returning the whole text
148              
149             =head2 actors()
150              
151             Returns a hash with the names of the actors and their first line
152              
153              
154             =head1 CONFIGURATION AND ENVIRONMENT
155            
156             Don::Mendo requires no configuration files or environment variables.
157              
158              
159             =head1 DEPENDENCIES
160              
161             None.
162              
163             =head1 INCOMPATIBILITIES
164              
165             None reported.
166              
167              
168             =head1 BUGS AND LIMITATIONS
169              
170             No bugs have been reported.
171              
172             Please report any bugs or feature requests to
173             C, or through the web interface at
174             L.
175              
176              
177             =head1 AUTHOR
178              
179             JJ Merelo C<< >>
180              
181              
182             =head1 LICENCE AND COPYRIGHT
183              
184             Copyright (c) 2008, JJ Merelo C<< >>. All rights reserved.
185              
186             This module is free software; you can redistribute it and/or
187             modify it under the same terms as Perl itself. See L.
188              
189              
190             =head1 DISCLAIMER OF WARRANTY
191              
192             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
193             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
194             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
195             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
196             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
197             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
198             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
199             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
200             NECESSARY SERVICING, REPAIR, OR CORRECTION.
201              
202             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
203             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
204             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
205             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
206             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
207             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
208             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
209             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
210             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
211             SUCH DAMAGES.
212              
213             =cut