hoelzro has asked for the wisdom of the Perl Monks concerning the following question:

I'm trying to write a basic object class for a program I'm writing, and this class will automatically generate getter/setter methods for members given to new using AUTOLOAD. I want it so if a method already exists with the name of a member, the new method will warn them unless the attribute "override" is attached to that method. So here's my code:
#!/usr/bin/perl # Object.pm package Pixie::Object; use strict; use warnings; require v5.6.0; use attributes (); use Exception::Class ('PrivateFieldException' => {isa => 'Exception::C +lass::Base', fields => ['field_name']}, 'NoSuchMemberException' => {isa => 'Exception::Class::Ba +se', fields => ['field_name']}); my %overrides; sub FETCH_CODE_ATTRIBUTES { my ($package, $referrent) = @_; return exists $overrides{$referrent} ? $overrides{$referrent} : () +; } sub MODIFY_CODE_ATTRIBUTES { my ($package, $referrent, @attrs) = @_; my @return; local $_; foreach (@attrs) { if($_ eq 'override') { $overrides{$referrent} = 'override'; } else { push @return, $_; } } return @return; } sub AUTOLOAD { my $this = shift; my $member = our $AUTOLOAD; $member =~ s/.*:://g; return unless($member =~ /[^A-Z]/); return $this->($member, @_); } sub new { my ($class, $members) = @_; my %members; my $this = bless sub { my ($key, $value) = @_; my ($package, $filename, $line) = caller; if($package ne __PACKAGE__) { # Allow protected access? PrivateFieldException->throw(message => 'Direct access of a pr +ivate field was attempted', field_name => $key); } unless(exists $members{$key}) { NoSuchMemberException->throw(message => 'No such member exists +', field_name => $key); } $members{$key} = $value if($value); return $members{$key}; }, $class; if($members) { while(my($key, $value) = each %$members) { $members{$key} = $value; if($this->can($key)) { # Do something more extreme? my @attributes = eval "attributes::get(\\&{\$this->$key})"; print "$key : @attributes\n"; warn "$class already has a method $key; this will be used inst +ead of field access." . " Attach attribute override to that method if you would +like to suppress this message."; } } } return $this; } 1; #!/usr/bin/perl # TestObject.pm # Test subclass for Pixie::Object package TestObject; use strict; use warnings; require Pixie::Object; our @ISA = qw(Pixie::Object); our $VERSION = 1.0; sub new { my $class = shift; return Pixie::Object::new($class, {foo => 56}); } sub foo : override { return "Howdy"; } 1;
Now, I thought that attribute handlers persisted throughout the ISA hierarchy. However, when I test this code, I get the following message:
Invalid CODE attribute: override at TestObject.pm line 19
BEGIN failed--compilation aborted at TestObject.pm line 21.
Compilation failed in require at ./test.pl line 6.
What's the deal? Is there a special mechanism I have to use to allow the attribute handlers to be inherited? Thanks, Rob

Replies are listed 'Best First'.
Re: subroutine attributes and ISA
by shmem (Chancellor) on Jul 14, 2007 at 07:46 UTC
    Attributes are determined and resolved at compile time (attributes::import is called when foo : override {} gets compiled). At that time, your derived class doesn't have @ISA set.

    Wrap your @TestObject::ISA setting into a BEGIN block:

    BEGIN { our @ISA = qw(Pixie::Object); }

    Otherwise the FETCH_CODE_ATTRIBUTES and MODIFY_CODE_ATTRIBUTES subroutines aren't resolvable when your sub foo : override { } gets compiled.

    Then, have a look at what your're checking in the "eval" in your Pixie::Object::new - I guess you mean something like

    # Do something more extreme? my @attributes = eval "attributes::get(\\\&$class\::$k +ey)"; print "$key : @attributes\n"; warn "$class already has a method $key; this will be u +sed instead of field access." . " Attach attribute override to that method if yo +u would like to suppress this message." unless grep(/^override/,@attributes);

    --shmem

    _($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                                  /\_¯/(q    /
    ----------------------------  \__(m.====·.(_("always off the crowd"))."·
    ");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}
      I put the our @ISA part into a BEGIN block, but the same error message comes up.
        I put the our @ISA part into a BEGIN block, but the same error message comes up.

        in TestObject.pm change

        require Pixie::Object;

        to

        use Pixie::Object;

        That should do.

        --shmem

        _($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                                      /\_¯/(q    /
        ----------------------------  \__(m.====·.(_("always off the crowd"))."·
        ");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}