#! /usr/bin/perl

use strict;
use warnings;
use Data::Dumper;

package XML::TemplateSAX::Handler;
use base qw(XML::SAX::Base);

sub new {
	my $class = shift;
	my %options = @_;

	my $self = {
		obj => $options{'Content'},
		stack => [],
		Handler => $options{'Handler'}
	};
	bless($self, $class);
	return $self;
}

sub start_element {
	my ($self, $data) = @_;
	my $obj = $self->{'obj'};

	# find the ID, if any
	my $id = $data->{'Attributes'}->{'{http://template.sesse.net/}id'};
	$id = $id->{'Value'} if (defined($id));

	# within a replacement; just ignore everything	
	return if (!defined($obj));

	# within a cloning; slurp it up
	if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
		$obj->start_element($data);
		return;
	}

	# substitution: see if this element matches anything. if so,
	# descend down into the tree.
	if (ref($obj) eq 'HASH') {
		my $match = undef;
		for my $key (keys %$obj) {
			if ($key =~ /^#(.*)$/) {
				if (defined($id) && $id eq $1) {
					$match = $obj->{$key};
					last;
				}
			} else {
				if ($data->{'LocalName'} eq $key) {
					$match = $obj->{$key};
					last;
				}
			}
		}

		if (defined($match)) {
			$self->SUPER::start_element($data);
		
			# FIXME: we should match on something better than the name. But what?
			push @{$self->{'stack'}}, [ $data->{'Name'}, $obj ];

			#
			# This is sort of ugly. We special-case replacement by outputting
			# the string immediately, and then just ignoring the rest of the
			# events until we get to the right end tag. It's not 100% technically
			# correct for the case where you replace an entire document by a
			# string, but that's nonsensical anyway.
			#
			if (!ref($match)) {
				$self->SUPER::characters({ Data => $match });
				$self->{'obj'} = undef;
				return;
			}

			#
			# Sort of the same, for cloning. Cloning works by gobbling up all the all the
			# input until the end element, and put it into a buffer. when we get to the end
			# element, spew it all out again as many times as we need, onto ourselves so we
			# get filtering etc. right.
			#
			# We let the buffer object keep the actual array, so we can fetch it out later.
			#
			if (ref($match) eq 'ARRAY') {
				$self->{'obj'} = XML::TemplateSAX::Buffer->new($match);
				return;
			}
			
			$self->{'obj'} = $match;
			return;
		}
	}
	

	$self->SUPER::start_element($data);
}

sub characters {
	my ($self, $data) = @_;

	return if (!defined($self->{'obj'}));
	
	if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
		$self->{'obj'}->characters($data);
		return;
	}

	$self->SUPER::characters($data);
}

sub comment {
	my ($self, $data) = @_;

	return if (!defined($self->{'obj'}));
	
	if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
		$self->{'obj'}->comment($data);
		return;
	}

	$self->SUPER::comment($data);
}

sub processing_instruction {
	my ($self, $data) = @_;

	return if (!defined($self->{'obj'}));
	
	if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
		$self->{'obj'}->processing_instruction($data);
		return;
	}

	$self->SUPER::processing_instruction($data);
}

sub end_element {
	my ($self, $data) = @_;

	my $stack = $self->{'stack'};
	if (scalar @$stack > 0) {
		my $top = $stack->[scalar @$stack - 1];
		
		if ($data->{'Name'} eq $top->[0]) {
			my $obj = $self->{'obj'};

			# did we just finish a clone operation?
			if (ref($obj) eq 'XML::TemplateSAX::Buffer') {
				for my $instance (@{$obj->{'ptr'}}) {
					$self->{'obj'} = $instance;
					$obj->replay($self);
				}
			}

			$self->SUPER::end_element($data);
			$self->{'obj'} = $top->[1];
			pop @$stack;
			return;
		}
	}
	
	return if (!defined($self->{'obj'}));
	
	if (ref($self->{'obj'}) eq 'XML::TemplateSAX::Buffer') {
		$self->{'obj'}->end_element($data);
		return;
	}

	$self->SUPER::end_element($data);
}

1;
