XML::SAX::IncrementalBuilder::LibXML - create DOM fragments from SAX events

   my $builder = XML::SAX::IncrementalBuilder::LibXML->new;
   my $parser = XML::LibXML->new(Handler => $builder);
   $parser->parse( ... );
   while (my $frag = $builder->get_node) {
      # do stuff
   }

package XML::SAX::IncrementalBuilder::LibXML::Element;
use strict;
use warnings;

use XML::LibXML;
use base qw(XML::LibXML::Element);
use Class::InsideOut qw(public);

public special => my %special;

sub toString {
   my $self = shift;

   my $str = '';
   my $special = $self->special ? $self->special : '';
   if ($special eq 'Start') {
      $str .= '<' . $self->nodeName;
      foreach my $attr ($self->attributes) {
        $str .= sprintf (" %s=\"%s\"", $attr->nodeName, $attr->getValue);
      }
      $str .= '>';
   }
   elsif ($special eq 'End') {
      $str = sprintf ("</%s>", $self->nodeName);
   }

   return $str;
}

package XML::SAX::IncrementalBuilder::LibXML::Document;
use strict;
use warnings;

use XML::LibXML;
use base qw(XML::LibXML::Document);
use Class::InsideOut qw(public);

public decl => my %decl;

sub toString {
   my $self = shift;

   my $str = '';
   if ($self->decl) {
      $str = '<?xml';
      if (my $v = $self->getVersion) {
         $str .= " version=\"" . $v . "\"";
      }
      if (my $e = $self->getEncoding) {
         $str .= " encoding=\"" . $e . "\"";
      }
      $str .= '?>';
   }

   if ($self->externalSubset) {
      $str .= $self->externalSubset->toString;
   }
   
   return $str;
}

package XML::SAX::IncrementalBuilder::LibXML;
use strict;
use warnings;

use base qw(XML::LibXML::SAX::Builder);
use Class::InsideOut qw(register);

our $VERSION = '0.02';

sub new {
   my $class = shift;

   my $self = $class->SUPER::new(@_, depth => -1);
   $self->{'godepth'} = 1 unless defined ($self->{'godepth'});
   $self->{'detach'} = 0 unless defined ($self->{'detach'});
   $self->{'finished'} = [];
   return $self;
}

sub clone {
   my $self = shift;

   my $class = ref $self;
   my $new_self = $class->new(
      depth => -1,
      godepth => $self->{'godepth'},
      detach => $self->{'detach'},
   );

   return $new_self;
}

sub get_node {
   my $self = shift;
   return shift(@{$self->{'finished'}});
}

sub finished_nodes {
   my $self = shift;
   return scalar @{$self->{'finished'}};
}

sub reset {
   my $self = shift;

   $self->done;
   $self->{depth} = -1;
}

sub _register {
      my ($noderef, $special) = @_;
      register ($$noderef, 'XML::SAX::IncrementalBuilder::LibXML::Element');
      $$noderef->special($special) if (defined $special);
}

#
# Below are the SAX2 methods
#

sub xml_decl {
   my $self = shift;

   $self->{'DOM'}->decl(1);
   $self->SUPER::xml_decl(@_);
}

sub start_document {
   my $self = shift;

   $self->SUPER::start_document(@_);

   bless ($self->{'DOM'}, 'XML::SAX::IncrementalBuilder::LibXML::Document');
   push (@{$self->{'finished'}}, $self->{'DOM'});
}

sub characters {
   my $self = shift;
   my $detached;

   if ($self->{detach} and $self->{depth} == $self->{godepth} - 1) {
      $detached = $self->{Parent};
      my $node = $self->{Parent} = XML::LibXML::DocumentFragment->new;
   }

   $self->SUPER::characters(@_);

   if ($detached) {
      push (@{$self->{finished}}, $self->{Parent});
      $self->{Parent} = $detached;
   }
}

sub start_element {
   my $self = shift;

   $self->{'depth'}++;

   if ($self->{'detach'} and $self->{'depth'} == $self->{'godepth'}) {
      $self->{'detached'} = $self->{Parent};
      my $frag = $self->{Parent} = XML::LibXML::DocumentFragment->new();
   }

   $self->SUPER::start_element(@_);
   my $node = $self->{Parent};

   # Announce elements with a lower depth than we're interested
   # in, even if they're not done yet.
   # FIXME: do we really want this?
   if ($self->{'depth'} < $self->{'godepth'}) {	    
      if ($self->{detach}) {
	 _register (\$node, 'Start');
      }
      push(@{$self->{'finished'}}, $node);
   }
   return $node;
}

sub end_element {
   my $self = shift;

   my $node = $self->{Parent};

   $self->SUPER::end_element(@_);

   if($self->{'depth'} == $self->{'godepth'}) {
      if ($self->{detached}) {
	 $node = $self->{Parent};
	 $self->{Parent} = delete $self->{detached};
      }
      push(@{$self->{'finished'}}, $node);
   }
   if ($self->{'depth'} < $self->{'godepth'}) {
      $node = $node->cloneNode;
      _register (\$node, 'End');
      push(@{$self->{'finished'}}, $node);
   }

   $self->{'depth'}--;

   # flag that we've reached the end of the document
   if ($self->{'depth'} == -1) {
      $self->{'EOD'} = 1;
   }
}

1;

__END__