Commits

ma...@9ae0c189-cd1f-4510-a509-f4891f5cf20d  committed 5748317

Proper NS code in SAX parser, and tests updated too

  • Participants
  • Parent commits 9415b19

Comments (0)

Files changed (2)

File lib/XML/LibXML/SAX/Parser.pm

 
 use XML::LibXML;
 use XML::SAX::Base;
+use XML::SAX::DocumentLocator;
 
 $VERSION = '1.00';
 @ISA = ('XML::SAX::Base');
 sub _parse_bytestream {
     my ($self, $fh, $options) = @_;
     my $parser = XML::LibXML->new();
-    my $doc = $parser->parse_fh($fh);
+    my $doc = exists($options->{Source}{SystemId}) ? $parser->parse_fh($fh, $options->{Source}{SystemId}) : $parser->parse_fh($fh);
     $self->generate($doc);
 }
 
 sub _parse_string {
     my ($self, $str, $options) = @_;
     my $parser = XML::LibXML->new();
-    my $doc = $parser->parse_string($str);
+    my $doc = exists($options->{Source}{SystemId}) ? $parser->parse_string($str, $options->{Source}{SystemId}) : $parser->parse_string($str);
     $self->generate($doc);
 }
 
     my ($self, $element) = @_;
 
     my $attribs = {};
+    my @ns_maps;
 
     foreach my $attr ($element->getAttributes) {
         my $key;
                     Prefix => $p,
                     LocalName => $localname,
                 };
+            push @ns_maps, $attribs->{$key};
         }
         else {
             my $ns = $attr->getNamespaceURI || '';
         LocalName => $element->getLocalName,
     };
 
+    foreach my $ns (@ns_maps) {
+        $self->start_prefix_mapping(
+            {
+                NamespaceURI => $ns->{Value},
+                Prefix => (($ns->{LocalName} eq 'xmlns') ? '' : $ns->{LocalName}),
+            }
+        );
+    }
+
     $self->start_element($node);
 
     foreach my $child ($element->childNodes) {
         $self->process_node($child);
     }
 
-    delete $node->{Attributes};
+    my $end_node = { %$node };
 
-    $self->end_element($node);
+    delete $end_node->{Attributes};
+
+    $self->end_element($end_node);
+    
+    foreach my $ns (@ns_maps) {
+        $self->end_prefix_mapping(
+            {
+                NamespaceURI => $ns->{Value},
+                Prefix => (($ns->{LocalName} eq 'xmlns') ? '' : $ns->{LocalName}),
+            }
+        );
+    }
+
 }
 
 1;
 and would require an extreme amount of work to allow SAX2
 parsing in a stream manner.
 
+=head1 WARNING
+
+WARNING WARNING WARNING
+
+This is NOT a streaming SAX parser. As I said above, this parser
+reads the entire document into a DOM and serialises it. Some
+people couldn't read that in the paragraph above so I've added
+this warning.
+
+There are many reasons, but if you want to write a proper SAX
+parser using the libxml2 library, please feel free and send it
+along to me.
+
 =head1 API
 
 The API is exactly the same as any other Perl SAX2 parser. See
 use Test;
-BEGIN { plan tests => 41 }
+BEGIN { plan tests => 46 }
 use XML::LibXML;
 use XML::LibXML::SAX::Parser;
 use XML::LibXML::SAX::Builder;
 ok($parser);
 $parser->parse_uri("example/dromeds.xml");
 
-$parser->parse_uri("example/ns.xml");
-
 $parser->parse_string(<<EOT);
 <?xml version='1.0' encoding="US-ASCII"?>
 <dromedaries one="1" />
 EOT
 
+$sax = SAXNSTester->new;
+ok($sax);
+
+$parser->set_handler($sax);
+
+$parser->parse_uri("example/ns.xml");
+
 ########### Helper class #############
 
 package SAXTester;
   my ($self, $chars) = @_;
   # warn("characters: $chars->{Data}\n");
 }
+
+package SAXNSTester;
+use Test;
+
+sub new {
+    bless {}, shift;
+}
+
+sub start_element {
+    my ($self, $node) = @_;
+    ok($node->{NamespaceURI} =~ /^urn:/);
+    # warn("start_element:\n", Dumper($node));
+}
+
+sub end_element {
+    my ($self, $node) = @_;
+    # warn("end_element: $node->{Name}\n");
+}
+
+sub start_prefix_mapping {
+    my ($self, $node) = @_;
+    ok($node->{NamespaceURI} =~ /^(urn:camels|urn:mammals|urn:a)$/);
+    # warn("start_prefix_mapping:\n", Dumper($node));
+}
+
+sub end_prefix_mapping {
+    my ($self, $node) = @_;
+    # warn("end_prefix_mapping:\n", Dumper($node));
+    ok($node->{NamespaceURI} =~ /^(urn:camels|urn:mammals|urn:a)$/);
+}
+