use strict; use warnings; BEGIN { if ($] == 5.008) { print("1..0 # Skip due to Perl 5.8.0 bug\n"); exit(0); } } use Test::More 'no_plan'; package My::Data; { use Object::InsideOut; my @data :Field('Accessor' => 'data'); sub auto : Automethod { my $self = $_[0]; my $class = ref($self) || $self; my $name = $_; # No data if (! exists($data[$$self])) { return; } my $data = \@data; # Workaround for 5.6.X bug if ($$self == 1) { return (sub { my $self = $_[0]; my $class = ref($self) || $self; return (join(' ', $$self, $class, __PACKAGE__, $name, $$data[$$self])); }, 'CUM'); } return (sub { my $self = shift; my $class = ref($self) || $self; return (@_, join(' ', $$self, $class, __PACKAGE__, $name, $$data[$$self])); }, 'CHA(BOT)'); } } package My::Info; { use Object::InsideOut qw(My::Data); my @info :Field('Accessor' => 'info'); sub auto : Automethod { my $self = $_[0]; my $class = ref($self) || $self; my $name = $_; # No info if (! exists($info[$$self])) { return; } my $info = \@info; # Workaround for 5.6.X bug if ($$self == 1) { return (sub { my $self = $_[0]; my $class = ref($self) || $self; return (join(' ', $$self, $class, __PACKAGE__, $name, $$info[$$self])); }, 'CUM'); } return (sub { my $self = shift; my $class = ref($self) || $self; return (@_, join(' ', $$self, $class, __PACKAGE__, $name, $$info[$$self])); }, 'CHA(BOT)'); } } package My::Comment; { use Object::InsideOut qw(My::Info); my @comment :Field('Accessor' => 'comment'); sub AUTOMETHOD { if (/^foo$/) { return sub { return 'Bar->foo' } } return; } sub auto : Automethod { my $self = $_[0]; my $class = ref($self) || $self; my $name = $_; # No comment if (! exists($comment[$$self])) { return; } my $comment = \@comment; # Workaround for 5.6.X bug if ($$self == 1) { return (sub { my $self = $_[0]; my $class = ref($self) || $self; return (join(' ', $$self, $class, __PACKAGE__, $name, $$comment[$$self])); }, 'CUM'); } return (sub { my $self = shift; my $class = ref($self) || $self; return (@_, join(' ', $$self, $class, __PACKAGE__, $name, $$comment[$$self])); }, 'CHA(BOT)'); } } package main; MAIN: { my $obj = My::Comment->new(); my (@results, @data); $obj->info('test'); @results = @{$obj->flog()}; #print(join("\n", @results), "\n\n"); @data = ('1 My::Comment My::Info flog test'); is_deeply(\@results, \@data, 'Accumulation 1'); $obj->data('tool'); @results = @{$obj->bork()}; #print(join("\n", @results), "\n\n"); @data = ('1 My::Comment My::Data bork tool', '1 My::Comment My::Info bork test'); is_deeply(\@results, \@data, 'Accumulation 2'); $obj->comment('tassel'); @results = @{$obj->funge()}; #print(join("\n", @results), "\n\n"); @data = ('1 My::Comment My::Data funge tool', '1 My::Comment My::Info funge test', '1 My::Comment My::Comment funge tassel'); is_deeply(\@results, \@data, 'Accumulation 3'); $obj = My::Comment->new(); $obj->info('test'); @results = $obj->flog(); #print(join("\n", @results), "\n\n"); @data = ('2 My::Comment My::Info flog test'); is_deeply(\@results, \@data, 'Chained 1'); $obj->data('tool'); @results = $obj->bork(); #print(join("\n", @results), "\n\n"); @data = ('2 My::Comment My::Info bork test', '2 My::Comment My::Data bork tool'); is_deeply(\@results, \@data, 'Chained 2'); $obj->comment('tassel'); @results = $obj->funge(); #print(join("\n", @results), "\n\n"); @data = ('2 My::Comment My::Comment funge tassel', '2 My::Comment My::Info funge test', '2 My::Comment My::Data funge tool'); is_deeply(\@results, \@data, 'Chained 3'); } exit(0); # EOF