use strict; use warnings; use Test::More 'no_plan'; #MODIFY_CODE_ATTRIBUTES #MODIFY_HASH_ATTRIBUTES #MODIFY_ARRAY_ATTRIBUTES #MODIFY_SCALAR_ATTRIBUTES package Foo; { use Object::InsideOut; sub _add_defaults :MOD_SCALAR_ATTRS { my ($pkg, $scalar, @attrs) = @_; my @unused_attrs; # List of any unhandled attributes while (my $attr = shift(@attrs)) { if ($attr =~ /^D\('?([^)']+)'?\)/i) { $$scalar = $1; Test::More::ok(1, "Foo: $attr"); } else { push(@unused_attrs, $attr); } } return (@unused_attrs); } sub _make_fields :MOD_ARRAY_ATTRS { my ($pkg, $array, @attrs) = @_; my @unused_attrs; # List of any unhandled attributes while (my $attr = shift(@attrs)) { if ($attr =~ /^F\('?([^)']+)'?\)/i) { push(@unused_attrs, "Field('all' => '$1')"); } else { push(@unused_attrs, $attr); } } return (@unused_attrs); } my @foo :F(foo); # :Field('all'=>'foo') } package Bork; { use Object::InsideOut; sub _check_attr :MOD_ARRAY_ATTRS { my ($pkg, $array, @attrs) = @_; my @unused_attrs; # List of any unhandled attributes while (my $attr = shift(@attrs)) { if ($attr eq 'Test') { Test::More::ok(1, "Bork: $attr"); } else { push(@unused_attrs, $attr); } } return (@unused_attrs); } } package Bar; { use Object::InsideOut qw(Foo Bork); my $iam :D(ima_foo); sub iam { return ($iam); } my @bar :F('bar') Test; sub _fetch_attrs :FETCH_CODE_ATTRS { my ($pkg, $ref) = @_; if ($ref == \&iam) { return ('Method'); } } } package main; MAIN: { is(Bar::iam, 'ima_foo' => 'Scalar default'); my $obj = Bar->new(); can_ok($obj => qw(foo bar)); is((attributes::get(Bar->can('iam')))[0], 'Method', 'Fetch attr'); } exit(0); # EOF