package Diff;

use strict;
no strict 'refs';

use vars qw/$AUTOLOAD/;

use XML;

sub new {
	my ($package, $name) = @_;
	return bless { defined $name ? (name => $name) : () }, $package;
}

sub AUTOLOAD {
	my ($this) = @_;
	my $package = ref $this;
	(my $method = $AUTOLOAD) =~ s/.*:://;
	my ($query, $member) = $method =~ /^([^_]+)_(.*)/;
	my $entity_package = ${"${package}::entity_package"};

#	use Data::Dumper;
#	print Dumper \%{"${entity_package}::members"};

	($query) = $query =~ /(add|change|remove|rename)/;

#	print STDERR ">>$query $member\n";

	die qq{"can't make sense of method call '$AUTOLOAD'"} unless
		${"${entity_package}::members"}{$member} && $query;

#	print "$AUTOLOAD : $method : $query : $member\n";

	my $hash = $this->{$query} && $this->{$query}{$member} || {};
	my @keys = sort keys %$hash;

	return wantarray ? @keys : \@keys if $query eq 'add' || $query eq 'remove';

	return wantarray ? %$hash : $hash;
}

sub xml {
	my ($this, $name) = @_;
	my $package = ref $this;
	my $entity_package = ${"${package}::entity_package"};

	my $xml;
	for ('remove', 'change', 'add', 'rename') {
		next unless exists $this->{$_};
		$xml .= XML->tag("$_") .
			XML->indent( $entity_package->xml_member_diff($this->{$_}) ) .
			XML->tag("/$_");
	}

	if (defined (my $xml_element = ${"${package}::xml_element"})) {
		$xml = XML->tag("$xml_element", name => $name) .
		XML->indent($xml) .
		XML->tag("/$xml_element");
	}

	return $xml;
}

sub report {
	my ($this, $name) = @_;
	my $package = ref $this;
	my $entity_package = ${"${package}::entity_package"};
	my $report;

	for ('remove', 'add', 'rename') {
		next unless exists $this->{$_};
		my $part = $entity_package->report_member_diff($this->{$_});
		$report .= "$_:\n";
		$report .= XML->indent( $part );
	}
	if (exists $this->{change}) {
		my $part = $entity_package->report_member_diff($this->{change});
		$report .= $part;
	}

	if (defined (my $xml_element = ${"${entity_package}::xml_element"}) && defined $name) {
                $report = "$xml_element `$name'\n" .
	                XML->indent($report);
        }

	return $report;
}

# the XML for diffs sucks somewhat at the moment - as does the internal format, somewhat

sub xml_parse {
	my $this = shift;
	$this = $this->new unless ref $this;

	my $elements = ref $_[0] ? shift : \@_;

	my $package = ref $this;
	my $entity_package = ${"${package}::entity_package"};

	my $this_element = ${"${package}::xml_element"};
	my $expecting = defined $this_element ? "</$this_element>" : "end of document";
	
	while (@$elements) {
		my $token = shift @$elements;
		my ($type, $data, @attributes) = @$token;
		if ($type eq 'end') {
			die "XML syntax: found </$data>, expecting $expecting" if $data ne $this_element;
			last;
		} elsif ($type eq 'start') {
			if ($data eq 'change' || $data eq 'add' || $data eq 'remove' || $data eq 'rename') {
				# we are parsing a change, add or remove section of this diff
				while (@$elements) {
					my $token = shift @$elements;
					my ($type, $data1, @attributes) = @$token;
					if ($type eq 'end') {
						die "XML syntax: found </$data1>, expecting </$data>" if $data1 ne $data;
						last;
					} elsif ($type eq 'start') {
						die "expecting at least one attribute" unless @attributes >= 2;
						my $attr = $attributes[0] || '';
						if ($attr ne 'value') {
#							my $name = $attributes[1];
							$data1 =~ s/:diff$//; # this is SO dodgy!!
							my ($container, $class) = $entity_package->methods::container_class_by_xml_element($data1);
							my ($element, $name);
							if ($data eq 'change') { # change - expecting a nested Diff object
								die "expecting name attribute" unless $attr eq 'name';
								$name = $attributes[1];
								my $diff_class = "${class}::Diff";
								$element = $diff_class->new($name);
								$element->xml_parse($elements);
#  							else { # add / remove - expecting an embedded object
#  								$element = $class->new(@attributes);
#  								$element->xml_parse($elements);
#  								$name = $element->name;
							} elsif ($data eq 'rename') {
								die "expecting old attribute" unless $attr eq 'old';
								$name = $attributes[1];
								die "expecting name attribute" unless $attributes[2] eq 'name';
								$element = $attributes[3]; # the new name
  								my $token = shift @$elements;
  								die "missing end tag for reference" unless $token && $token->[0] eq 'end' && $token->[1] eq $data1;
							} else { # add / remove - expecting nothing inside - stick '1' in the data structure
  								die "expecting name attribute" unless $attr eq 'name';
  								$name = $attributes[1];
  								$element = 1;
  								my $token = shift @$elements;
  								die "missing end tag for reference" unless $token && $token->[0] eq 'end' && $token->[1] eq $data1;
  							}
							$this->{$data}{$container}{$name} = $element;
						} else { # $attr eq 'value'
							my $value = $attributes[1];
							$this->{$data}{$data1} = $value;
							my $token = shift @$elements;
							die "missing end tag for value" unless $token && $token->[0] eq 'end' && $token->[1] eq $data1;
						}
					} elsif ($type eq 'text') {
						die "not expecting text outside attributes in diff";
					}
				}
			} else {
				die "XML syntax: found <$data>, expecting <remove>, <change> or <add>";
			}
		} elsif ($type eq 'text') {
			die "not expecting text outside attributes in diff";
		}
	}
	return $this;
}

sub DESTROY { }

1