
package AutoGen;
use strict;

my %attr_ok;

sub import {
  my $caller = caller;
  my ($class, @ATTRS) = @_;
  for my $attr (@ATTRS) {
    $attr_ok{$caller}{$attr} = "ok";
  }
  no strict 'refs';
  push @{"$caller\::ISA"}, "AutoGen::Accessors";
}

package AutoGen::Accessors;
use Carp 'croak';
our($AUTOLOAD);

sub AUTOLOAD {
  my ($package, $method) = $AUTOLOAD =~ /(.*)::(.*)/;
  my ($setget, $attr) = $method =~ /^(set|get)_(.*)/;

  unless (defined $setget) {
    croak qq{>Can\'t locate object method "$method" via package "$package"};
  }

  my @base_classes = $package;

  my $attr_ok;
  while (@base_classes) {
    my $cur_class = shift @base_classes;
    { no strict 'refs'; push @base_classes, @{"$cur_class\::ISA"}; }
    $attr_ok = 1, last if $attr_ok{$cur_class}{$attr};
  }
# $attr_ok = $attr_ok{$package}{$attr};

  if ($attr_ok) {
    no strict 'refs';
    if ($setget eq "set") {
      *$AUTOLOAD = sub {
        my ($self, $val) = @_;
        my $old = $self->{$attr};
        $self->{$attr} = $val;
        return $old;
      };
      goto &$AUTOLOAD;
    } elsif ($setget eq "get") {
      *$AUTOLOAD = sub {
        my $self = shift;
        return $self->{$attr};
      };
      goto &$AUTOLOAD;
    } else { die "setget=$setget" }
  }

  croak "Unknown attribute '$attr' in '$method'";
}

sub DESTROY { }  # Do-nothing

1;


