Object::AutoAccessor - Accessor class by using AUTOLOAD

  use Object::AutoAccessor;

  my $struct = {
      foo => {
          bar => {
              baz => 'BUILD OK',
          },
      },
  };

  # Now let's easily accomplish it.
  my $obj = Object::AutoAccessor->build($struct);

  print $obj->foo->bar->baz; # prints 'BUILD OK'

  # OK, now reverse it!
  $obj->foo->bar->baz('TO HASHREF');
  my $hashref = $obj->as_hashref;
  print $hashref->{foo}->{bar}->{baz}; # prints 'TO HASHREF';

  # Of course, new() can be used.
  $obj = Object::AutoAccessor->new();

  # setter methods
  $obj->foo('bar');
  $obj->set_foo('bar');
  $obj->param(foo => 'bar');

  # getter methods
  $obj->foo();
  $obj->get_foo();
  $obj->param('foo');

  # $obj->param() is compatible with HTML::Template->param()
  my @keywords = $obj->param();
  my $val = $obj->param('hash');
  $obj->param(key => 'val');

  my $tmpl = HTML::Template->new(..., associate => [$obj], ...);

package Object::AutoAccessor;

require 5.004;
use strict;
use Carp;		# require 5.004

use vars qw($VERSION $AUTOLOAD);

$VERSION = '0.06';

sub new {
	my $obj = shift;
	my $class = ref($obj) || $obj;
	
	unless (@_ % 2 == 0) {
		croak "Odd number of argumentes for $class->new()";
	}
	
	my %args = @_;
	my $options = { autoload => 1 };
	$options->{$_} = $args{$_} for keys %args;
	bless $options, $class;
}

sub renew {
	my $obj = shift;
	my $class = ref($obj) || $obj;
	
	unless (@_ % 2 == 0) {
		croak "Odd number of argumentes for $class->renew()";
	}
	
	my %args = @_;
	if (ref($obj) and UNIVERSAL::isa($obj, __PACKAGE__)) {
		%args = map { $_ => $obj->{$_} } grep !/^params$/, keys %$obj;
	}
	$class->new(%args);
}

sub renew_node { shift->renew(@_) }

sub new_node {
	my $self = shift;
	
	unless (@_) {
		croak "Not enough arguments for " . ref($self) . "->new_node()";
	}
	
	my $label = shift;
	my $child = $self->renew(@_);
	$self->param($label => $child);
	$child;
}

sub node {
	my $self = shift;
	
	unless (@_) {
		return grep { $self->is_node($_) } keys(%{ $self->{params} });
	}
	
	my $first = shift;
	
	if (@_) {
		my @children = ();
		for my $label ($first,@_) {
			if ($self->is_node($label)) {
				push(@children, $self->{params}->{$label});
			}
			else {
				push(@children, undef);
			}
		}
		return wantarray ? @children : [@children];
	}
	else {
		if ($self->is_node($first)) {
			return $self->{params}->{$first};
		}
		else {
			return undef;
		}
	}
}

sub has_node { scalar shift->node() }

sub is_node {
	my $self = shift;
	
	unless (@_) {
		croak "Not enough arguments for " . ref($self) . "->is_node()";
	}
	
	my $label = shift;
	return (ref($self->{params}->{$label}) and UNIVERSAL::isa($self->{params}->{$label}, __PACKAGE__));
}

sub param {
	my $self = shift;
	
	unless (@_) {
		return grep { !$self->is_node($_) } keys(%{ $self->{params} });
	}
	
	my $first = shift;
	
	if (@_) {
		croak "Odd number of argumentes for " . ref($self) . "->param()" unless ((@_ % 2) == 1);
		
		my %hash = ($first,@_);
		
		for my $key (keys %hash) {
			my $ref = ( ref $hash{$key} );
			
			if ($ref eq 'HASH') {
				%{ $self->{params}->{$key} } = %{ $hash{$key} };
			}
			elsif ($ref eq 'ARRAY') {
				@{ $self->{params}->{$key} } = @{ $hash{$key} };
			}
			elsif ($ref eq 'SCALAR') {
				$self->{params}->{$key} = $hash{$key};
			}
			else {
				$self->{params}->{$key} = $hash{$key};
			}
		}
		
		if (@_ == 1) {
			return $self->{params}->{$first};
		}
	}
	else {
		if ($self->is_node($first)) {
			return undef;
		}
		
		my $type = ( ref $self->{params}->{$first} );
		
		if ($type eq 'HASH') {
			return \%{ $self->{params}->{$first} };
		}
		elsif ($type eq 'ARRAY') {
			return \@{ $self->{params}->{$first} };
		}
		elsif ($type eq 'SCALAR') {
			return $self->{params}->{$first};
		}
		else { # CODEREF, IO, GLOB, OBJECT
			return $self->{params}->{$first};
		}
	}
}

sub defined {
	my $self = shift;
	
	unless (@_) {
		croak "Not enough arguments for " . ref($self) . "->defined()";
	}
	
	my $label = shift;
	return CORE::defined($self->{params}->{$label});
}

sub exists {
	my $self = shift;
	
	unless (@_) {
		croak "Not enough arguments for " . ref($self) . "->exists()";
	}
	
	my $label = shift;
	return CORE::exists($self->{params}->{$label});
}

sub delete {
	my $self = shift;
	
	unless (@_) {
		croak "Not enough arguments for " . ref($self) . "->delete()";
	}
	
	my $label = shift;
	return CORE::delete($self->{params}->{$label});
}

sub undef {
	my $self = shift;
	
	unless (@_) {
		croak "Not enough arguments for " . ref($self) . "->undef()";
	}
	
	my $label = shift;
	return CORE::undef($self->{params}->{$label});
}

sub build {
	my $obj = shift;
	my $class = ref($obj) || $obj;
	
	unless (@_) {
		croak "Not enough arguments for " . $class . "->build()";
	}
	
	my $hashref = shift;
	
	unless (UNIVERSAL::isa($hashref, 'HASH')) {
		croak $class . "->build(): Cannot build: argument is not a HASH reference";
	}
	
	my $self = $class->new(@_);
	
	$self->_build($hashref);
	
	$self;
}

sub _build {
	my $self = shift;
	my $struct = shift;
	
	for my $key (keys %$struct) {
		if (UNIVERSAL::isa($struct->{$key}, 'HASH')) {
			$self->new_node($key)->_build($struct->{$key});
		}
		else {
			$self->param( $key => $struct->{$key} );
		}
	}
}

sub as_hashref {
	my $self = shift;
	
	my $hashref = {};
	
	$self->_as_hashref($hashref);
}

sub _as_hashref {
	my $self = shift;
	my $hashref = shift;
	
	for my $key (keys %{ $self->{params} }) {
		if (UNIVERSAL::isa($self->{params}->{$key}, __PACKAGE__)) {
			$hashref->{$key} = $self->node($key)->_as_hashref($hashref->{$key});
		}
		else {
			$hashref->{$key} = $self->param($key);
		}
	}
	
	$hashref;
}

sub autoload {
	my $self = shift;
	$self->{autoload} = shift if @_;
	$self->{autoload};
}

sub AUTOLOAD {
	my $self = shift;
	
	return if $AUTOLOAD =~ /::DESTROY$/;
	
	my ($method) = ($AUTOLOAD =~ /.*::(.*?)$/);
	
	if ( $self->{autoload} ) {
		if ( $self->can( $method ) ) {
			return $self->$method( @_ );
		}
		elsif ($method =~ /^([sg]et_)(.*)$/) {
			my($prefix, $name) = ($1, $2);
			if ($prefix eq 'set_') {
				return $self->param($name => @_);
			}
			else {
				carp "Too many arguments for " . ref($self) . "->get_$name\()" if @_;
				return $self->param($name);
			}
		}
		else {
			if ($self->is_node($method)) {
				if (@_) {
					undef $self->{params}->{$method};
					return $self->param($method => @_);
				}
				else {
					return $self->{params}->{$method};
				}
			}
			else {
				return $self->param($method => @_);
			}
		}
	}
	else {
		croak(ref($self) . "->$method\() : this method is not implimented");
	}
	
	return;
}

sub DESTROY {}

1;
__END__