1# $Id: Builder.pm,v 1.10 2001/06/12 20:56:56 matt Exp $
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
199