File Coverage

blib/lib/Class/Data/Lite.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	9	10	90.0
condition			n/a
subroutine	10	10	100.0
pod			n/a
total	54	55	98.1

package Class::Data::Lite;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.0010";

sub _croak {require Carp; Carp::croak(@_) }

sub import {
    shift;
    my %args = @_;
    my $pkg = caller(0);

    my %key_ctor = (
        rw => \&_mk_accessor,
        ro => \&_mk_ro_accessor,
    );

    no strict 'refs';
    for my $key (keys %key_ctor) {
        if (my $accessors = delete $args{$key}) {
            _croak "value of the '$key' parameter should be an arrayref or hashref"
                unless ref($accessors) =~ /^(?:HASH|ARRAY)$/;
            my %h = ref($accessors) eq 'HASH' ? %$accessors : map {($_ => undef)} @$accessors;
            while (my ($k, $v) = each %h) {
                *{"${pkg}::${k}"} = $key_ctor{$key}->($pkg, $k, $v);
            }
        }
    }
}

sub _mk_accessor {
    my ($pkg, $meth, $data) = @_;
    return sub {
        if (@_>1) {
            if ($_[0] ne $pkg) {
                # In the case of rw, raise an exception here because there is a
                # possibility of being overwritten from a child class.
                # In the case of ro, there is no risk, so we do not raise
                # exceptions in particular.
                _croak qq[can't call "${pkg}::${meth}" as object method or inherited class method];
            }
            $data = $_[1];
        }
        $data;
    };
}

sub _mk_ro_accessor {
    my ($pkg, $meth, $data) = @_;
    return sub { $data };
}

1;
__END__