The Secret of Class::Data::Inheritable

Class::Data::Inheritable

• http://search.cpan.org/~tmtm/Class-Data-Inheritable-0.08/lib/Class/Data/Inheritable.pm

#
# package Parent
#
package Parent;
use base qw(Class::Data::Inheritable);

Parxent->mk_classdata('suitcase');

Parent->suitcase('Red');
print "Parent->suitcase ", Parent->suitcase, "\n";

#
# package Child
#
package Child;
use base Parent;

print "Child->suitcase ", Child->suitcase, "\n\n";
      

소스

package Class::Data::Inheritable;

use strict qw(vars subs);
use vars qw($VERSION);
$VERSION = '0.08';

sub mk_classdata {
    my ($declaredclass, $attribute, $data) = @_;

    if( ref $declaredclass ) {
        require Carp;
        Carp::croak("mk_classdata() is a class method, not an object method");
    }

    my $accessor = sub {
        my $wantclass = ref($_[0]) || $_[0];

        return $wantclass->mk_classdata($attribute)->(@_)
          if @_>1 && $wantclass ne $declaredclass;

        $data = $_[1] if @_>1;
        return $data;
    };

    my $alias = "_${attribute}_accessor";
    *{$declaredclass.'::'.$attribute} = $accessor;
    *{$declaredclass.'::'.$alias}     = $accessor;
}

1;

__END__
      

Parent

Parent->mk_classdata('suitcase');
      

• $declareclass = Parent
• $attribute = suitcase

Parent

Parent->suitcate('Red')
      

• $wantclass = Parent
• $declarclass = Parent
• 'Red'

Child

Child->suitcase
      

• $wantclass = Child
• $declareclass = Parent
• $wantclass->mk_classdata($attribute)->(@_)