package Object;

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

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

=cut

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

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

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

sub set {
	my ($self, $attr, $value) = @_;
	if (my $method = $self->can("set_$attr")) {
		return $method->($value);
	} elsif (exists $self->{$attr}) {
		$self->{$attr} = $value;
	} else {
		croak "cannot set: ".ref($self).".$attr";
	}
}

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 (($attr) = $method =~ /^get_(.*)/) {
		return $self->get($1);
		exists $self->{$attr} or
			croak "cannot get attribute: ".ref($self).".$attr";
		return $self->{$attr};
	} elsif (($attr) = $method =~ /^set_(.*)/) {
		exists $self->{$attr} or
			croak "cannot set attribute: ".ref($self).".$attr";
		$self->{$attr} = $value;
	} else {
		if (@_ == 1) {
			return $self->get($method);
		} elsif (@_ == 2) {
			$self->set($method, $value);
		} else {
			croak "unknown sub $method, called with ".@_." arguments";
		}
	}
}

# 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);
}

sub test {
	use Lib;
	my $x = Object::Test->new({cow => 10, feet => 4});
	$x->cow(15);
	$x->cow == 1 or die "Object failed";
	print D $x;
}

package Object::Test;
use base 'Object';
sub get_cow {
	return 1;
}

1
