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;