File Coverage

blib/lib/Class/DBI/LazyInflate.pm

Criterion	Covered	Total	%
statement	21	29	72.4
branch	0	2	0.0
condition	0	3	0.0
subroutine	7	9	77.7
pod	1	1	100.0
total	29	44	65.9

# $Id: LazyInflate.pm 7 2005-06-01 06:36:24Z daisuke $
#
# Copyright (c) 2004-2005 Daisuke Maki
# All rights reserved.

package Class::DBI::LazyInflate;
use strict;
use Class::DBI;
use Data::Lazy;
use vars qw($VERSION);

BEGIN
{
    $VERSION = '0.06';
}

sub import
{
    my $class = shift;
    my($caller) = caller();
    {
        no strict 'refs';
        *{ "${caller}::has_lazy" } = \&has_lazy;
    }
}

sub has_lazy
{
    my($class, $column, $colclass, %args) = @_;

    my $inflate      = $args{inflate} ||
        ($colclass->isa('Class::DBI') ? '_simple_bless' : 'new');
    my $lazy_inflate = sub {
        my @args = @_;
        tie $_[0], 'Data::Lazy',
            sub {
                ref($inflate) eq 'CODE' ?
                    $inflate->(@args) :
                    $colclass->$inflate(@args) },
            LAZY_STOREVALUE;
        $_[0];
    };
    $class->has_a(
        $column, $colclass,
        inflate => $lazy_inflate, deflate => $args{deflate}
    );
}

1;

__END__