package OO;
use strict;
use warnings;
use Carp qw/croak/;
####
#--------------------------------------------------------------------
# The registry itself: storing all the data of your objects
#--------------------------------------------------------------------
my %Object = ();
# Object => Class => Attribute
##
##
#--------------------------------------------------------------------
# inheritable constructor with generalized behaviour
#--------------------------------------------------------------------
sub new {
my $class = shift;
my $self = bless [caller], $class;
# is that neccessary if you can override new()?
if( $self->can( 'initialize' ) ){
$self->initialize( @_ );
}
return $self;
}
##
##
#--------------------------------------------------------------------
# Use these two methods to get and set members of your
# object and they will do encapsulation for you
#
# BE CONSISTENT our your OO will BREAK!
#
#--------------------------------------------------------------------
sub oo_get {
my $obj = shift;
my $field = shift;
# member hash is based on caller class
# and may be overwritten by third argument to get()
my $class = @_ ? shift : caller;
$Object{ $obj }{ $class }{ $field }
}
sub oo_set {
my $obj = shift;
my $field = shift;
my $value = shift;
my $class = @_ ? shift : caller;
$Object{ $obj }{ $class }{ $field } = $value;
}
##
##
#--------------------------------------------------------------------
# most important: DESTROY
#--------------------------------------------------------------------
sub DESTROY {
my $obj = shift;
delete $Object{ $obj } #that's why the structure of the registry was chosen like that
}
##
##
#--------------------------------------------------------------------
# create_accessor class method to create simple accessor/mutator methods
#--------------------------------------------------------------------
sub oo_create_accessor {
my $pkg = shift;
no strict 'refs'; # we're messing around with the symbol table
foreach my $mem ( @_ ){
my $symbol = $pkg . '::' . $mem;
if( defined *{ $symbol } ){
croak "Attempt to redefine $symbol via create_accessor";
}
else {
*{ $symbol } = sub {
my $self = shift;
if( @_ ){
$self->oo_set( $mem , $_[0] , $pkg );
}
else {
$self->oo_get( $mem , $pkg );
}
};
}
}
}
##
##
#--------------------------------------------------------------------
# debugging function/method (as you like it)
#--------------------------------------------------------------------
sub oo_registry {
return \%Object
}
1;