File Coverage

blib/lib/Pod/CYOA/Transformer.pm
Criterion Covered Total %
statement 6 34 17.6
branch 0 10 0.0
condition 0 6 0.0
subroutine 2 5 40.0
pod 0 1 0.0
total 8 56 14.2


line stmt bran cond sub pod time code
1             package Pod::CYOA::Transformer 0.003;
2 1     1   60339 use Moose;
  1         415558  
  1         7  
3             with 'Pod::Elemental::Transformer';
4             # ABSTRACT: transform 'cyoa' regions
5              
6             #pod =head1 OVERVIEW
7             #pod
8             #pod Pod::CYOA::Transformer is a L<Pod::Elemental::Transformer> implementation. It
9             #pod looks for a region with the format name C<cyoa> and transforms it into a
10             #pod C<=item>-list surrounded by C<html> regions.
11             #pod
12             #pod A C<cyoa> region is written with pairs of C<?>-separated values representing
13             #pod page links and descriptions. For example:
14             #pod
15             #pod =for :cyoa
16             #pod ? pie-eating ? eat a pie
17             #pod ? start ? start over
18             #pod ? visit-lefty ? buy an "O"
19             #pod
20             #pod ...will become something like:
21             #pod
22             #pod =for html
23             #pod <div class='cyoa'>
24             #pod
25             #pod =over 4
26             #pod
27             #pod =item * If you'd like to L<eat a pie|@pie-eating>
28             #pod
29             #pod =item * If you'd like to L<start over|@start>
30             #pod
31             #pod =item * If you'd like to L<buy an "O"|@visit-lefty>
32             #pod
33             #pod =back
34             #pod
35             #pod =for html
36             #pod </div>
37             #pod
38             #pod The C<@>-prefix on the link targets is expected to be handled by
39             #pod L<Pod::CYOA::XHTML>.
40             #pod
41             #pod =cut
42              
43 1     1   7236 use Pod::Elemental::Types qw(FormatName);
  1         75953  
  1         8  
44              
45             has format_name => (
46             is => 'ro',
47             isa => FormatName,
48             default => 'cyoa',
49             );
50              
51             sub transform_node {
52 0     0 0   my ($self, $node) = @_;
53              
54 0           for my $i (reverse(0 .. $#{ $node->children })) {
  0            
55 0           my $para = $node->children->[ $i ];
56 0 0         next unless $self->__is_xformable($para);
57              
58 0           my @replacements = $self->_expand_cyoa( $para );
59 0           splice @{ $node->children }, $i, 1, @replacements;
  0            
60             }
61             }
62              
63             sub __is_xformable {
64 0     0     my ($self, $para) = @_;
65              
66 0 0 0       return unless $para->isa('Pod::Elemental::Element::Pod5::Region')
67             and $para->format_name eq $self->format_name;
68              
69 0 0         confess("CYOA regions must be non-pod (=begin " . $self->format_name . ")")
70             if $para->is_pod;
71            
72 0           return 1;
73             }
74              
75             sub _expand_cyoa {
76 0     0     my ($self, $para) = @_;
77              
78 0           my ($data, @wtf) = @{ $para->children };
  0            
79 0 0         confess "more than one child of a non-Pod region!" if @wtf;
80              
81 0           my @replacements;
82              
83 0           push @replacements, Pod::Elemental::Element::Pod5::Region->new({
84             is_pod => 0,
85             format_name => 'html',
86             content => '',
87             children => [
88             Pod::Elemental::Element::Pod5::Data->new({
89             content => "<div class='cyoa'>",
90             }),
91             ],
92             });
93              
94 0           push @replacements, Pod::Elemental::Element::Pod5::Command->new({
95             command => 'over',
96             content => 4,
97             });
98              
99 0           my @lines = split /\n/, $data->as_pod_string;
100 0           for my $line (@lines) {
101 0           my ($link, $desc) = $line =~ /\A\?\s*([-a-z0-9]+)\s*\?\s*(.+)\z/;
102 0 0 0       confess "do not understand CYOA line: $line" unless $link and $desc;
103              
104 0           push @replacements, Pod::Elemental::Element::Pod5::Command->new({
105             command => 'item',
106             content => '*',
107             });
108              
109 0           push @replacements, Pod::Elemental::Element::Pod5::Ordinary->new({
110             content => "If you'd like to L<$desc|\@$link>",
111             });
112             }
113              
114 0           push @replacements, Pod::Elemental::Element::Pod5::Command->new({
115             command => 'back',
116             content => '',
117             });
118              
119 0           push @replacements, Pod::Elemental::Element::Pod5::Region->new({
120             is_pod => 0,
121             format_name => 'html',
122             content => '',
123             children => [
124             Pod::Elemental::Element::Pod5::Data->new({
125             content => "</div>",
126             }),
127             ],
128             });
129              
130 0           return @replacements;
131             }
132              
133             1;
134              
135             __END__
136              
137             =pod
138              
139             =encoding UTF-8
140              
141             =head1 NAME
142              
143             Pod::CYOA::Transformer - transform 'cyoa' regions
144              
145             =head1 VERSION
146              
147             version 0.003
148              
149             =head1 OVERVIEW
150              
151             Pod::CYOA::Transformer is a L<Pod::Elemental::Transformer> implementation. It
152             looks for a region with the format name C<cyoa> and transforms it into a
153             C<=item>-list surrounded by C<html> regions.
154              
155             A C<cyoa> region is written with pairs of C<?>-separated values representing
156             page links and descriptions. For example:
157              
158             =for :cyoa
159             ? pie-eating ? eat a pie
160             ? start ? start over
161             ? visit-lefty ? buy an "O"
162              
163             ...will become something like:
164              
165             =for html
166             <div class='cyoa'>
167              
168             =over 4
169              
170             =item * If you'd like to L<eat a pie|@pie-eating>
171              
172             =item * If you'd like to L<start over|@start>
173              
174             =item * If you'd like to L<buy an "O"|@visit-lefty>
175              
176             =back
177              
178             =for html
179             </div>
180              
181             The C<@>-prefix on the link targets is expected to be handled by
182             L<Pod::CYOA::XHTML>.
183              
184             =head1 PERL VERSION
185              
186             This module should work on any version of perl still receiving updates from
187             the Perl 5 Porters. This means it should work on any version of perl released
188             in the last two to three years. (That is, if the most recently released
189             version is v5.40, then this module should work on both v5.40 and v5.38.)
190              
191             Although it may work on older versions of perl, no guarantee is made that the
192             minimum required version will not be increased. The version may be increased
193             for any reason, and there is no promise that patches will be accepted to lower
194             the minimum required perl.
195              
196             =head1 AUTHOR
197              
198             Ricardo SIGNES <rjbs@semiotic.systems>
199              
200             =head1 COPYRIGHT AND LICENSE
201              
202             This software is copyright (c) 2021 by Ricardo SIGNES.
203              
204             This is free software; you can redistribute it and/or modify it under
205             the same terms as the Perl 5 programming language system itself.
206              
207             =cut