[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/site_perl/5.10.0/XML/XPath/ -> Builder.pm (source)

   1  # $Id: Builder.pm,v 1.10 2001/06/12 20:56:56 matt Exp $
   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, <ken@bitsko.slc.ut.us>
 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


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1