view release on metacpan or  search on metacpan

lib/Pry.pm  view on Meta::CPAN

# a refinement for the Reply class
#
my $_say = sub {
	require Term::ANSIColor;
	shift;
	my ($text, $colour) = (@_, "cyan");
	print Term::ANSIColor::colored($text, "bold $colour"), "\n";
};

our $Dumper = 'Data::Dumper';

my $_display_vars = sub {
	my $invocant = shift;
	my $_dumper  = $Dumper eq 'Data::Dump'
		? do { require Data::Dump;   \&Data::Dump::dump }
		: do { require Data::Dumper; \&Data::Dumper::Dumper };
	
	local $Data::Dumper::Deparse = 1;
	local $Data::Dumper::Terse   = 1;
	
	for my $var (@_)
	{
		my $val  = ($var =~ /\A\$/) ? ${$Lexicals->{$var}} : $Lexicals->{$var};
		my $dump = $_dumper->($val);
		chomp($dump);
		$dump =~ s/(\A\[)/\(/ and $dump =~ s/(\]\z)/\)/ if $var =~ /\A\@/;
		$dump =~ s/(\A\{)/\(/ and $dump =~ s/(\}\z)/\)/ if $var =~ /\A\%/;
		$invocant->$_say("$var = $dump;", "yellow");
	}
};

# shim to pass lexicals to Reply
#
{
	package #hide
		Pry::_Lexicals;
	our @ISA = qw( Reply::Plugin );
	sub lexical_environment { $Lexicals }
	$INC{'Pry/_Lexicals.pm'} = __FILE__;
}

# the guts
#
sub pry (;@)
{
	my ($caller, $file, $line) = caller;
	
	if ( $Already )
	{
		Reply->$_say(
			"Pry is not re-entrant; not prying again at $file line $line",
			"magenta",
		);
		return;
	}
	local $Already = 1;
	
	require Devel::StackTrace;
	require Reply;
	require PadWalker;
	
	$Lexicals = +{
		%{ PadWalker::peek_our(1) },
		%{ PadWalker::peek_my(1) },
	};
	$Trace = Devel::StackTrace->new(
		ignore_package => __PACKAGE__,
		message        => "Prying",
	);
	
	my $repl = Reply->new(
		config  => ".replyrc",
		plugins => [ "/Pry/_Lexicals" ],
	);
	$repl->step("package $caller");
	
	$repl->$_say("Prying at $file line $line", "magenta");
	$repl->$_display_vars(@_) if @_;
	$repl->$_say("Current package:   '$caller'");
	$repl->$_say("Lexicals in scope: @{[ sort keys %$Lexicals ]}");
	$repl->$_say("Ctrl+D to finish prying.", "magenta");
	$repl->run;
	$repl->$_say("Finished prying!", "magenta");
	
	my @return = map($Lexicals->{$_}, @_);
	wantarray ? @return : \@return;
}

# utils
#
sub Lexicals ()  { $Lexicals if $] }
sub Trace    ()  { $Trace    if $] }
sub Dump     (@) { __PACKAGE__->$_display_vars(@_) }

1;

__END__

=pod

=begin trustme

=item pry

=end trustme

=encoding utf-8

=head1 NAME

Pry - intrude on your code

=head1 SYNOPSIS

   use Pry;
   
   ...;
   pry;
   ...;

=head1 DESCRIPTION

Kind of a bit like a debugger, kind of a bit like a REPL.