view release on metacpan or  search on metacpan

lib/AutoReloader.pm  view on Meta::CPAN

# if more: package, filename [, checkfuncref [, auto ]]

sub gensub {
    my $package = scalar(@_) == 1 ? caller : shift;
    my $file    = shift;
    my $chkfunc = shift || $AL {'checksub'};
    my $auto    = shift || $AL {'auto'} || 'auto';
    my $function;

    {
        ($function = pop (@{[ File::Spec->splitpath($file) ]}) ) =~ s/\..*//;
        
        $file .= $AL {'suffix'} || '.al' unless $file =~ /\.\w+$/;
        unless (-e $file) {
	    my ($filename, $seen);
	    {
		$filename = File::Spec -> catfile ($auto, $package, $file);
		foreach my $d ('.',@INC) { # check current working dir first
		    my $f = File::Spec -> catfile ($d,$filename);
		    if (-e $f) {
			$file = $f;
			last;
		    }
		}
		last if $seen;
		unless (-e $file) {
		    # redo the search with a truncated filename
		    $file =~ s/(\w{12,})(\.\w+)$/substr($1,0,11).$2/e;
		    $seen++;
		    redo;
		}
	    } 
	    die
	      "Can't locate function file '$filename' for package '$package'\n"
		unless -e $file;
	}
    }

    if (my $addr = $AL {'Inc'} -> {"$package\::$function"} ) {
        return $AL {Sub} -> {$addr} -> {'outer'};
    }
    else {
        # file not known yet
        my $inner;
        my $h        = {};
        my $cr       = $chkfunc -> ($file);
        my $subname  = "$package\::$function";

        $h = {
            file     => $file,
            check    => \$AL {'check'},
            checksub => \$chkfunc,
            checkref => \$cr,
            function => $subname,
        };

        my $outer          = load ($package, $file, $h) or die $@;
        my $outeraddr      = Scalar::Util::refaddr ($outer);

        $h -> {'outer'} = $outer;
        Scalar::Util::weaken ($h -> {'outer'});

        $AL{Sub} -> {$outeraddr} = $h;
        $AL{Inc} -> {$subname}   = $outeraddr;
        return bless $outer, __PACKAGE__;
    }
};
{
    my $load = \&load;
    sub load {
	my ($package, $file, $h) = @_;
	delete $INC {$file};
	my $ref = eval "package $package; require '$file'";
	#warn $@ if $@;
	return undef if $@;
	{
	    # just in case the require dinn' return a ref -
	    # then a named subroutine has been loaded.
	    # All other cases are errors.
	    unless (
	      Scalar::Util::reftype($ref)
	                 and
	      Scalar::Util::reftype($ref) eq 'CODE') {
		$ref = \&{$h -> {'function'}};
		no strict 'refs';
		no warnings 'redefine';
		*{$h -> {'function'} } = $h ->{'outer'} if $h -> {'outer'};
	    }
	    ${$h->{inner}} = $ref;
    
	    my $sub = sub {
		my $cr = $h -> {'checkref'};
		if( ${ $h -> {'check'} } and ${ $h-> {'checksub'} }
					and
		( my $c = ${ $h->{checksub} } -> ($file) ) != $$cr) {
		    warn "reloading $file" if $Debug;
		    $$cr = $c;
		    $load -> ($package, $file, $h);
		}
		goto ${ $h -> {'inner'} };
	    };
	}
    }
}

sub DESTROY {
    my $outeraddr = Scalar::Util::refaddr ($_[0]);
    my $h = $AL {'Sub'} -> {$outeraddr};
    delete  $AL {'Inc'} -> { $h -> {'function'}};
    delete  $AL {'Sub'} -> {$outeraddr};
}

sub AUTOLOAD {
    no strict;
    my $sub = $AUTOLOAD;
    my ($pkg, $func, $filename);
    {
        ($pkg, $func) = ($sub =~ /(.*)::([^:]+)$/);
        $pkg = File::Spec -> catdir (split /::/, $pkg);
    }
    my $save = $@;