On Jun 18, 2008, at 6:35 PM, Andy Armstrong wrote:
I assume there's a module that works like this?
[snip]
It's got to exist, right? I had a look but there are so many ^
(?:Object|Data)::.* modules that it's a bit hard to see the wood
for the trees :)
--
Andy Armstrong, Hexten
Implemented! See the attached .pm file and the test.pl file that
verifies the four snipped use cases. It could certainly be made more
readable, but my interest is waning quickly. :-) I hereby grant
anyone permission to use/extend this crappy code under the same
license terms as Perl itself.
Chris
package MyFoo;
use Data::Auto::Objectify::Thing qw( my_data_field );
sub new {
bless {
my_data_field => {
foo => [ 1, 2, 3 ],
bar => { eat => 'drink', sleep => 'wake' },
grid => [
[1,2,3,4,5,6], [7,8,9,10,11,12],
[13,14,15,16,17,18], [19,20,21,22,23,24],
],
}
},
shift;
}
package main;
use Test::More tests => 4;
my $my_foo = MyFoo->new;
is($my_foo->foo( 1 ), 2);
is($my_foo->bar->eat, 'drink');
is($my_foo->bar('eat'), 'drink');
is($my_foo->grid(3, 5), 24);
package Data::Auto::Objectify::Thing;
use warnings;
use strict;
use Carp;
use Data::Dumper;
sub import {
my ($pkg, $fieldname) = @_;
my $caller_pkg = caller(0);
no strict 'refs';
*{$caller_pkg . '::AUTOLOAD'} = sub {
my ($self, @args) = @_;
my $autoload = do {
no strict 'vars';
$AUTOLOAD;
};
return if $autoload =~ /::DESTROY$/;
my ($fn) = $autoload =~ m/([^:]+)\z/xms;
if (defined $fieldname) {
$self = $self->{$fieldname};
}
if (!exists $self->{$fn}) {
croak 'No such field ' . $fn;
}
my $field = $self->{$fn};
if (!ref $field) {
return $field;
}
if ('ARRAY' eq ref $field) {
$field = $field->[$_] for @args;
return $field;
}
my $obj = bless {xyzzy => $field}, 'Data::Auto::Objectify::Thing::anon';
$obj = $obj->$_() for @args;
return $obj;
};
return;
}
package Data::Auto::Objectify::Thing::anon;
Data::Auto::Objectify::Thing->import('xyzzy');
1;
