#!/usr/bin/perl -w
# $Id: bench_sax_base_libxml_complex,v 1.2 2003/09/19 18:52:26 mrodrigu Exp $
use strict;
use simple_benchmark; # to get memory size
use XML::LibXML::SAX;
use XML::SAX::Machines qw(:all); # to pipe the 2 SAX handlers
use XML::SAX::Writer;

use Getopt::Long;

my( $in_file, $print);
GetOptions( 'print!' => \$print, 'in_file=s' =>\$in_file); 
$in_file ||= 'test.xml';
$print= 1 unless( defined $print);

my @filters=  qw( XML::LibXML::SAX HandlerDelete HandlerDuplicate HandlerChangeTag HandlerPrefix HandlerAddAtt
									HandlerErase
                );
push @filters, 'XML::SAX::Writer' if( $print);

@filters= map { $_->new() } @filters;  # I should not need this, but I do!

Pipeline( @filters)->parse_uri( $in_file);

package HandlerDelete;
use base qw( XML::SAX::Base);
sub new { return bless { level => 0, in_delete => 0, delete_level => -1 }; }
sub start_element { my( $h, $elt)= @_;
		                $h->{level}++; 
				            if( ($elt->{Name} eq 'process') && ( ($elt->{Attributes}->{'{}action'}->{Value}||'') eq 'delete'))
										  { $h->{in_delete}= 1; 
										    $h->{delete_level}= $h->{level}; 
									    } 
									  else
		                  { $h->SUPER::start_element( $elt) unless( $h->{in_delete}); } 
								  }
sub end_element { my( $h, $elt)= @_;
		              if(  $h->{in_delete})
                    { if( ($elt->{Name} eq 'process') && ($h->{level}== $h->{delete_level}) )
												 { $h->{in_delete}= 0; }
										}
		              else
									  { $h->SUPER::end_element( $elt); }
		              $h->{level}--;
								}
sub characters { my( $h, $chars)= @_; $h->SUPER::characters( $chars) unless( $h->{in_delete}); }

package HandlerDuplicate;
use base qw( XML::SAX::Base);
sub new { return bless { level => 0, in_duplicate => 0, duplicate_level => -1, stored_events => [] }; }
sub start_element { my( $h, $elt)= @_;
		                $h->SUPER::start_element( $elt);  
		                $h->{level}++; 
				            if( ($elt->{Name} eq 'process') && ( ($elt->{Attributes}->{'{}action'}->{Value}||'') eq 'duplicate'))
										  { $h->{in_duplicate}= 1; 
										    $h->{duplicate_level}= $h->{level}; 
									    } 
										if( $h->{in_duplicate}) { push @{$h->{stored_events}}, { type => 'start_element', event => $elt }; }
								  }
sub end_element { my( $h, $elt)= @_;
									$h->SUPER::end_element( $elt); 
									if( $h->{in_duplicate})
                    { push @{$h->{stored_events}}, { type => 'end_element', event => $elt };  
                      if( ($elt->{Name} eq 'process') && ($h->{level} == $h->{duplicate_level}) )
												 { $h->{in_duplicate}= 0; 
													 $h->replay_stored_events;
													 $h->{stored_events}= [];
												 }
										}
		              $h->{level}--;
								}
								
sub characters { my( $h, $chars)= @_; 
						     $h->SUPER::characters( $chars);
		             if( $h->{in_duplicate}) { push @{$h->{stored_events}}, { type => 'characters', event => $chars }; }
						   }

sub replay_stored_events
  { my $h= shift;
    foreach my $event ( @{$h->{stored_events}})
      { my $type= $event->{type};
				my $data= $event->{event};
        if( $type eq 'start_element')
          { $h->SUPER::start_element( $data); }
        elsif( $type eq 'end_element')
          { $h->SUPER::end_element( $data); }
        elsif( $type eq 'characters')
          { $h->SUPER::characters( $data); }
      }
  }

package HandlerChangeTag;
use base qw( XML::SAX::Base);
sub new { return bless { level => 0, change_level => -1 }; }
sub start_element { my( $h, $elt)= @_;
		                $h->{level}++; 
				            if( ($elt->{Name} eq 'process') && ( ($elt->{Attributes}->{'{}action'}->{Value}||'') eq 'change_tag'))
										  { $h->{change_level}= $h->{level}; 
												$elt->{Name}= 'new_tag'; 
									    } 
		                $h->SUPER::start_element( $elt); 
								  }
sub end_element { my( $h, $elt)= @_;
                    { if( ($elt->{Name} eq 'process') && ($h->{level}== $h->{change_level}) )
												{ $h->{change_level}= -1;
														$elt->{Name}= 'new_tag';	
												}
										}
									$h->SUPER::end_element( $elt);
		              $h->{level}--;
								}

package HandlerPrefix;
use base qw( XML::SAX::Base);
sub start_element { my( $h, $elt)= @_;
										$h->SUPER::start_element( $elt); 
				            if( ($elt->{Name} eq 'process') && ( ($elt->{Attributes}->{'{}action'}->{Value}||'') eq 'prefix'))
										  { $h->SUPER::start_element( { Name => 'prefix' });
												$h->SUPER::characters( { Data => "prefixed "});
										    $h->SUPER::end_element( { Name => 'prefix' });
											}
								  }

								
package HandlerAddAtt;
use base qw( XML::SAX::Base);
sub start_element { my( $h, $elt)= @_;
				            if( ($elt->{Name} eq 'process') && ( ($elt->{Attributes}->{'{}action'}->{Value}||'') eq 'add_att'))
										  { $elt->{Attributes}->{'{}new_att'}= { Name => 'new_att', Value => 'foo' }; }
										$h->SUPER::start_element( $elt); 
								  }

package HandlerErase;
use base qw( XML::SAX::Base);
sub new { return bless { level => 0, in_erase => 0, erase_level => -1 }; }
sub start_element { my( $h, $elt)= @_;
		                $h->{level}++; 
				            if( ($elt->{Name} eq 'process') && ( ($elt->{Attributes}->{'{}action'}->{Value}||'') eq 'erase'))
										  { $h->{in_erase}= 1; 
										    $h->{erase_level}= $h->{level}; 
									    } 
									  else
		                  { $h->SUPER::start_element( $elt); } 
								  }
sub end_element { my( $h, $elt)= @_;
		              if( $h->{in_erase} &&  ($elt->{Name} eq 'process') && ($h->{level}== $h->{erase_level}) )
                    { $h->{in_erase}= 0; }
		              else
									  { $h->SUPER::end_element( $elt); }
		              $h->{level}--;
								}