view release on metacpan or  search on metacpan

lib/Class/LazyLoad.pm  view on Meta::CPAN

package Class::LazyLoad;

use strict 'vars';

use vars qw(
    $AUTOLOAD
    $VERSION
);

$VERSION = 0.04;

{
    my @todo;
    sub import
    {
        shift;
        return if (caller)[0] eq 'Class::LazyLoad::Functions';        
        
        unless ( @_ ) {
            push @todo, [ (caller)[0], 'new' ];
            return;
        }

        foreach ( @_ ) {
            if (ref($_) eq 'ARRAY') {
                push @todo, $_;
            } else {
                push @todo, [ $_, 'new' ];
            }
        }
    }

    sub init_lazyloads { lazyload( @$_ ) for @todo }
    INIT { init_lazyloads() }
}

use overload
    '${}' => sub { _build($_[0]); $_[0] },          
    '%{}' => sub { _build($_[0]); $_[0] },
    '&{}' => sub { _build($_[0]); $_[0] },
    '@{}' => sub { 
        # C::LL does array access, so make sure it's not us before building.
        return $_[0] if (caller)[0] eq __PACKAGE__;
        _build($_[0]); $_[0] 
    },
    nomethod => sub {
        my $realclass = $_[0][1];
        if ($_[3] eq '""') {
            if (my $func = overload::Method($realclass, $_[3])) {
                _build($_[0]);
                return $_[0]->$func();
            }
            else {
                return overload::StrVal($_[0]);
            }
        }
        die "LazyLoaded object '$realclass' is not overloaded, cannot perform '$_[3]'\n" 
            unless overload::Overloaded($realclass);
        my $func = overload::Method($realclass, $_[3]);
        die "LazyLoaded object '$realclass' does not overloaded '$_[3]'\n"	
            unless defined $func;
        _build($_[0]);
        $_[0]->$func($_[1], $_[2]);
    };

sub can
{
    _build( $_[0] );
    $_[0]->can($_[1]);
}

sub isa { $_[0][1]->isa($_[1]) }

sub AUTOLOAD
{
    my ($subname) = $AUTOLOAD =~ /([^:]+)$/;

    my $realclass = $_[0][1];
    _build( $_[0] );

    my $func = $_[0]->can( $subname );
    die "Cannot call '$subname' on an instance of '$realclass'\n"
        unless ref( $func ) eq 'CODE';

    goto &$func;
}

sub _compile
{ 
    my $pkg = shift;
    (my $filename = $pkg) =~ s!::!/!g;
#    print "$pkg => " . $INC{"$filename.pm"} . "\n";
    return if exists $INC{"$filename.pm"};

    eval "use $pkg;";
    die "Could not load '$pkg' because : $@" if $@;
}

{
    my %lazyloads;

    sub lazyload
    {