File Coverage

blib/lib/XML/Essex/Filter/OutputMonitor.pm
Criterion Covered Total %
statement 72 79 91.1
branch 20 36 55.5
condition 7 24 29.1
subroutine 16 16 100.0
pod 11 12 91.6
total 126 167 75.4


line stmt bran cond sub pod time code
1             package XML::Essex::Filter::OutputMonitor;
2              
3             $VERSION = 0.000_1;
4              
5             =head1 NAME
6              
7             XML::Essex::Filter::OutputMonitor - Enforce and cajol Essex output
8              
9             =head1 SYNOPSIS
10              
11             ## Internal use only
12              
13             =head1 DESCRIPTION
14              
15             Used by XML::Generator::Essex and XML::Filter::Essex instances to watch
16             what's emitted downstream so as to capture result codes and notice
17             incomplete documents.
18              
19             Fills in partially filled end_element events and dies on mismatched
20             end_element events. Fills in missing start_document and end_document
21             events (unless L is
22             cleared).
23              
24             NOTE: This could actually fill in missing end_element events, but I
25             think that would lead to subtle bugs and would not help in many cases.
26             It's safer to leave it out and we can always add this feature in the
27             future, whereas taking it out would be difficult.
28              
29             Returns a 1 from the end_document if no downstream handler is found.
30              
31             =for test_script XML-Generator-Essex.t
32              
33             =head2 Methods
34              
35             =over
36              
37             =cut
38              
39 3     3   6388 use XML::SAX::Base ();
  3         23159  
  3         178  
40             @ISA = qw( XML::SAX::Base );
41              
42             # Not sure why Carp is still reporting errors in XML::Essex.
43             @CARP_NOT = ( @ISA, qw( XML::Essex XML::Essex::Event XML::Filter::Essex ) );
44              
45 3     3   23 use strict;
  3         5  
  3         112  
46 3     3   18 use Carp ();
  3         4  
  3         79  
47 3     3   945 use XML::Essex::Model ();
  3         6  
  3         3135  
48              
49             sub new {
50 1     1 0 23 my $self = shift->SUPER::new( @_ );
51 1         45 $self->auto_document_events( 1 );
52 1         8 return $self;
53             }
54              
55              
56             sub start_document {
57 1     1 1 2 my $self = shift;
58              
59 1         3 $self->start_document_seen( 1 );
60 1         3 $self->end_document_seen( 0 );
61 1         2 $self->end_document_result( undef );
62 1         2 $self->end_document_result_has_been_set( 0 );
63 1         3 $self->{Stack} = [];
64              
65 1         9 $self->SUPER::start_document( @_ );
66             }
67              
68              
69             sub start_element {
70 1     1 1 2 my $self = shift;
71              
72 1 50 33     3 $self->start_document( {} )
73             if $self->auto_document_events
74             && ! $self->start_document_seen;
75              
76 1         43 push @{$self->{Stack}}, $_[0];
  1         4  
77              
78 1         11 $self->SUPER::start_element( @_ );
79             }
80              
81             sub end_element {
82 1     1 1 3 my $self = shift;
83 1         2 my ( $elt ) = @_;
84              
85 1         2 my $s = $self->{Stack};
86              
87 1 50       5 Carp::croak "extra end_element at end of document:
88             XML::Essex::Model::_render_event_name( $elt ),
89             ">"
90             unless @$s;
91              
92             # Only DWIM if nothing has been set so that partially built
93             # end_elements are more likely to cause downstream errors.
94 1 50 33     19 if ( ! defined $elt->{NamespaceURI}
      33        
      33        
95             && ! defined $elt->{LocalName}
96             && ! defined $elt->{Prefix}
97             && ! defined $elt->{Name}
98             ) {
99 1         4 @{$elt}{qw(
  1         3  
100             NamespaceURI
101             LocalName
102             Prefix
103             Name
104 1         2 )} = @{$s->[-1]}{qw(
105             NamespaceURI
106             LocalName
107             Prefix
108             Name
109             )};
110             }
111              
112 1 50       5 my $ns_uri = defined $elt->{NamespaceURI}
113             ? $elt->{NamespaceURI}
114             : "";
115              
116 1 50 33     20 if ( $s->[-1]->{LocalName} eq $elt->{LocalName}
    50          
117             && (
118             defined $s->[-1]->{NamespaceURI}
119             ? $s->[-1]->{NamespaceURI}
120             : ""
121             )
122             eq $ns_uri
123             ) {
124 1         3 pop @$s;
125             }
126             else {
127 0         0 my @missing;
128 0         0 for ( reverse @$s ) {
129             last
130 0 0 0     0 if $_->{LocalName} eq $elt->{LocalName}
    0          
131             && (
132             defined $_->{NamespaceURI}
133             ? $_->{NamespaceURI}
134             : ""
135             ) eq $ns_uri;
136 0         0 push @missing, $_;
137             }
138              
139 0 0       0 Carp::croak( "end_element mismatch: expected
140             XML::Essex::Model::_render_event_name( $s->[-1] ),
141             ">, got
142             XML::Essex::Model::_render_event_name( $elt ),
143             ">",
144             ! @missing
145             ? ()
146             : (
147             ". These may have been skipped: ",
148             map "
149             . XML::Essex::Model::_render_event_name( $_ )
150             . ">",
151             @missing
152             ),
153             );
154             }
155              
156 1         12 $self->SUPER::end_element( @_ );
157             }
158              
159              
160             sub end_document {
161 1     1 1 2 my $self = shift;
162              
163 1         3 $self->end_document_seen( 1 );
164              
165 1 50       3 Carp::croak( "end_document sent but no start_document" )
166             unless $self->{Stack};
167              
168 1 50       2 if ( @{$self->{Stack}} ) {
  1         4  
169 0         0 Carp::croak( "missing end_element(s) at end of document: ",
170             map "
171             . XML::Essex::Model::_render_event_name( $_ )
172             . ">",
173 0         0 reverse @{$self->{Stack}}
174             );
175             }
176              
177 1         3 delete $self->{Stack};
178              
179             # Use a scalar to catch the result so a return of ()
180             # converts to "undef".
181 1 50       7 my $r = $self->SUPER::get_handler
182             ? $self->SUPER::end_document( @_ )
183             : 1;
184              
185 1         21 $self->end_document_result( $r );
186 1         3 return $r;
187             }
188              
189              
190             =item reset
191              
192             Undefines all state variables.
193              
194             =cut
195              
196             sub reset {
197 1     1 1 11 my $self = shift;
198              
199 1         4 $self->start_document_seen( undef );
200 1         4 $self->end_document_seen( undef );
201 1         3 $self->end_document_result( undef );
202 1         4 $self->end_document_result_has_been_set( 0 );
203             }
204              
205              
206             =item finish
207              
208             Emits an end_doc if need be.
209              
210             =cut
211              
212             sub finish {
213 1     1 1 9 my $self = shift;
214              
215 1 50 33     2 $self->end_document( {} )
      33        
216             if $self->auto_document_events
217             && $self->start_document_seen
218             && ! $self->end_document_seen;
219             }
220              
221              
222             =item start_document_seen
223              
224             Sets/gets whether the start_document event was seen.
225              
226             =cut
227              
228             sub start_document_seen {
229 5     5 1 7 my $self = shift;
230 5 100       13 $self->{EssexStartDocumentSeen} = shift if @_;
231 5         24 return $self->{EssexStartDocumentSeen};
232             }
233              
234             =item end_document_seen
235              
236             Sets/gets whether the end_document event was seen. Will be set if the
237             downstream filter's C throws an exception.
238              
239             =cut
240              
241             sub end_document_seen {
242 5     5 1 8 my $self = shift;
243 5 100       18 $self->{EssexEndDocumentSeen} = shift if @_;
244 5         20 return $self->{EssexEndDocumentSeen};
245             }
246              
247             =item end_document_result
248              
249             Sets/gets the result returned by the downstream filter's C
250             event handler. Set to undef if nothing else, for instance if the
251             downstream C throws an exception.
252              
253             =cut
254              
255             sub end_document_result {
256 4     4 1 6 my $self = shift;
257 4 100       11 if ( @_ ) {
258 3         6 $self->{EssexEndDocumentResult} = shift;
259 3         5 $self->{EssexEndDocumentResultHasBeenSet} = 1;
260             }
261 4         11 return $self->{EssexEndDocumentResult};
262             }
263              
264             =item end_document_result_has_been_set
265              
266             Set if the end_document_result() has been called.
267              
268             =cut
269              
270             sub end_document_result_has_been_set {
271 3     3 1 4 my $self = shift;
272 3 100       8 $self->{EssexEndDocumentResultHasBeenSet} = shift if @_;
273 3         12 return $self->{EssexEndDocumentResultHasBeenSet};
274             }
275              
276             =item auto_document_events
277              
278             When set (the default), a start_document will be emitted before the
279             first event unless it is start_document event and an end_document will
280             be emitted after the last event unless an end_document was emitted.
281             When cleared, this automation does not occur. The automatic end_document
282             will not be emitted if an exception is thrown so as not to cause
283             a stateful downstream handler to throw an additional exception.
284              
285             This does allow well-balanced chunks of XML to be emitted, but there
286             will be start_ and end_document events around them. Clear this
287             member is you don't want to emit them, or if you want to emit them
288             yourself.
289              
290             This is not affected by L.
291              
292             =cut
293              
294             sub auto_document_events {
295 3     3 1 5 my $self = shift;
296 3 100       9 $self->{AutoDocumentEvents} = shift if @_;
297 3         20 return $self->{AutoDocumentEvents};
298             }
299              
300             =back
301              
302             =head1 LIMITATIONS
303              
304             =head1 COPYRIGHT
305              
306             Copyright 2002, R. Barrie Slaymaker, Jr., All Rights Reserved
307              
308             =head1 LICENSE
309              
310             You may use this module under the terms of the BSD, Artistic, oir GPL licenses,
311             any version.
312              
313             =head1 AUTHOR
314              
315             Barrie Slaymaker
316              
317             =cut
318              
319             1;