File Coverage

blib/lib/Class/Accessor/Lazy.pm

Criterion	Covered	Total	%
statement	67	90	74.4
branch	9	30	30.0
condition	11	30	36.6
subroutine	13	13	100.0
pod	3	3	100.0
total	103	166	62.0

package Class::Accessor::Lazy;
use strict; use warnings FATAL => 'all';
use 5.008;
use parent 'Class::Accessor';
use Class::Accessor::Lazy::Original;
use Class::Accessor::Lazy::Fast;
use Carp qw(confess);

our $VERSION = '1.003'; # change in pod

sub mk_lazy_accessors {
    my($self, @fields) = @_;

    return $self->_mk_lazy_accessors('rw', @fields);
}
sub mk_lazy_ro_accessors {
    my($self, @fields) = @_;

    return $self->_mk_lazy_accessors('ro', @fields);
}


*make_lazy_accessor = \&Class::Accessor::Lazy::Original::make_accessor;
*make_lazy_ro_accessor = \&Class::Accessor::Lazy::Original::make_ro_accessor;
*make_lazy_wo_accessor = \&Class::Accessor::Lazy::Original::make_wo_accessor;

{
    no strict 'refs';

    sub follow_best_practice {
        my $self = shift;
        my $class = ref $self || $self;

        $class->SUPER::follow_best_practice();

        return $self;
    }

    sub _mk_accessors {
        my $self = shift;
        my $class = ref $self || $self;

        $class->SUPER::_mk_accessors(@_);

        return $self;
    }

    sub _mk_lazy_accessors {
        my $self = shift;
        my($access, @fields) = @_;
        my $class = ref $self || $self;
        my $ra = $access eq 'rw' || $access eq 'ro';
        my $wa = $access eq 'rw' || $access eq 'wo';

        foreach my $field (@fields) {
            my $accessor_name = $self->accessor_name_for($field);
            my $mutator_name = $self->mutator_name_for($field);
            if( $accessor_name eq 'DESTROY' or $mutator_name eq 'DESTROY' ) {
                $self->_carp("Having a data accessor named DESTROY  in '$class' is unwise.");
            }

            my $lazy;
            if ($accessor_name eq $mutator_name) {
                my $accessor;
                if ($ra && $wa) {
                    $accessor = $self->make_lazy_accessor($field);
                    $lazy = 1;
                } elsif ($ra) {
                    $accessor = $self->make_lazy_ro_accessor($field);
                    $lazy = 1;
                } else {
                    $accessor = $self->make_lazy_wo_accessor($field);
                }

                my $fullname = "${class}::$accessor_name";
                my $subnamed = 0;
                unless (defined &{$fullname}) {
                    subname($fullname, $accessor) if defined &subname;
                    $subnamed = 1;
                    *{$fullname} = $accessor;
                }
                if ($accessor_name eq $field) {
                    # the old behaviour
                    my $alias = "${class}::_${field}_accessor";
                    subname($alias, $accessor) if defined &subname and not $subnamed;
                    *{$alias} = $accessor unless defined &{$alias};
                }
            } else {
                my $fullaccname = "${class}::$accessor_name";
                my $fullmutname = "${class}::$mutator_name";
                if ($ra and not defined &{$fullaccname}) { # guess, we need warning here, that accessor exists
                    my $accessor = $self->make_lazy_ro_accessor($field);
                    $lazy = 1;
                    subname($fullaccname, $accessor) if defined &subname;
                    *{$fullaccname} = $accessor;
                }
                if ($wa and not defined &{$fullmutname}) { # guess, we need warning here, that mutator exists
                    my $mutator = $self->make_lazy_wo_accessor($field);
                    subname($fullmutname, $mutator) if defined &subname;
                    *{$fullmutname} = $mutator;
                }
            }

            if( $lazy )
            {
                my $init_method = "${class}::_lazy_init_$field";
                unless (defined &{$init_method} ){
                    $self->_croak("Unable to create lazy accessor '$field' without defined init method $init_method");
                }
            }
        }
        return $self;
    }
}

1;

__END__