1 | # $Id: Builder.pm 7909 2004-08-06 05:11:55Z mdewsnip $
|
---|
2 |
|
---|
3 | package XML::XPath::Builder;
|
---|
4 |
|
---|
5 | use strict;
|
---|
6 |
|
---|
7 | # to get array index constants
|
---|
8 | use XML::XPath::Node;
|
---|
9 | use XML::XPath::Node::Element;
|
---|
10 | use XML::XPath::Node::Attribute;
|
---|
11 | use XML::XPath::Node::Namespace;
|
---|
12 | use XML::XPath::Node::Text;
|
---|
13 | use XML::XPath::Node::PI;
|
---|
14 | use XML::XPath::Node::Comment;
|
---|
15 |
|
---|
16 | use 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 |
|
---|
21 | sub new {
|
---|
22 | my $class = shift;
|
---|
23 | my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
|
---|
24 |
|
---|
25 | bless $self, $class;
|
---|
26 | }
|
---|
27 |
|
---|
28 | sub 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 |
|
---|
46 | sub end_document {
|
---|
47 | my $self = shift;
|
---|
48 |
|
---|
49 | return $self->{DOC_Node};
|
---|
50 | }
|
---|
51 |
|
---|
52 | sub 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 |
|
---|
70 | sub 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 |
|
---|
111 | sub end_element {
|
---|
112 | my $self = shift;
|
---|
113 | $self->{current} = $self->{current}->getParentNode;
|
---|
114 | }
|
---|
115 |
|
---|
116 | sub 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 |
|
---|
123 | sub 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 |
|
---|
130 | sub _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 |
|
---|
143 | sub _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 |
|
---|
158 | 1;
|
---|
159 |
|
---|
160 | __END__
|
---|
161 |
|
---|
162 | =head1 NAME
|
---|
163 |
|
---|
164 | XML::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 |
|
---|
178 | C<XML::XPath::Builder> is a SAX handler for building an XML::XPath
|
---|
179 | tree.
|
---|
180 |
|
---|
181 | C<XML::XPath::Builder> is used by creating a new instance of
|
---|
182 | C<XML::XPath::Builder> and providing it as the Handler for a SAX
|
---|
183 | parser. Calling `C<parse()>' on the SAX parser will return the
|
---|
184 | root node of the tree built from that parse.
|
---|
185 |
|
---|
186 | =head1 AUTHOR
|
---|
187 |
|
---|
188 | Ken MacLeod, <[email protected]>
|
---|
189 |
|
---|
190 | =head1 SEE ALSO
|
---|
191 |
|
---|
192 | perl(1), XML::XPath(3)
|
---|
193 |
|
---|
194 | PerlSAX.pod in libxml-perl
|
---|
195 |
|
---|
196 | Extensible Markup Language (XML) <http://www.w3c.org/XML>
|
---|
197 |
|
---|
198 | =cut
|
---|