I tried to make a simple module:
# 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;
And use it thusly:
#!/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};
The idea was to somewhat emulate def foo and def bar= from Ruby.
If I use $_ = Foo->new, everything works as expected.
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)')
However, with $_ = Bar->new as above, it no longer works.
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)')
To me, it seems like bouncing back out of &AUTOLOAD doesn't return to into traversing @ISA, which is sad. :-(
Am I misinterpreting something, and is there a better way of doing this? I don't want to have to (pre)declare all of the attributes that I'll be using.
Update:
Now I understand a little better.
If I call $_->Bar::foo, that does not ever get translated into $_->Foo::foo, regardless of @ISA.
Now that I understand that only ->foo has magic, and not ->Bar::foo, it makes fixing the problem easy.
Update^2:
Silly me. UNIVERSAL::can returns exactly what I wanted: a "magical" code ref that follows inheritance when you call it, so I changed my code to use it.
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 symbo
+l table
$AUTOLOAD =~ /(?<![^:])get_([^:]*)$/s ? do { # define a gette
+r
my $attr = $1;
sub($) {ref $_[0] ? $_[0]->{$attr} : ${"$_[0]::$attr"}};
} :
$AUTOLOAD =~ /(?<![^:])set_([^:]*)$/s ? do { # define a sette
+r
my $attr = $1;
sub($$) {
ref $_[0] ? $_[0]->{$attr} : ${"$_[0]::$attr"} = $_[1]
+;
$_[0];
};
} : do { # get/set depend
+ing 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
}
Thanks!
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.