File Coverage

/.cpan/build/xml-rax-0.01-AJUGb1/blib/lib/XML/RAX.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1            
2             =head1 NAME
3            
4             XML::RAX - Record-oriented API for XML
5            
6             =head1 SYNOPSIS
7            
8             use XML::RAX;
9             my $R = new XML::RAX();
10            
11             # open from XML data
12             $R->open( '1555-5555
' );
13             $R->setRecord('Record');
14            
15             # open XML from file
16             $R->openfile( 'test.xml' );
17             $R->setRecord('Record');
18            
19             # iterate through recordset
20             my $rec = $R->readRecord();
21             while ( $rec )
22             {
23             print "Phone = ".$rec->getField('Phone')."\n";
24             $rec = $R->readRecord();
25             }
26            
27             =head1 DESCRIPTION
28            
29             This interface allows you to access an XML document as you
30             would a database recordset. In instances where the XML document
31             fits a record/field type format, using the RAX interface
32             will usually be simpler than using DOM or SAX to access the data.
33            
34             XML::RAX requires XML::Parser.
35            
36             See Sean McGrath's article on RAX for an good overview of RAX:
37             http://www.xml.com/pub/2000/04/26/rax/index.html
38            
39             =head1 AUTHOR
40            
41             Robert Hanson
42            
43             =head1 CREDITS
44            
45             The RAX API was created by Sean McGrath and first introduced in
46             his article on XML.com.
47            
48             =head1 COPYRIGHT
49            
50             Copyright (c) 2000 Robert Hanson. All rights reserved. This program
51             is free software; you can redistribute it and/or modify it under
52             the same terms as Perl itself.
53            
54             =cut
55            
56             package XML::RAX;
57            
58 1     1   1428 use XML::Parser;
  0            
  0            
59             use FileHandle;
60             use strict;
61             use vars qw($VERSION);
62            
63             $VERSION = "0.01";
64            
65             sub new
66             {
67             my $class = shift;
68             my $xml = shift;
69            
70             my $self = {
71             'parse_done' => 0, # true when XML page is fully parsed
72             'parse_started' => 0, # true after parse is started
73             'rax_opened' => 0, # true when data passed through open method
74             'record_delim' => '', # record tag identifier
75             'rec_fields' => [], # temp storage of a records fields
76             'records' => [], # queue of records
77             'parser' => undef, # XML::Parser object
78             'expatnb' => undef, # Expat::NB object
79             'field_lvl' => 0, # numeric level where fields reside (rec_lvl + 1)
80             'rec_lvl' => 0, # numeric level where records reside
81             'in_rec' => 0, # true when parse is inside record_delim tag
82             'in_field' => 0, # true when parse is inside field_lvl
83             'field_data' => '', # text data within current field
84             'tag_stack' => [], # stack of element tags
85             'xml' => '', # xml text for parsing
86             'xml_file' => undef, # filehandle to xml doc
87             };
88             bless $self, $class;
89            
90             return $self;
91             }
92            
93            
94             sub debug
95             {
96             # comment out the next line to show debugging info
97             return 1;
98            
99             # show parse info
100             my $self = shift;
101             my $source = shift;
102            
103             print "SOURCE: $source\n";
104             foreach my $prop ( sort (keys(%{$self})) )
105             {
106             next if ( $prop =~ /^(?:xml|records|parser|expat|tag_stack)/ );
107             print "$prop = $self->{$prop}\n";
108             }
109             print "Records: ".scalar(@{$self->{records}})."\n";
110             print "====================================\n";
111             return 1;
112             }
113            
114            
115             sub open
116             {
117             my $self = shift;
118            
119             return 0 if ( $self->{rax_opened} );
120            
121             $self->{xml} = shift;
122             $self->{rax_opened} = 1;
123             return 1;
124             }
125            
126            
127             sub openfile
128             {
129             my $self = shift;
130            
131             return 0 if ( $self->{rax_opened} );
132            
133             my $filename = shift;
134             my $fh = FileHandle->new( $filename, 'r' );
135            
136             if ( defined($fh) )
137             {
138             $self->{xml_file} = $fh;
139             $self->{rax_opened} = 1;
140             return 1;
141             }
142            
143             return 0;
144             }
145            
146            
147             sub startparse
148             {
149             my $self = shift;
150            
151             $self->{parser} = new XML::Parser(
152             Handlers => {
153             Start => sub { $self->handle_start(@_); },
154             End => sub { $self->handle_end(@_); },
155             Char => sub { $self->handle_char(@_); },
156             Final => sub { $self->handle_final(@_); } } );
157            
158             $self->{expatnb} = $self->{parser}->parse_start();
159            
160             if ( $self->{expatnb} )
161             {
162             $self->{parse_started} = 1;
163             return 1;
164             }
165            
166             return 0;
167             }
168            
169             sub parse
170             {
171             my $self = shift;
172            
173             return 0 unless ( $self->{rax_opened} );
174             return 0 if ( $self->{parse_done} );
175            
176             unless ( $self->{parse_started} )
177             {
178             $self->startparse() || return 0;
179             }
180            
181            
182             if ( defined $self->{xml_file} )
183             {
184             my $buffer;
185             read( $self->{xml_file}, $buffer, 4096 );
186            
187             if ( length( $buffer ) )
188             {
189             $self->{expatnb}->parse_more( $buffer );
190             }
191             else
192             {
193             $self->{expatnb}->parse_done;
194             $self->{parse_done} = 1;
195             }
196             }
197             else
198             {
199             $self->{expatnb}->parse_more( $self->{xml} );
200             $self->{expatnb}->parse_done;
201             $self->{parse_done} = 1;
202             }
203            
204             return 1;
205             }
206            
207             sub handle_start
208             {
209             my $self = shift;
210             my ( $expat, $element, %attr ) = @_;
211            
212             push @{$self->{tag_stack}}, $element;
213            
214             if ( ( ! $self->{in_rec} ) && ( $element eq $self->{record_delim} ) )
215             {
216             $self->{in_rec} = 1;
217             $self->{rec_lvl} = scalar(@{$self->{tag_stack}});
218             $self->{field_lvl} = $self->{rec_lvl} + 1;
219             }
220             elsif ( ( $self->{in_rec} ) && ( scalar(@{$self->{tag_stack}}) == $self->{field_lvl} ) )
221             {
222             $self->{in_field} = 1;
223             }
224            
225             $self->debug("->-> $element");
226             }
227            
228             sub handle_end
229             {
230             my $self = shift;
231             my ( $expat, $element ) = @_;
232            
233             pop @{$self->{tag_stack}};
234            
235             if ( $self->{in_rec} )
236             {
237             if ( scalar(@{$self->{tag_stack}}) < $self->{rec_lvl} )
238             {
239             $self->{in_rec} = 0;
240             push @{$self->{records}}, XML::RAX::Record->new( @{$self->{rec_fields}} );
241             $self->{rec_fields} = [];
242             }
243             elsif ( scalar(@{$self->{tag_stack}}) < $self->{field_lvl} )
244             {
245             $self->{in_field} = 0;
246             push @{$self->{rec_fields}}, { name => $element, value => $self->{field_data} };
247             $self->{field_data} = '';
248             }
249             }
250            
251             $self->debug("<-<- $element");
252             }
253            
254             sub handle_char
255             {
256             my $self = shift;
257             my ( $expat, $char ) = @_;
258            
259             if ( $self->{in_field} )
260             {
261             $self->{field_data} .= $char;
262             }
263             $self->debug("handle char");
264             }
265            
266             sub handle_final
267             {
268             my $self = shift;
269             my $expat = shift;
270             $self->debug("handle final");
271             }
272            
273             sub setRecord
274             {
275             my $self = shift;
276            
277             return 0 if ( $self->{parse_started} );
278            
279             $self->{record_delim} = shift;
280             $self->debug("set record");
281             return 1;
282             }
283            
284             sub readRecord
285             {
286             my $self = shift;
287            
288             $self->parse() until ( ( scalar @{$self->{records}} ) || ( $self->{parse_done} ) );
289            
290             $self->debug("read record");
291             return shift( @{$self->{records}} );
292             }
293            
294            
295             package XML::RAX::Record;
296            
297             sub new
298             {
299             my $class = shift;
300             my @fields = @_;
301            
302             my $self = { fields => {} };
303             bless $self, $class;
304            
305             foreach my $field ( @fields )
306             {
307             $self->{fields}->{$field->{name}} = $field->{value};
308             }
309            
310             return $self;
311             }
312            
313            
314             sub getField
315             {
316             my $self = shift;
317             my $field = shift;
318            
319             my $retval = $self->{fields}->{$field};
320             $retval =~ s/^\s*(.*?)\s*$/$1/ if ( $retval );
321             return $retval;
322             }
323            
324            
325             1;