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