File Coverage

blib/lib/Pod/Eventual/Reconstruct.pm
Criterion Covered Total %
statement 55 68 80.8
branch 8 16 50.0
condition n/a
subroutine 15 18 83.3
pod 10 10 100.0
total 88 112 78.5


line stmt bran cond sub pod time code
1 6     6   133213 use 5.006;
  6         39  
  6         209  
2 6     6   26 use strict;
  6         7  
  6         169  
3 6     6   25 use warnings;
  6         7  
  6         382  
4              
5             package Pod::Eventual::Reconstruct;
6              
7             # ABSTRACT: Construct a document from Pod::Eventual events
8              
9             our $VERSION = '1.000001';
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13              
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24 6     6   520 use Moo 1.000008 qw( has ); # builder => CODE
  6         10915  
  6         35  
25 6     6   3935 use Path::Tiny qw(path);
  6         20128  
  6         369  
26 6     6   2966 use autodie qw(open close);
  6         78344  
  6         36  
27 6     6   1972 use Carp qw( croak );
  6         7  
  6         415  
28              
29              
30              
31              
32              
33             has write_handle => ( is => ro =>, required => 1 );
34              
35 6     6   27 no Moo;
  6         6  
  6         42  
36              
37              
38              
39              
40              
41              
42              
43              
44              
45              
46              
47             ## no critic (RequireArgUnpacking,RequireBriefOpen)
48             sub string_writer {
49 4     4 1 9914 my $class = $_[0];
50 4         7 my $string_write;
51              
52 4 50       15 if ( not ref $_[1] ) {
    0          
53 4         9 $string_write = \$_[1];
54             }
55             elsif ( ref $_[1] ne 'SCALAR' ) {
56 0         0 croak '->string_writer( string ) must be a scalar or scalar ref';
57             }
58             else {
59 0         0 $string_write = $_[1];
60             }
61 4         21 open my $fh, '>', $string_write;
62 4         8359 return $class->handle_writer( $fh, $_[2] );
63             }
64             ## use critic
65              
66              
67              
68              
69              
70              
71              
72              
73              
74              
75              
76             sub file_writer {
77 0     0 1 0 my ( $class, $file, $mode ) = @_;
78 0         0 return $class->handle_writer( path($file)->openw($mode) );
79             }
80              
81              
82              
83              
84              
85              
86              
87              
88              
89              
90              
91             sub file_writer_raw {
92 0     0 1 0 my ( $class, $file ) = @_;
93 0         0 return $class->handle_writer( path($file)->openw_raw() );
94             }
95              
96              
97              
98              
99              
100              
101              
102              
103              
104              
105              
106             sub file_writer_utf8 {
107 0     0 1 0 my ( $class, $file ) = @_;
108 0         0 return $class->handle_writer( path($file)->openw_utf8() );
109             }
110              
111              
112              
113              
114              
115              
116              
117              
118              
119             sub handle_writer {
120 4     4 1 10 my ( $class, $handle ) = @_;
121 4         31 return $class->new( write_handle => $handle );
122             }
123              
124              
125              
126              
127              
128              
129              
130              
131              
132              
133              
134              
135              
136             sub write_event {
137 82     82 1 9974 my ( $self, $event ) = @_;
138 82         137 my $writer = 'write_' . $event->{type};
139 82 50       312 if ( not $self->can($writer) ) {
140 0         0 croak( 'no writer for event type ' . $event->{type} );
141             }
142 82         697 return $self->$writer($event);
143             }
144              
145              
146              
147              
148              
149              
150              
151              
152              
153              
154              
155             sub write_command {
156 29     29 1 34 my ( $self, $event ) = @_;
157 29 50       98 if ( $event->{type} ne 'command' ) {
158 0         0 croak('write_command cant write anything but nonpod');
159             }
160 29         42 my $content = $event->{content};
161 29 100       246 if ( $content !~ qr{ \A \s+ \z }sx ) {
162 16         30 $content = q[ ] . $content;
163             }
164 29         144 $self->write_handle->printf( q{=%s%s}, $event->{command}, $content );
165              
166             #if ( $event->{command} ne 'cut' ){
167             # $self->write_handle->printf(qq{\n});
168             #}
169 29         283 return $self;
170             }
171              
172              
173              
174              
175              
176              
177              
178              
179              
180              
181              
182             sub write_text {
183 6     6 1 11 my ( $self, $event ) = @_;
184 6 50       76 if ( $event->{type} ne 'text' ) {
185 0         0 croak('write_text cant write anything but text');
186             }
187 6         25 $self->write_handle->print( $event->{content} );
188 6         35 return $self;
189             }
190              
191              
192              
193              
194              
195              
196              
197              
198              
199              
200              
201             sub write_nonpod {
202 16     16 1 19 my ( $self, $event ) = @_;
203 16 50       38 if ( $event->{type} ne 'nonpod' ) {
204 0         0 croak('write_nonpod cant write anything but nonpod');
205             }
206 16         89 $self->write_handle->print( $event->{content} );
207 16         113 return $self;
208              
209             }
210              
211              
212              
213              
214              
215              
216              
217              
218              
219              
220              
221             sub write_blank {
222 29     29 1 25 my ( $self, $event ) = @_;
223 29 50       65 if ( $event->{type} ne 'blank' ) {
224 0         0 croak('write_blank cant write anything but blanks');
225             }
226 29         77 $self->write_handle->print( $event->{content} );
227 29         148 return $self;
228             }
229              
230             1;
231              
232             __END__