# Autoattr.pm
package Autoattr;
our $DEBUG;
sub new($) {
$DEBUG and printf STDERR "%s::new(%s)\n",
__PACKAGE__, join ', ', map "'$_'", @_;
ref $_[0] ? bless {%{$_[0]}}, ref $_[0] : bless {}, $_[0];
}
sub DESTROY {
$DEBUG and printf STDERR "%s::DESTROY(%s)\n",
__PACKAGE__, join ', ', map "'$_'", @_;
return;
}
sub AUTOLOAD {
no strict qw(refs);
our $AUTOLOAD;
$DEBUG and printf STDERR "%s::AUTOLOAD=%s(%s)\n",
__PACKAGE__, $AUTOLOAD, join ', ', map "'$_'", @_;
if ($AUTOLOAD =~ /:get_([^:]*)$/) {
my $attr = $1;
*{$AUTOLOAD} = sub {$_[0]->{$attr}};
}
elsif ($AUTOLOAD =~ /:set_([^:]*)$/) {
my $attr = $1;
*{$AUTOLOAD} = sub {$_[0]->{$attr} = $_[1]; $_[0]};
}
else {
(my $get = $AUTOLOAD) =~ s/([^:]*)$/get_$1/;
(my $set = $AUTOLOAD) =~ s/([^:]*)$/set_$1/;
*{$AUTOLOAD} = sub {goto \&{$#_ ? $set : $get}};
}
goto \&$AUTOLOAD;
}
1;
####
#!/usr/bin/perl -w
package Foo;
use base qw(Autoattr);
sub get_foo {$_[0]->{foo} .= 'foo'}
sub set_bar {$_[0]->{bar} = 'bar' x $_[1]; $_[0]}
package Bar;
use base qw(Foo);
package main;
BEGIN {$Autoattr::DEBUG = 1}
$_ = Bar->new;
printf "\n>>> %s, %s, %s\n\n",
$_->foo,
$_->foo,
$_->foo;
printf "\n>>> %s, %s, %s\n\n",
do {$_->bar(3); $_->bar},
do {$_->bar(2); $_->bar},
do {$_->bar(1); $_->bar};
##
##
Autoattr::new('Foo')
Autoattr::AUTOLOAD=Foo::foo('Foo=HASH(0x225140)')
>>> foo, foofoo, foofoofoo
Autoattr::AUTOLOAD=Foo::bar('Foo=HASH(0x225140)', '3')
Autoattr::AUTOLOAD=Foo::get_bar('Foo=HASH(0x225140)')
>>> barbarbar, barbar, bar
Autoattr::DESTROY('Foo=HASH(0x225140)')
##
##
Autoattr::new('Bar')
Autoattr::AUTOLOAD=Bar::foo('Bar=HASH(0x225164)')
Autoattr::AUTOLOAD=Bar::get_foo('Bar=HASH(0x225164)')
Use of uninitialized value in printf at C:\dev\perl\test.pl line 32.
Use of uninitialized value in printf at C:\dev\perl\test.pl line 32.
Use of uninitialized value in printf at C:\dev\perl\test.pl line 32.
>>> , ,
Autoattr::AUTOLOAD=Bar::bar('Bar=HASH(0x225164)', '3')
Autoattr::AUTOLOAD=Bar::set_bar('Bar=HASH(0x225164)', '3')
Autoattr::AUTOLOAD=Bar::get_bar('Bar=HASH(0x225164)')
>>> 3, 2, 1
Autoattr::DESTROY('Bar=HASH(0x225164)')
##
##
package Autoattr;
our $DEBUG;
sub new($) {
$DEBUG and printf STDERR "%s::new(%s)\n",
__PACKAGE__, join ', ', map "'$_'", @_;
ref $_[0] ? bless {%{$_[0]}}, ref $_[0] : bless {}, $_[0];
}
sub DESTROY {
$DEBUG and printf STDERR "%s::DESTROY(%s)\n",
__PACKAGE__, join ', ', map "'$_'", @_;
return;
}
sub AUTOLOAD {
no strict qw(refs);
$DEBUG and printf STDERR "%s::AUTOLOAD=%s(%s)\n",
__PACKAGE__, our $AUTOLOAD, join ', ', map "'$_'", @_;
*{$AUTOLOAD} = # into the symbol table
$AUTOLOAD =~ /(?{$attr} : ${"$_[0]::$attr"}};
} :
$AUTOLOAD =~ /(?{$attr} : ${"$_[0]::$attr"} = $_[1];
$_[0];
};
} : do { # get/set depending on @_
(my $get = $AUTOLOAD) =~ s/([^:]*)$/get_$1/;
(my $set = $AUTOLOAD) =~ s/([^:]*)$/set_$1/;
sub($;$) {$#_ ? $_[0]->$set(@_[1 .. $#_]) : $_[0]->$get};
}
;
$AUTOLOAD =~ /([^:]*)$/; goto $_[0]->can($1); # go to the new symbol
}