__PACKAGE__->mk_class_data('__data_key'); sub new { my ( $class, $args ) = @_; # XXX I don't like doing this for every instance, but # use 'base' doesn't call import() my $key = " $class data "; $class->__data_key($key); $args ||= {}; unless ( 'HASH' eq reftype $args ) { croak('Argument to new() must be a hashref'); } my $self = bless { $key => $args } => $class; $self->_initialize; delete $self->{$key}; return $self; } sub _initialize { my $class = ref($_[0]); croak "_initialize() must be overridden in a ($class)"; } # a truly private method! my $check_attribute = sub { my ( $self, $attribute ) = @_; my $value = delete $self->{ $self->__data_key }->{$attribute}; if ( ! defined wantarray ) { $self->$attribute($value); } else { return $value; } }; sub _must_have { my ( $self, $attribute ) = @_; croak("Mandatory attribute ($attribute) not found") unless exists $self->{ $self->__data_key }->{$attribute}; goto $check_attribute; } sub _may_have { my ( $self, $attribute ) = @_; return unless exists $self->{ $self->__data_key }->{$attribute}; goto $check_attribute; }