File Coverage

blib/lib/HTTP/OAI/SAXHandler.pm
Criterion Covered Total %
statement 58 110 52.7
branch 8 14 57.1
condition 2 7 28.5
subroutine 14 41 34.1
pod 17 24 70.8
total 99 196 50.5


line stmt bran cond sub pod time code
1             package HTTP::OAI::SAXHandler;
2              
3 11     11   66 use strict;
  11         24  
  11         299  
4 11     11   55 use warnings;
  11         18  
  11         479  
5              
6 11     11   63 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  11         26  
  11         756  
7              
8 11     11   68 use Data::Dumper; # debugging for here
  11         17  
  11         15178  
9              
10             our $VERSION = '4.11';
11              
12             @ISA = qw( Exporter XML::SAX::Base );
13              
14             @EXPORT_OK = qw( g_start_document g_start_element g_end_element g_data_element );
15             %EXPORT_TAGS = (SAX=>[qw( g_start_document g_start_element g_end_element g_data_element )]);
16              
17             =pod
18              
19             =head1 NAME
20              
21             HTTP::OAI::SAXHandler - SAX2 utility filter
22              
23             =head1 DESCRIPTION
24              
25             This module provides utility methods for SAX2, including collapsing multiple "characters" events into a single event.
26              
27             This module exports methods for generating SAX2 events with Namespace support. This *isn't* a fully-fledged SAX2 generator!
28              
29             =over 4
30              
31             =item $h = HTTP::OAI::SAXHandler->new()
32              
33             Class constructor.
34              
35             =cut
36              
37             sub new {
38 2     2 1 10 my ($class,%args) = @_;
39 2   33     12 $class = ref($class) || $class;
40 2         20 my $self = $class->SUPER::new(%args);
41 2         131 $self->{Depth} = 0;
42 2         23 $self;
43             }
44              
45             sub g_start_document {
46 0     0 0 0 my ($handler) = @_;
47 0         0 $handler->start_document();
48 0         0 $handler->start_prefix_mapping({
49             'Prefix'=>'xsi',
50             'NamespaceURI'=>'http://www.w3.org/2001/XMLSchema-instance'
51             });
52 0         0 $handler->start_prefix_mapping({
53             'Prefix'=>'',
54             'NamespaceURI'=>'http://www.openarchives.org/OAI/2.0/'
55             });
56             }
57              
58             sub g_data_element {
59 0     0 0 0 my ($handler,$uri,$qName,$attr,$value) = @_;
60 0         0 g_start_element($handler,$uri,$qName,$attr);
61 0 0       0 if( ref($value) ) {
62 0         0 $value->set_handler($handler);
63 0         0 $value->generate;
64             } else {
65 0         0 $handler->characters({'Data'=>$value});
66             }
67 0         0 g_end_element($handler,$uri,$qName);
68             }
69              
70             sub g_start_element {
71 0     0 0 0 my ($handler,$uri,$qName,$attr) = @_;
72 0   0     0 $attr ||= {};
73 0         0 my ($prefix,$localName) = split /:/, $qName;
74 0 0       0 unless(defined($localName)) {
75 0         0 $localName = $prefix;
76 0         0 $prefix = '';
77             }
78             $handler->start_element({
79 0         0 'NamespaceURI'=>$uri,
80             'Name'=>$qName,
81             'Prefix'=>$prefix,
82             'LocalName'=>$localName,
83             'Attributes'=>$attr
84             });
85             }
86              
87             sub g_end_element {
88 0     0 0 0 my ($handler,$uri,$qName) = @_;
89 0         0 my ($prefix,$localName) = split /:/, $qName;
90 0 0       0 unless(defined($localName)) {
91 0         0 $localName = $prefix;
92 0         0 $prefix = '';
93             }
94             $handler->end_element({
95 0         0 'NamespaceURI'=>$uri,
96             'Name'=>$qName,
97             'Prefix'=>$prefix,
98             'LocalName'=>$localName,
99             });
100             }
101              
102             sub current_state {
103 0     0 0 0 my $self = shift;
104 0         0 return $self->{State}->[$#{$self->{State}}];
  0         0  
105             }
106              
107             sub current_element {
108 0     0 0 0 my $self = shift;
109 0         0 return $self->{Elem}->[$#{$self->{Elem}}];
  0         0  
110             }
111              
112             sub start_document {
113 2     2 1 385 HTTP::OAI::Debug::sax( Dumper($_[1]) );
114 2         18 $_[0]->SUPER::start_document();
115             }
116              
117             sub end_document {
118 2     2 1 159 $_[0]->SUPER::end_document();
119 2         71 HTTP::OAI::Debug::sax( Dumper($_[1]) );
120             }
121              
122             # Char data is rolled together by this module
123             sub characters {
124 17     17 1 673 my ($self,$hash) = @_;
125 17         67 $self->{Text} .= $hash->{Data};
126             # characters are traced in {start,end}_element
127             #HTTP::OAI::Debug::sax( "'" . substr($hash->{Data},0,40) . "'" );
128             }
129              
130             sub start_element {
131 15     15 1 1475 my ($self,$hash) = @_;
132 15         19 push @{$self->{Attributes}}, $hash->{Attributes};
  15         34  
133              
134             # Call characters with the joined character data
135 15 100       36 if( defined($self->{Text}) )
136             {
137 4         19 HTTP::OAI::Debug::sax( "'".substr($self->{Text},0,40) . "'" );
138 4         16 $self->SUPER::characters({Data=>$self->{Text}});
139 4         68 $self->{Text} = undef;
140             }
141              
142 15         87 $hash->{State} = $self;
143 15         58 $hash->{Depth} = ++$self->{Depth};
144 15         71 HTTP::OAI::Debug::sax( (" " x $hash->{Depth}) . '<'.$hash->{Name}.'>' );
145 15         46 $self->SUPER::start_element($hash);
146             }
147              
148             sub end_element {
149 15     15 1 557 my ($self,$hash) = @_;
150              
151             # Call characters with the joined character data
152 15         30 $hash->{Text} = $self->{Text};
153 15 100       33 if( defined($self->{Text}) )
154             {
155             # Trailing whitespace causes problems
156 13 100       60 if( $self->{Text} =~ /\S/ )
157             {
158 12         78 HTTP::OAI::Debug::sax( "'".substr($self->{Text},0,40) . "'" );
159 12         50 $self->SUPER::characters({Data=>$self->{Text}});
160             }
161 13         160 $self->{Text} = undef;
162             }
163              
164 15   50     21 $hash->{Attributes} = pop @{$self->{Attributes}} || {};
165 15         27 $hash->{State} = $self;
166 15         27 $hash->{Depth} = $self->{Depth}--;
167 15         58 HTTP::OAI::Debug::sax( (" " x $hash->{Depth}) . ' <'.$hash->{Name}.'>' );
168 15         44 $self->SUPER::end_element($hash);
169             }
170              
171             sub entity_reference {
172 0     0 1 0 my ($self,$hash) = @_;
173 0         0 HTTP::OAI::Debug::sax( $hash->{Name} );
174             }
175              
176             sub start_cdata {
177 0     0 1 0 HTTP::OAI::Debug::sax();
178             }
179              
180             sub end_cdata {
181 0     0 1 0 HTTP::OAI::Debug::sax();
182             }
183              
184             sub comment {
185 0     0 1 0 HTTP::OAI::Debug::sax( $_[1]->{Data} );
186             }
187              
188             sub doctype_decl {
189             # {SystemId,PublicId,Internal}
190 0     0 1 0 HTTP::OAI::Debug::sax( $_[1]->{Name} );
191             }
192              
193             sub attlist_decl {
194             # {ElementName,AttributeName,Type,Default,Fixed}
195 0     0 1 0 HTTP::OAI::Debug::sax( $_[1]->{ElementName} );
196             }
197              
198             sub xml_decl {
199             # {Version,Encoding,Standalone}
200 2 100   2 1 194 HTTP::OAI::Debug::sax( join ", ", map { defined($_) ? $_ : "null" } @{$_[1]}{qw( Version Encoding Standalone )} );
  6         28  
  2         59  
201             }
202              
203             sub entity_decl {
204             # {Value,SystemId,PublicId,Notation}
205 0     0 1   HTTP::OAI::Debug::sax( $_[1]->{Name} );
206             }
207              
208             sub unparsed_decl {
209 0     0 0   HTTP::OAI::Debug::sax();
210             }
211              
212             sub element_decl {
213             # {Model}
214 0     0 1   HTTP::OAI::Debug::sax( $_[1]->{Name} );
215             }
216              
217             sub notation_decl {
218             # {Name,Base,SystemId,PublicId}
219 0     0 1   HTTP::OAI::Debug::sax( $_[1]->{Name} );
220             }
221              
222             sub processing_instruction {
223             # {Target,Data}
224 0     0 1   HTTP::OAI::Debug::sax( $_[1]->{Target} . " => " . $_[1]->{Data} );
225             }
226              
227             package HTTP::OAI::FilterDOMFragment;
228              
229 11     11   100 use vars qw( @ISA );
  11         29  
  11         1139  
230              
231             @ISA = qw( XML::SAX::Base );
232              
233             # Trap things that don't apply to a balanced fragment
234       0     sub start_document {}
235       0     sub end_document {}
236       0     sub xml_decl {}
237              
238             package XML::SAX::Debug;
239              
240 11     11   80 use Data::Dumper;
  11         21  
  11         547  
241              
242 11     11   64 use vars qw( @ISA $AUTOLOAD );
  11         27  
  11         2872  
243              
244             @ISA = qw( XML::SAX::Base );
245              
246             sub DEBUG {
247 0     0     my ($event,$self,$hash) = @_;
248 0           warn "$event(".Dumper($hash).")\n";
249 0           my $superior = "SUPER::$event";
250 0           $self->$superior($hash);
251             }
252              
253 0     0     sub start_document { DEBUG('start_document',@_) }
254 0     0     sub end_document { DEBUG('end_document',@_) }
255 0     0     sub start_element { DEBUG('start_element',@_) }
256 0     0     sub end_element { DEBUG('end_element',@_) }
257 0     0     sub characters { DEBUG('characters',@_) }
258 0     0     sub xml_decl { DEBUG('xml_decl',@_) }
259              
260             1;
261              
262             __END__