File Coverage

blib/lib/Text/Parser/Multiline.pm
Criterion Covered Total %
statement 57 57 100.0
branch 22 22 100.0
condition 3 3 100.0
subroutine 15 15 100.0
pod n/a
total 97 97 100.0


line stmt bran cond sub pod time code
1 9     9   6112 use strict;
  9         23  
  9         276  
2 9     9   46 use warnings;
  9         17  
  9         438  
3              
4             package Text::Parser::Multiline 0.927;
5              
6             # ABSTRACT: Adds multi-line support to the Text::Parser object.
7              
8 9     9   50 use Moose::Role;
  9         17  
  9         79  
9              
10              
11             requires(
12                 qw(save_record multiline_type lines_parsed __read_file_handle),
13                 qw(join_last_line is_line_continued _set_this_line this_line)
14             );
15              
16 9     9   46174 use Text::Parser::Errors;
  9         20  
  9         7028  
17              
18             around save_record => \&__around_save_record;
19             around is_line_continued => \&__around_is_line_continued;
20             after __read_file_handle => \&__after__read_file_handle;
21              
22             my $orig_save_record = sub {
23                 return;
24             };
25              
26             my %save_record_proc = (
27                 join_last => \&__join_last_proc,
28                 join_next => \&__join_next_proc,
29             );
30              
31             sub __around_save_record {
32 260     260   3021     my ( $orig, $self ) = ( shift, shift );
33 260         385     $orig_save_record = $orig;
34 260 100       594     return $orig->( $self, @_ ) if not defined $self->multiline_type;
35 229         538     my $type = $self->multiline_type;
36 229         671     $save_record_proc{$type}->( $orig, $self, @_ );
37             }
38              
39             sub __around_is_line_continued {
40 231     231   2949     my ( $orig, $self, $line ) = ( shift, shift, shift );
41 231 100 100     531     return $orig->( $self, $line )
42                     if not defined $self->multiline_type
43                     or $self->multiline_type eq 'join_next';
44 114 100       372     return 0 if not $orig->( $self, $line );
45 67 100       1725     return 1 if $self->lines_parsed() > 1;
46 3         22     die unexpected_cont( line => $line );
47             }
48              
49             sub __after__read_file_handle {
50 31     31   246     my $self = shift;
51 31 100       98     return if not defined $self->multiline_type;
52 28 100       138     return $self->__test_safe_eof()
53                     if $self->multiline_type eq 'join_next';
54 20         57     $self->_set_this_line( $self->__pop_last_line );
55 20         539     $orig_save_record->( $self, $self->this_line );
56             }
57              
58             sub __test_safe_eof {
59 8     8   14     my $self = shift;
60 8         21     my $last = $self->__pop_last_line();
61 8 100       37     return if not defined $last;
62 3         92     my $lnum = $self->lines_parsed();
63 3         28     die unexpected_eof( discontd => $last, line_num => $lnum );
64             }
65              
66             sub __join_next_proc {
67 116     116   221     my ( $orig, $self ) = ( shift, shift );
68 116         352     $self->__append_last_stash(@_);
69 116 100       368     return if $self->is_line_continued(@_);
70 17         56     $self->__call_orig_save_rec($orig);
71             }
72              
73             sub __call_orig_save_rec {
74 44     44   87     my $self = shift;
75 44         66     my $orig = shift;
76 44         89     $self->_set_this_line( $self->__pop_last_line );
77 44         1208     $orig->( $self, $self->this_line );
78             }
79              
80             sub __join_last_proc {
81 113     113   269     my ( $orig, $self ) = ( shift, shift );
82 113 100       249     return $self->__append_last_stash(@_) if $self->__more_may_join_last(@_);
83 27         89     $self->__call_orig_save_rec($orig);
84 27         465     $self->__append_last_stash(@_);
85             }
86              
87             sub __more_may_join_last {
88 113     113   324     my $self = shift;
89 113 100       279     $self->is_line_continued(@_) or not defined $self->_joined_line;
90             }
91              
92             has _joined_line => (
93                 is => 'rw',
94                 isa => 'Str|Undef',
95                 default => undef,
96                 clearer => '_delete_joined_line',
97             );
98              
99             sub __append_last_stash {
100 226     226   410     my ( $self, $line ) = @_;
101 226 100       6281     return $self->_joined_line($line) if not defined $self->_joined_line;
102 159         421     my $joined_line = $self->join_last_line( $self->__pop_last_line, $line );
103 159         5618     $self->_joined_line($joined_line);
104             }
105              
106             sub __pop_last_line {
107 231     231   327     my $self = shift;
108 231         6854     my $last_line = $self->_joined_line();
109 231         7795     $self->_delete_joined_line;
110 231         1430     return $last_line;
111             }
112              
113 9     9   81 no Moose::Role;
  9         17  
  9         52  
114              
115              
116             1;
117              
118             __END__
119            
120             =pod
121            
122             =encoding UTF-8
123            
124             =head1 NAME
125            
126             Text::Parser::Multiline - Adds multi-line support to the Text::Parser object.
127            
128             =head1 VERSION
129            
130             version 0.927
131            
132             =head1 SYNOPSIS
133            
134             use Text::Parser;
135            
136             my $parser = Text::Parser->new(multiline_type => 'join_last');
137             $parser->read('filename.txt');
138             print $parser->get_records();
139             print scalar($parser->get_records()), " records were read although ",
140             $parser->lines_parsed(), " lines were parsed.\n";
141            
142             =head1 RATIONALE
143            
144             Some text formats allow line-wrapping with a continuation character, usually to improve human readability. To handle these types of text formats with the native L<Text::Parser> class, the derived class would need to have a C<save_record> method that would:
145            
146             =over 4
147            
148             =item *
149            
150             Detect if the line is wrapped or is part of a wrapped line. To do this the developer has to implement a function named C<L<is_line_continued|Text::Parser/is_line_continued>>.
151            
152             =item *
153            
154             Join any wrapped lines to form a single line. For this, the developer has to implement a function named C<L<join_last_line|Text::Parser/join_last_line>>.
155            
156             =back
157            
158             With these two things, the developer can implement their C<L<save_record|Text::Parser/save_record>> assuming that the line is already unwrapped.
159            
160             =head1 OVERVIEW
161            
162             This role may be composed into an object of the L<Text::Parser> class. To use this role, just set the C<L<multiline_type|Text::Parser/multiline_type>> attribute. A derived class may set this in their constructor (or C<BUILDARGS> if you use L<Moose>). If this option is set, the developer should re-define the C<is_line_continued> and C<join_last_line> methods.
163            
164             =head1 ERRORS AND EXCEPTIONS
165            
166             It should also look for the following error conditions (see L<Text::Parser::Errors>):
167            
168             =over 4
169            
170             =item *
171            
172             If the end of file is reached, and the line is expected to be still continued, an exception of C<L<Text::Parser::Errors::UnexpectedEof|Text::Parser::Errors/"Text::Parser::Errors::UnexpectedEof">> is thrown.
173            
174             =item *
175            
176             It is impossible for the first line in a text input to be wrapped from a previous line. So if this condition occurs, an exception of C<L<Text::Parser::Errors::UnexpectedCont|Text::Parser::Errors/"Text::Parser::Errors::UnexpectedCont">> is thrown.
177            
178             =back
179            
180             =head1 METHODS TO BE IMPLEMENTED
181            
182             These methods must be implemented by the developer in the derived class. There are default implementations provided in L<Text::Parser> but they may not handle your target text format.
183            
184             =head2 C<< $parser->is_line_continued($line) >>
185            
186             Takes a string argument containing the current line (also available through the C<this_line> method) as input. Your implementation should return a boolean that indicates if the current line is wrapped.
187            
188             sub is_line_continued {
189             my ($self, $line) = @_;
190             chomp $line;
191             $line =~ /\\\s*$/;
192             }
193            
194             The above example method checks if a line is being continued by using a back-slash character (C<\>).
195            
196             =head2 C<< $parser->join_last_line($last_line, $current_line) >>
197            
198             Takes two string arguments. The first is the previously read line which is wrapped in the next line (the second argument). The second argument should be identical to the return value of C<L<this_line|Text::Parser/"this_line">>. Neither argument will be C<undef>. Your implementation should join the two strings stripping any continuation character(s), and return the resultant string.
199            
200             Here is an example implementation that joins the previous line terminated by a back-slash (C<\>) with the present line:
201            
202             sub join_last_line {
203             my $self = shift;
204             my ($last, $line) = (shift, shift);
205             $last =~ s/\\\s*$//g;
206             return "$last $line";
207             }
208            
209             =head1 SEE ALSO
210            
211             =over 4
212            
213             =item *
214            
215             L<Text::Parser>
216            
217             =item *
218            
219             L<Text::Parser::Errors>
220            
221             =back
222            
223             =head1 BUGS
224            
225             Please report any bugs or feature requests on the bugtracker website
226             L<http://github.com/balajirama/Text-Parser/issues>
227            
228             When submitting a bug or request, please include a test-file or a
229             patch to an existing test-file that illustrates the bug or desired
230             feature.
231            
232             =head1 AUTHOR
233            
234             Balaji Ramasubramanian <balajiram@cpan.org>
235            
236             =head1 COPYRIGHT AND LICENSE
237            
238             This software is copyright (c) 2018-2019 by Balaji Ramasubramanian.
239            
240             This is free software; you can redistribute it and/or modify it under
241             the same terms as the Perl 5 programming language system itself.
242            
243             =cut
244