File Coverage

blib/lib/Class/Data/Accessor.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	13	14	92.8
condition	5	6	83.3
subroutine	9	9	100.0
pod	2	2	100.0
total	68	70	97.1

package Class::Data::Accessor;
use strict;
use warnings;
use Carp;
use vars qw($VERSION);
$VERSION = '0.04004';

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

    if( ref $declaredclass ) {
        croak("mk_classaccessor() is a class method, not an object method");
    }

    if( $attribute eq 'DESTROY' ) {
        carp("Having a data accessor named DESTROY in '$declaredclass' is unwise.");
    }

    my $accessor = sub {
        if (ref $_[0]) {
          return $_[0]->{$attribute} = $_[1] if @_ > 1;
          return $_[0]->{$attribute} if exists $_[0]->{$attribute};
        }

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

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

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

    no warnings qw/redefine/;
    no strict qw/refs/;
    my $alias = "_${attribute}_accessor";
    *{$declaredclass.'::'.$attribute} = $accessor;
    *{$declaredclass.'::'.$alias}     = $accessor;
}

sub mk_classaccessors {
    my ($declaredclass, @attributes) = @_;

    foreach my $attribute (@attributes) {
        $declaredclass->mk_classaccessor($attribute);
    }
};

__END__