package Object;

use strict; use warnings;
use Carp;
use Data::Dumper; # for clone
use Heap::Fibonacci;

our $AUTOLOAD;

=pod

An object with attributes,
and a clone method.

To implement "virtual attributes",
subclass Object and implement
get_foo and/or set_foo methods.

You get foo() as shortcut for get_foo(),
foo($bar) as shortcut for set_foo($bar),
get("foo") and set("foo", $bar) for free.
Don't override these!

If an attribute starts with an underscore,
it won't be listed by the keys() method.
Use that for "private" stuff.

TODO implement classes to wrap lists, etc. separately - maybe

TODO if something is undef, accessors try to make it using rules
  - if you try to set something to undef, it remains the same as it was previously

=cut

sub new {
	my ($class, $self) = @_;
	$self ||= {};
	bless $self, $class;
	return $self;
}

sub nodes {
	my ($self) = @_;
	return [grep !/^_/, keys %$self];
}

sub keys {
	my ($self) = @_;
	return [grep !/^__/, keys %$self];
}

sub defined {
	my ($self) = @_;
	return [grep defined $self->{$_}, $self->keys];
}

sub get {
	my ($self, $attr) = @_;
	if (my $method = $self->can("get_$attr")) {
		return $method->();
	} elsif (ref $self->{$attr} eq "Object::Can") {
		my $value = $self->{$attr};
		if (ref $value eq "Object::Can") {
			$self->calc($attr);
		}
		return $value;
	} else {
		croak "cannot get: ".ref($self).".$attr";
	}
}

sub set {
	my $self = shift;
	my @attrs;
	while (my ($attr, $value) = splice @_, 0, 2) {
		push @attrs, $attr;
		if (defined $value) {
			if (my $method = $self->can("set_$attr")) {
				$method->($value);
			} elsif (exists $self->{$attr}) {
				$self->{$attr} = $value;
				$self->mod($attr, $value);
			} else {
				croak "cannot set: ".ref($self).".$attr";
			}
		}
	}
	$self->mod(\@attrs);
}

sub AUTOLOAD {
	my ($self, $value) = @_;
	if (!ref $self) {
		croak "unknown sub $AUTOLOAD";
	}
	my $method = $AUTOLOAD;
	$method =~ s/.*:://;
	return if $method eq "DESTROY";
	my $attr;
	if (@_ == 1) {
		return $self->get($method);
	} elsif (@_ == 2) {
		$self->set($method, $value);
	} else {
		croak "unknown sub/attr $method, called with ".@_." arguments";
	}
}

sub rule {
	my ($class, $from, $to, $op, $cost) = @_;
	no strict 'refs';
	$cost //= 1;
	my $rule = [$from, $to, $op, $cost];
	my $rules_from = ${"${class}::__rules_from"} ||= {};
	my $rules_to = ${"${class}::__rules_to"} ||= {};
	for my $x (@$from) {
		push @{$rules_from->{$x}}, $rule;
	}
	for my $x (@$to) {
		push @{$rules_to->{$x}}, $rule;
	}
}

sub rules_from {
	my ($class, $from) = @_;
	no strict 'refs';
	$class = ref $class || $class;
	my $rules = ${"${class}::__rules_from"}{$from};
	return $rules;
}

sub rules_to {
	my ($class, $to) = @_;
	no strict 'refs';
	$class = ref $class || $class;
	my $rules = ${"${class}::__rules_to"}{$to};
	return $rules;
}

sub mod {
	my ($self, $from) = @_;
	# set all derived attributes to either undef or Object::Can if we can calculate them, recursively
	# What happens when as with a + b = c, setting a or b might be thought to undef both of the others?
	# How do they work in that case?
}

sub calc {
	my ($self, $to) = @_;
	# $self->{$to} is an Object::Can - calculate the value and replace it using $self->set($to, $value)
}

sub make {
	my ($self, $to) = @_;
	my $path = $self->find_path_to($to);
	use Lib;
	warn D $path;
}

# this is a bit bogus!  XXX
sub clone {
	my ($self) = @_;
	my $dump = Dumper($self);
	$dump =~ s/^\$\S+\s*=\s*// or die "Dumper behaving weirdly";
	return eval($dump);
}

package Object::Can;
use base 'Object';

package Object;

sub test {
	use Lib;
	my $x = Object::Test->new({cows => 10});
	$x->cows(15);
	$x->cows == 1 or die "Object failed";
	print D $x->defined;
#	$x->make("legs");
#	print D $x;
#	print D $Object::Test::rules;
}

package Object::Test;
use base 'Object';
my $class = __PACKAGE__;

sub get_cows {
	return 1;
}

$class->rule(['cows'], ['legs'], 'times4', 1);

1
