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.