Posted by admin (Graham Ellis), 17 January 2003
The ultimate "standard" class in Perl ... a constuctor and a set method each of which takes its parameters as a hash of settings to make, a get method to get any property, and an AUTOLOAD that lets you call any non-existatnt set or get method that you like and it will do what you mean.
Code:# The ultimate standard class!
package animal;
use Carp;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw($counter);
$counter = 0;
sub new {
my ($class,@params) = @_ ;
my %info;
$counter++;
set(\%info,@params);
bless \%info,$class;
}
sub set {
my ($obj,@params) = @_;
if (@params%2) {
croak("Snuffed it it set ... ");
}
%setup = @params;
foreach $p (keys %setup) {
$q = $p;
$p =~ s/^-//;
unless ($pnv{$p}) {
carp("Can't set $p. Not a valid property");
} else {
$$obj{$p} = $setup{$q};
}
}
1;
}
sub get {
my ($obj,$what) = @_;
unless ($pnv{$what}) {
carp("Can't get $what. Not a valid property");
return 0;
}
return $$obj{$what};
}
sub AUTOLOAD {
my ($obj,$value) = @_;
($dirn,$what) = ($AUTOLOAD =~ /.*:(...)(.*)/);
if ($dirn eq "set") {
unless ($pnv{$what}) {
carp("Can't set $what. Not a valid property");
return 0;
}
$$obj{$what} = $value;
return 1;
}
if ($dirn eq "get") {
unless ($pnv{$what}) {
carp("Can't get $what. Not a valid property");
return 0;
}
return $$obj{$what};
}
# Check for anything else ;-)
0;
}
foreach $pname (qw(speed legs age weight comment colour)) {
$pnv{$pname} = 1;
}
print "Loaded in class, Copyright me, now\n";
1;
|
|
This page is a thread posted to the opentalk forum
at
www.opentalk.org.uk and
archived here for reference. To jump to the archive index please
follow
this link.
fb63
