source: trunk/gsdl/perllib/cpan/XML/XPath/Builder.pm@ 7909

Last change on this file since 7909 was 7909, checked in by mdewsnip, 17 years ago

CPAN module for processing XPath expressions.

  • Property svn:keywords set to Author Date Id Revision
File size: 4.7 KB
Line 
1# $Id: Builder.pm 7909 2004-08-06 05:11:55Z mdewsnip $
2
3package XML::XPath::Builder;
4
5use strict;
6
7# to get array index constants
8use XML::XPath::Node;
9use XML::XPath::Node::Element;
10use XML::XPath::Node::Attribute;
11use XML::XPath::Node::Namespace;
12use XML::XPath::Node::Text;
13use XML::XPath::Node::PI;
14use XML::XPath::Node::Comment;
15
16use vars qw/$xmlns_ns $xml_ns/;
17
18$xmlns_ns = "http://www.w3.org/2000/xmlns/";
19$xml_ns = "http://www.w3.org/XML/1998/namespace";
20
21sub new {
22 my $class = shift;
23 my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
24
25 bless $self, $class;
26}
27
28sub start_document {
29 my $self = shift;
30
31 $self->{IdNames} = {};
32 $self->{InScopeNamespaceStack} = [ {
33 '_Default' => undef,
34 'xmlns' => $xmlns_ns,
35 'xml' => $xml_ns,
36 } ];
37
38 $self->{NodeStack} = [ ];
39
40 my $document = XML::XPath::Node::Element->new();
41 my $newns = XML::XPath::Node::Namespace->new('xml', $xml_ns);
42 $document->appendNamespace($newns);
43 $self->{current} = $self->{DOC_Node} = $document;
44}
45
46sub end_document {
47 my $self = shift;
48
49 return $self->{DOC_Node};
50}
51
52sub characters {
53 my $self = shift;
54 my $sarg = shift;
55 my $text = $sarg->{Data};
56
57 my $parent = $self->{current};
58
59 my $last = $parent->getLastChild;
60 if ($last && $last->isTextNode) {
61 # append to previous text node
62 $last->appendText($text);
63 return;
64 }
65
66 my $node = XML::XPath::Node::Text->new($text);
67 $parent->appendChild($node, 1);
68}
69
70sub start_element {
71 my $self = shift;
72 my $sarg = shift;
73 my $tag = $sarg->{'Name'};
74 my $attr = $sarg->{'Attributes'};
75
76 push @{ $self->{InScopeNamespaceStack} },
77 { %{ $self->{InScopeNamespaceStack}[-1] } };
78 $self->_scan_namespaces(@_);
79
80 my ($prefix, $namespace) = $self->_namespace($tag);
81
82 my $node = XML::XPath::Node::Element->new($tag, $prefix);
83
84 foreach my $name (keys %$attr) {
85 my $value = $attr->{$name};
86
87 if ($name =~ /^xmlns(:(.*))?$/) {
88 # namespace node
89 my $prefix = $2 || '#default';
90# warn "Creating NS node: $prefix = $value\n";
91 my $newns = XML::XPath::Node::Namespace->new($prefix, $value);
92 $node->appendNamespace($newns);
93 }
94 else {
95 my ($prefix, $namespace) = $self->_namespace($name);
96 undef $namespace unless $prefix;
97
98 my $newattr = XML::XPath::Node::Attribute->new($name, $value, $prefix);
99 $node->appendAttribute($newattr, 1);
100 if (exists($self->{IdNames}{$tag}) && ($self->{IdNames}{$tag} eq $name)) {
101 # warn "appending Id Element: $val for ", $node->getName, "\n";
102 $self->{DOC_Node}->appendIdElement($value, $node);
103 }
104 }
105 }
106
107 $self->{current}->appendChild($node, 1);
108 $self->{current} = $node;
109}
110
111sub end_element {
112 my $self = shift;
113 $self->{current} = $self->{current}->getParentNode;
114}
115
116sub processing_instruction {
117 my $self = shift;
118 my $pi = shift;
119 my $node = XML::XPath::Node::PI->new($pi->{Target}, $pi->{Data});
120 $self->{current}->appendChild($node, 1);
121}
122
123sub comment {
124 my $self = shift;
125 my $comment = shift;
126 my $node = XML::XPath::Node::Comment->new($comment->{Data});
127 $self->{current}->appendChild($node, 1);
128}
129
130sub _scan_namespaces {
131 my ($self, %attributes) = @_;
132
133 while (my ($attr_name, $value) = each %attributes) {
134 if ($attr_name eq 'xmlns') {
135 $self->{InScopeNamespaceStack}[-1]{'_Default'} = $value;
136 } elsif ($attr_name =~ /^xmlns:(.*)$/) {
137 my $prefix = $1;
138 $self->{InScopeNamespaceStack}[-1]{$prefix} = $value;
139 }
140 }
141}
142
143sub _namespace {
144 my ($self, $name) = @_;
145
146 my ($prefix, $localname) = split(/:/, $name);
147 if (!defined($localname)) {
148 if ($prefix eq 'xmlns') {
149 return '', undef;
150 } else {
151 return '', $self->{InScopeNamespaceStack}[-1]{'_Default'};
152 }
153 } else {
154 return $prefix, $self->{InScopeNamespaceStack}[-1]{$prefix};
155 }
156}
157
1581;
159
160__END__
161
162=head1 NAME
163
164XML::XPath::Builder - SAX handler for building an XPath tree
165
166=head1 SYNOPSIS
167
168 use AnySAXParser;
169 use XML::XPath::Builder;
170
171 $builder = XML::XPath::Builder->new();
172 $parser = AnySAXParser->new( Handler => $builder );
173
174 $root_node = $parser->parse( Source => [SOURCE] );
175
176=head1 DESCRIPTION
177
178C<XML::XPath::Builder> is a SAX handler for building an XML::XPath
179tree.
180
181C<XML::XPath::Builder> is used by creating a new instance of
182C<XML::XPath::Builder> and providing it as the Handler for a SAX
183parser. Calling `C<parse()>' on the SAX parser will return the
184root node of the tree built from that parse.
185
186=head1 AUTHOR
187
188Ken MacLeod, <ken@bitsko.slc.ut.us>
189
190=head1 SEE ALSO
191
192perl(1), XML::XPath(3)
193
194PerlSAX.pod in libxml-perl
195
196Extensible Markup Language (XML) <http://www.w3c.org/XML>
197
198=cut
Note: See TracBrowser for help on using the repository browser.