my $obj = DynObject->new(id => 'MyObj', action => sub{print "hi\n";}); print $obj->id, "\n"; $obj->action(); #### $obj = MyDyn->new(id => 'MyObj'); print $obj->id, "\n"; $obj->action(); package MyDyn; use base 'DynObject'; sub action { print "hi\n"; } #### use strict; package DynObject; use Carp; my $counter = 0; sub new { my $class = shift; croak("The number of parameters must be even") unless @_ % 2 == 0; no strict 'refs'; my $type = ref $class; my $code; if(!$type) { $type = __PACKAGE__; $type .= "::obj@{[$counter++]}"; *{"${type}::ISA"} = [$class]; } for(my $i = 0; $i < @_; $i+=2) { croak("The method name '$_[$i]' is not a word") unless $_[$i] =~ /^\w+$/ && $_[$i] !~ /^\d+$/; if(ref $_[$i+1] eq 'CODE') { *{"${type}::$_[$i]"} = $_[$i+1]; } elsif(defined $_[$i+1] && !ref $_[$i+1]) { my $str = $_[$i+1]; *{"${type}::$_[$i]"} = sub{$str}; } else { delete ${"${type}::"}{$_[$i]}; } } return ref $class ? $class : bless [], $type; } sub DESTROY { my $obj = shift; my $type = ref $obj; $type =~ s/(\w+)$//; my $name = $1 . "::"; no strict 'refs'; delete ${$type}{$name}; } 1;