package XMLParser;

use strict;
use XML::Parser;

use vars qw(@ISA %class_by_element);

@ISA = qw(XML::Parser);

sub new {
	my $package = shift;
	my $this = $package->SUPER::new(@_);
	my $elements = $this->{_XMLParser_elements} = [];
	$this->setHandlers(
		Start => sub { 
			my ($expat, $element, @attributes) = @_;
			push @$elements, ['start', $element, @attributes];
		},
		End => sub {
			my ($expat, $element) = @_;
			push @$elements, ['end', $element];
		},
		Char => sub {
			my ($expat, $text) = @_;
			($text) = $text =~ /\s*((?:\S.*)?\S)\s*/;
			return if ! defined $text || $text eq '';
			if (@$elements && $elements->[-1][0] eq 'text') {
				$elements->[-1][1] .= "\n" . $text;
			} else {
				push @$elements, ['text', $text];
			}
		}
        );

	return $this;
}

sub parse {
	my $this = shift;

	my $elements;

	if (ref $_[0] ne 'ARRAY') {
		$this = $this->new unless ref $this;
		$this->SUPER::parse(@_);
		$elements = $this->{_XMLParser_elements};
	} else {
		$elements = $_[0];
	}

	my $root = shift @$elements;
	my ($type, $element, @attr) = @$root;
	return $element if $type ne 'start';

	my $class = $class_by_element{$element};
	die "Unknown XML element <$element>" unless defined $class;
	my $doc = $class->new(@attr);
	$doc->xml_parse($elements);

	return $doc;
}

sub parsefile {
	my $self = shift;

	my $this = ref($self)?$self:$self->new();

	return $this->SUPER::parsefile(@_);
}

1
