Binding

 view release on metacpan or  search on metacpan

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;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
	local *FH;
	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	my $string = do { local $/; <FH> };

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 or non-interactive session, always use defaults
	if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
		local $ENV{PERL_MM_USE_DEFAULT} = 1;
		goto &ExtUtils::MakeMaker::prompt;
	} else {
		goto &ExtUtils::MakeMaker::prompt;

lib/Binding.pm  view on Meta::CPAN

This module can help when you need to eval code with caller's variable
binding. It's similar to Tcl's uplevel function. The name comes from
the Binding class of Ruby language.

It's not doing much yet but let you grab caller variables.

=head1 INTERFACE

=over

=item of_caller([ $level ])

One of the constructors. The C<$level> parameter is optional and
defaults to 1, which means one level up in the stack. The returned
value is a object of C<Binding> class, which can latter be invoked
with C<eval> method.

=item eval( $code_str )

An instance method that evals code in C<$code_str>. Block form of eval
is not accepted. Variables used in $code_str will be referenced to the

t/of_caller.t  view on Meta::CPAN

#!/usr/bin/env perl -w
use strict;
use Test::More tests => 4;

use Binding;

my $x = 500;

sub foo {
    my $level = shift;;
    my $b = Binding->of_caller($level);
    return $b->eval('$x + 1;');
}

sub bar {
    my $x = 42;
    foo;
}

sub baz {
    my $x = 50;