local-lib5/lib/perl5/i486-linux-gnu-thread-multi/XML/LibXML/SAX/Builder.pm

   1 # $Id: Builder.pm 785 2009-07-16 14:17:46Z pajas $
   2 #
   3 # This is free software, you may use it and distribute it under the same terms as
   4 # Perl itself.
   5 #
   6 # Copyright 2001-2003 AxKit.com Ltd., 2002-2006 Christian Glahn, 2006-2009 Petr Pajas
   7 #
   8 #
   9
  10 package XML::LibXML::SAX::Builder;
  11
  12 use XML::LibXML;
  13 use XML::NamespaceSupport;
  14
  15 use vars qw ($VERSION);
  16
  17 sub CLONE_SKIP {
  18   return $XML::LibXML::__threads_shared ? 0 : 1;
  19 }
  20
  21 $VERSION = "1.70"; # VERSION TEMPLATE: DO NOT CHANGE
  22
  23 sub new {
  24     my $class = shift;
  25     return bless {@_}, $class;
  26 }
  27
  28 sub result { $_[0]->{LAST_DOM}; }
  29
  30 sub done {
  31     my ($self) = @_;
  32     my $dom = $self->{DOM};
  33     $dom = $self->{Parent} unless defined $dom; # this is for parsing document chunks
  34
  35     delete $self->{NamespaceStack};
  36     delete $self->{Parent};
  37     delete $self->{DOM};
  38
  39     $self->{LAST_DOM} = $dom;
  40
  41     return $dom;
  42 }
  43
  44 sub set_document_locator {
  45 }
  46
  47 sub start_dtd {
  48   my ($self, $dtd) = @_;
  49   if (defined $dtd->{Name} and
  50       (defined $dtd->{SystemId} or defined $dtd->{PublicId})) {
  51     $self->{DOM}->createExternalSubset($dtd->{Name},$dtd->{PublicId},$dtd->{SystemId});
  52   }
  53 }
  54
  55 sub end_dtd {
  56 }
  57
  58 sub start_document {
  59     my ($self, $doc) = @_;
  60     $self->{DOM} = XML::LibXML::Document->createDocument();
  61
  62     if ( defined $self->{Encoding} ) {
  63         $self->xml_decl({Version => ($self->{Version} || '1.0') , Encoding => $self->{Encoding}});
  64     }
  65
  66     $self->{NamespaceStack} = XML::NamespaceSupport->new;
  67     $self->{NamespaceStack}->push_context;
  68     $self->{Parent} = undef;
  69     return ();
  70 }
  71
  72 sub xml_decl {
  73     my $self = shift;
  74     my $decl = shift;
  75
  76     if ( defined $decl->{Version} ) {
  77         $self->{DOM}->setVersion( $decl->{Version} );
  78     }
  79     if ( defined $decl->{Encoding} ) {
  80         $self->{DOM}->setEncoding( $decl->{Encoding} );
  81     }
  82     return ();
  83 }
  84
  85 sub end_document {
  86     my ($self, $doc) = @_;
  87     my $d = $self->done();
  88     return $d;
  89 }
  90
  91 sub start_prefix_mapping {
  92     my $self = shift;
  93     my $ns = shift;
  94
  95     unless ( defined $self->{DOM} or defined $self->{Parent} ) {
  96         $self->{Parent} = XML::LibXML::DocumentFragment->new();
  97         $self->{NamespaceStack} = XML::NamespaceSupport->new;
  98         $self->{NamespaceStack}->push_context;
  99     }
 100
 101     $self->{USENAMESPACESTACK} = 1;
 102
 103     $self->{NamespaceStack}->declare_prefix( $ns->{Prefix}, $ns->{NamespaceURI} );
 104     return ();
 105 }
 106
 107
 108 sub end_prefix_mapping {
 109     my $self = shift;
 110     my $ns = shift;
 111     $self->{NamespaceStack}->undeclare_prefix( $ns->{Prefix} );
 112     return ();
 113 }
 114
 115
 116 sub start_element {
 117     my ($self, $el) = @_;
 118     my $node;
 119
 120     unless ( defined $self->{DOM} or defined $self->{Parent} ) {
 121         $self->{Parent} = XML::LibXML::DocumentFragment->new();
 122         $self->{NamespaceStack} = XML::NamespaceSupport->new;
 123         $self->{NamespaceStack}->push_context;
 124     }
 125
 126     if ( defined $self->{Parent} ) {
 127         $el->{NamespaceURI} ||= "";
 128         $node = $self->{Parent}->addNewChild( $el->{NamespaceURI},
 129                                               $el->{Name} );
 130     }
 131     else {
 132         if ($el->{NamespaceURI}) {
 133             if ( defined $self->{DOM} ) {
 134                 $node = $self->{DOM}->createRawElementNS($el->{NamespaceURI},
 135                                                          $el->{Name});
 136             }
 137             else {
 138                 $node = XML::LibXML::Element->new( $el->{Name} );
 139                 $node->setNamespace( $el->{NamespaceURI},
 140                                      $el->{Prefix} , 1 );
 141             }
 142         }
 143         else {
 144             if ( defined $self->{DOM} ) {
 145                 $node = $self->{DOM}->createRawElement($el->{Name});
 146             }
 147             else {
 148                 $node = XML::LibXML::Element->new( $el->{Name} );
 149             }
 150         }
 151
 152         $self->{DOM}->setDocumentElement($node);
 153     }
 154
 155     # build namespaces
 156     my $skip_ns= 0;
 157     foreach my $p ( $self->{NamespaceStack}->get_declared_prefixes() ) {
 158         $skip_ns= 1;
 159         my $uri = $self->{NamespaceStack}->get_uri($p);
 160         my $nodeflag = 0;
 161         if ( defined $uri
 162              and defined $el->{NamespaceURI}
 163              and $uri eq $el->{NamespaceURI} ) {
 164             #            $nodeflag = 1;
 165             next;
 166         }
 167         $node->setNamespace($uri, $p, 0 );
 168     }
 169
 170     $self->{Parent} = $node;
 171
 172     $self->{NamespaceStack}->push_context;
 173
 174     # do attributes
 175     foreach my $key (keys %{$el->{Attributes}}) {
 176         my $attr = $el->{Attributes}->{$key};
 177         if (ref($attr)) {
 178             # catch broken name/value pairs
 179             next unless $attr->{Name} ;
 180             next if $self->{USENAMESPACESTACK}
 181                     and ( $attr->{Name} eq "xmlns"
 182                           or ( defined $attr->{Prefix}
 183                                and $attr->{Prefix} eq "xmlns" ) );
 184
 185
 186             if ( defined $attr->{Prefix}
 187                  and $attr->{Prefix} eq "xmlns" and $skip_ns == 0 ) {
 188                 # ok, the generator does not set namespaces correctly!
 189                 my $uri = $attr->{Value};
 190                 $node->setNamespace($uri,
 191                                     $attr->{Localname},
 192                                     $uri eq $el->{NamespaceURI} ? 1 : 0 );
 193             }
 194             else {
 195                 $node->setAttributeNS($attr->{NamespaceURI} || "",
 196                                       $attr->{Name}, $attr->{Value});
 197             }
 198         }
 199         else {
 200             $node->setAttribute($key => $attr);
 201         }
 202     }
 203     return ();
 204 }
 205
 206 sub end_element {
 207     my ($self, $el) = @_;
 208     return unless $self->{Parent};
 209
 210     $self->{NamespaceStack}->pop_context;
 211     $self->{Parent} = $self->{Parent}->parentNode();
 212     return ();
 213 }
 214
 215 sub start_cdata {
 216     my $self = shift;
 217     $self->{IN_CDATA} = 1;
 218     return ();
 219 }
 220
 221 sub end_cdata {
 222     my $self = shift;
 223     $self->{IN_CDATA} = 0;
 224     return ();
 225 }
 226
 227 sub characters {
 228     my ($self, $chars) = @_;
 229     if ( not defined $self->{DOM} and not defined $self->{Parent} ) {
 230         $self->{Parent} = XML::LibXML::DocumentFragment->new();
 231         $self->{NamespaceStack} = XML::NamespaceSupport->new;
 232         $self->{NamespaceStack}->push_context;
 233     }
 234     return unless $self->{Parent};
 235     my $node;
 236
 237     unless ( defined $chars and defined $chars->{Data} ) {
 238         return;
 239     }
 240
 241     if ( defined $self->{DOM} ) {
 242         if ( defined $self->{IN_CDATA} and $self->{IN_CDATA} == 1 ) {
 243             $node = $self->{DOM}->createCDATASection($chars->{Data});
 244         }
 245         else {
 246             $node = $self->{Parent}->appendText($chars->{Data});
 247             return;
 248         }
 249     }
 250     elsif ( defined $self->{IN_CDATA} and $self->{IN_CDATA} == 1 ) {
 251         $node = XML::LibXML::CDATASection->new($chars->{Data});
 252     }
 253     else {
 254         $node = XML::LibXML::Text->new($chars->{Data});
 255     }
 256
 257     $self->{Parent}->addChild($node);
 258     return ();
 259 }
 260
 261 sub comment {
 262     my ($self, $chars) = @_;
 263     my $comment;
 264     if ( not defined $self->{DOM} and not defined $self->{Parent} ) {
 265         $self->{Parent} = XML::LibXML::DocumentFragment->new();
 266         $self->{NamespaceStack} = XML::NamespaceSupport->new;
 267         $self->{NamespaceStack}->push_context;
 268     }
 269
 270     unless ( defined $chars and defined $chars->{Data} ) {
 271         return;
 272     }
 273
 274     if ( defined $self->{DOM} ) {
 275         $comment = $self->{DOM}->createComment( $chars->{Data} );
 276     }
 277     else {
 278         $comment = XML::LibXML::Comment->new( $chars->{Data} );
 279     }
 280
 281     if ( defined $self->{Parent} ) {
 282         $self->{Parent}->addChild($comment);
 283     }
 284     else {
 285         $self->{DOM}->addChild($comment);
 286     }
 287     return ();
 288 }
 289
 290 sub processing_instruction {
 291     my ( $self,  $pi ) = @_;
 292     my $PI;
 293     return unless  defined $self->{DOM};
 294     $PI = $self->{DOM}->createPI( $pi->{Target}, $pi->{Data} );
 295
 296     if ( defined $self->{Parent} ) {
 297         $self->{Parent}->addChild( $PI );
 298     }
 299     else {
 300         $self->{DOM}->addChild( $PI );
 301     }
 302     return ();
 303 }
 304
 305 sub warning {
 306     my $self = shift;
 307     my $error = shift;
 308     # fill $@ but do not die seriously
 309     eval { $error->throw; };
 310 }
 311
 312 sub error {
 313     my $self = shift;
 314     my $error = shift;
 315     delete $self->{NamespaceStack};
 316     delete $self->{Parent};
 317     delete $self->{DOM};
 318     $error->throw;
 319 }
 320
 321 sub fatal_error {
 322     my $self = shift;
 323     my $error = shift;
 324     delete $self->{NamespaceStack};
 325     delete $self->{Parent};
 326     delete $self->{DOM};
 327     $error->throw;
 328 }
 329
 330 1;
 331
 332 __END__