Commits

Anonymous committed ce85906

*** empty log message ***

Comments (0)

Files changed (4)

-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <dromedaries>
     <species name="Camel">
       <humps>1 or 2</humps>

lib/XML/LibXML/SAX/Builder.pm

 
 package XML::LibXML::SAX::Builder;
 
+use XML::LibXML;
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+}
+
+sub start_document {
+    my ($self, $doc) = @_;
+    $self->{DOM} = XML::LibXML::Document->createDocument( );
+    $self->{Parent} = undef;
+}
+
+sub end_document {
+    my ($self, $doc) = @_;
+    my $dom = delete $self->{DOM};
+    delete $self->{Parent};
+    return $dom;
+}
+
+sub start_element {
+    my ($self, $el) = @_;
+    my $node;
+    if ($el->{NamespaceURI}) {
+        $node = $self->{DOM}->createElementNS($el->{NamespaceURI}, $el->{Name});
+    }
+    else {
+        $node = $self->{DOM}->createElement($el->{Name});
+    }
+    
+    # do attributes
+    foreach my $key (keys %{$el->{Attributes}}) {
+        my $attr = $el->{Attributes}->{$key};
+        if (ref($attr)) {
+            # SAX2 attributes
+            $node->setAttributeNS($attr->{NamespaceURI} || "", $attr->{Name} => $attr->{Value});
+        }
+        else {
+            $node->setAttribute($key => $attr);
+        }
+    }
+    
+    # append
+    if ($self->{Parent}) {
+        $self->{Parent}->appendChild($node);
+        $self->{Parent} = $node;
+    }
+    else {
+        $self->{DOM}->setDocumentElement($node);
+        $self->{Parent} = $node;
+    }
+}
+
+sub end_element {
+    my ($self, $el) = @_;
+    return unless $self->{Parent};
+    $self->{Parent} = $self->{Parent}->getParentNode();
+}
+
+sub characters {
+    my ($self, $chars) = @_;
+    return unless $self->{Parent};
+    $self->{Parent}->appendText($chars->{Data});
+}
+
 1;
 
 __END__
 
+=head1 NAME
+
+XML::LibXML::SAX::Builder - build a LibXML tree from SAX events
+
+=head1 SYNOPSIS
+
+  my $builder = XML::LibXML::SAX::Builder->new();
+  my $gen = XML::Generator::DBI->new(Handler => $builder, dbh => $dbh);
+  my $dom = $gen->execute("SELECT * FROM Users");
+
+=head1 DESCRIPTION
+
+This is a SAX handler that generates a DOM tree from SAX events. Usage
+is as above. Input is accepted from any SAX1 or SAX2 event generator.
+
+=cut

lib/XML/LibXML/SAX/Generator.pm

 
 package XML::LibXML::SAX::Generator;
 
+use XML::LibXML;
+
 sub new {
     my $class = shift;
     unshift @_, 'Handler' unless @_ != 1;
     my $self = shift;
     my ($node) = @_;
     
+    my $document = { Parent => undef };
+    $self->{Handler}->start_document($document);
     
+    process_node($self->{Handler}, $node);
+    
+    $self->{Handler}->end_document($document);
+}
+
+sub process_node {
+    my ($handler, $node) = @_;
+    
+    my $node_type = $node->getType();
+    if ($node_type == XML_COMMENT_NODE) {
+        $handler->comment( { Data => $node->getData } );
+    }
+    elsif ($node_type == XML_TEXT_NODE || $node_type == XML_CDATA_SECTION_NODE) {
+        # warn($node->getData . "\n");
+        $handler->characters( { Data => $node->getData } );
+    }
+    elsif ($node_type == XML_ELEMENT_NODE) {
+        # warn("<" . $node->getName . ">\n");
+        process_element($handler, $node);
+        # warn("</" . $node->getName . ">\n");
+    }
+    elsif ($node_type == XML_ENTITY_REF_NODE) {
+        foreach my $kid ($node->getChildnodes) {
+            # warn("child of entity ref: " . $kid->getType() . " called: " . $kid->getName . "\n");
+            process_node($handler, $kid);
+        }
+    }
+    elsif ($node_type == XML_DOCUMENT_NODE) {
+        # just get root element. Ignore other cruft.
+        foreach my $kid ($node->getChildnodes) {
+            if ($kid->getType() == XML_ELEMENT_NODE) {
+                process_element($handler, $kid);
+                last;
+            }
+        }
+    }
+    else {
+        warn("unknown node type: $node_type");
+    }
+}
+
+sub process_element {
+    my ($handler, $element) = @_;
+    
+    my @attr;
+    
+    foreach my $attr ($element->getAttributes) {
+        push @attr, XML::LibXML::SAX::AttributeNode->new(
+            Name => $attr->getName,
+            Value => $attr->getData,
+            NamespaceURI => $attr->getNamespaceURI,
+            Prefix => $attr->getPrefix,
+            LocalName => $attr->getLocalName,
+            );
+    }
+    
+    my $node = {
+        Name => $element->getName,
+        Attributes => { map { $_->{Name} => $_ } @attr },
+        NamespaceURI => $element->getNamespaceURI,
+        Prefix => $element->getPrefix,
+        LocalName => $element->getLocalName,
+    };
+    
+    $handler->start_element($node);
+    
+    foreach my $child ($element->getChildnodes) {
+        process_node($handler, $child);
+    }
+    
+    $handler->end_element($node);
+}
+
+package XML::LibXML::SAX::AttributeNode;
+
+use overload '""' => "stringify";
+
+sub new {
+    my $class = shift;
+    my %p = @_;
+    return bless \%p, $class;
+}
+
+sub stringify {
+    my $self = shift;
+    return $self->{Value};
 }
 
 1;
 
 __END__
 
+=head1 NAME
+
+XML::LibXML::SAX::Generator - Generate SAX events from a LibXML tree
+
+=head1 SYNOPSIS
+
+  my $handler = MySAXHandler->new();
+  my $generator = XML::LibXML::SAX::Generator->new(Handler => $handler);
+  my $dom = XML::LibXML->new->parse_file("foo.xml");
+  
+  $generator->generate($dom);
+
+=head1 DESCRIPTION
+
+This helper class allows you to generate SAX events from any XML::LibXML
+node, and all it's sub-nodes. This basically gives you interop from
+XML::LibXML to other modules that may implement SAX.
+
+It uses SAX2 style, but should be compatible with anything SAX1, by use
+of stringification overloading.
+
+There is nothing to really know about, beyond the synopsis above, and
+a general knowledge of how to use SAX, which is beyond the scope here.
+
+=cut
+use Test;
+BEGIN { plan tests => 19 }
+use XML::LibXML;
+use XML::LibXML::SAX::Generator;
+use XML::LibXML::SAX::Builder;
+use IO::File;
+ok(1);
+
+my $sax = SAXTester->new;
+ok($sax);
+
+my $str = join('', IO::File->new("example/dromeds.xml")->getlines);
+my $doc = XML::LibXML->new->parse_string($str);
+ok($doc);
+
+my $generator = XML::LibXML::SAX::Generator->new(Handler => $sax);
+ok($generator);
+
+$generator->generate($doc);
+
+my $builder = XML::LibXML::SAX::Builder->new();
+ok($builder);
+my $gen2 = XML::LibXML::SAX::Generator->new(Handler => $builder);
+my $dom2 = $gen2->generate($doc);
+ok($dom2);
+
+ok($dom2->toString, $str);
+# warn($dom2->toString);
+
+########### Helper class #############
+
+package SAXTester;
+use Test;
+
+sub new {
+    my $class = shift;
+    return bless {}, $class;
+}
+
+sub start_document {
+  ok(1);
+}
+
+sub end_document {
+  ok(1);
+}
+
+sub start_element {
+  my ($self, $el) = @_;
+  ok($el->{Name}, qr{^(dromedaries|species|humps|disposition)$});
+  foreach my $attr (keys %{$el->{Attributes}}) {
+    # warn("Attr: $attr = $el->{Attributes}->{$attr}\n");
+  }
+# warn("start_element: $el->{Name}\n");
+}
+
+sub end_element {
+  my ($self, $el) = @_;
+  # warn("end_element: $el->{Name}\n");
+}
+
+sub characters {
+  my ($self, $chars) = @_;
+  # warn("characters: $chars->{Data}\n");
+}