Attribute-Cached

 view release on metacpan or  search on metacpan

bench/attr_bench.pl  view on Meta::CPAN

use strict; use warnings;
use Data::Dumper;

use Attribute::Cached;
use constant CACHETIME => 20;

use Cache::MemoryCache;
my %caches;

sub getCache {
    my (undef, undef, undef, $method) = caller(2);
    return $caches{$method} ||= do {
         warn "Getting cache $method";
         Cache::MemoryCache->new({namespace=>$method});
        };
}
sub getCacheKey {
    return join ',' => @_;
}
sub customCacheKey {
    return join ':' => @_;

inc/Module/AutoInstall.pm  view on Meta::CPAN

        # make an educated guess of whether we'll need root permission.
        print "    (You may need to do that as the 'root' user.)\n"
          if eval '$>';
    }
    print "*** $class configuration finished.\n";

    chdir $cwd;

    # import to main::
    no strict 'refs';
    *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}

sub _running_under {
    my $thing = shift;
    print <<"END_MESSAGE";
*** Since we're running under ${thing}, I'll just let it take care
    of the dependency's installation later.
END_MESSAGE
    return 1;
}

inc/Module/Install.pm  view on Meta::CPAN

#####################################################################
# Common Utility Functions

sub _caller {
	my $depth = 0;
	my $call  = caller($depth);
	while ( $call eq __PACKAGE__ ) {
		$depth++;
		$call = caller($depth);
	}
	return $call;
}

sub _read {
	local *FH;
	if ( $] >= 5.006 ) {
		open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	} else {
		open( FH, "< $_[0]"  ) or die "open($_[0]): $!";

inc/Module/Install/Makefile.pm  view on Meta::CPAN

}

sub Makefile { $_[0] }

my %seen = ();

sub prompt {
	shift;

	# Infinite loop protection
	my @c = caller();
	if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
		die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
	}

	# In automated testing, always use defaults
	if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
		local $ENV{PERL_MM_USE_DEFAULT} = 1;
		goto &ExtUtils::MakeMaker::prompt;
	} else {
		goto &ExtUtils::MakeMaker::prompt;

t/01_cacheset.t  view on Meta::CPAN

    $self->{time}{$key} = $time;
}

package main;

my %caches;

sub getCache {
    my $method = $_[1];
    if (!$method) {
        my $method_name = (caller(2))[3];
        $method_name=~/\((.*?)\)/;
        $method = $1;
    }
    return $caches{$method} ||= do {
         diag "Getting cache $method";
         Cache::MockCache->new({namespace=>$method});
        };
}
sub getCacheKey {
    return join ',' => @_;