[Bps-public-commit] r14892 - in Carp-REPL: . lib/Carp
sartak at bestpractical.com
sartak at bestpractical.com
Thu Aug 7 00:38:56 EDT 2008
Author: sartak
Date: Thu Aug 7 00:38:55 2008
New Revision: 14892
Modified:
Carp-REPL/ (props changed)
Carp-REPL/META.yml
Carp-REPL/Makefile.PL
Carp-REPL/lib/Carp/REPL.pm
Carp-REPL/lib/Devel/REPL/Plugin/Carp/REPL.pm
Log:
r68928 at onn: sartak | 2008-08-07 00:38:00 -0400
Reimplement using Devel::StackTrace::WithLexicals
Modified: Carp-REPL/META.yml
==============================================================================
--- Carp-REPL/META.yml (original)
+++ Carp-REPL/META.yml Thu Aug 7 00:38:55 2008
@@ -6,7 +6,7 @@
Test::Expect: 0
Test::More: 0
distribution_type: module
-generated_by: Module::Install version 0.68
+generated_by: Module::Install version 0.70
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
@@ -23,9 +23,7 @@
Data::Dump::Streamer: 0
Devel::LexAlias: 0
Devel::REPL: 0
- Moose: 0
- Moose::Role: 0
- PadWalker: 0
+ Devel::StackTrace::WithLexicals: 0
namespace::clean: 0
perl: 5.6.0
-version: 0.12
+version: 0.13
Modified: Carp-REPL/Makefile.PL
==============================================================================
--- Carp-REPL/Makefile.PL (original)
+++ Carp-REPL/Makefile.PL Thu Aug 7 00:38:55 2008
@@ -3,13 +3,11 @@
name 'Carp-REPL';
all_from 'lib/Carp/REPL.pm';
-requires 'Devel::LexAlias' => 0;
-requires 'Devel::REPL' => 0;
-requires 'Moose' => 0;
-requires 'Moose::Role' => 0;
-requires 'namespace::clean' => 0;
-requires 'PadWalker' => 0;
-requires 'Data::Dump::Streamer' => 0;
+requires 'Devel::StackTrace::WithLexicals' => 0;
+requires 'Devel::LexAlias' => 0;
+requires 'Devel::REPL' => 0;
+requires 'namespace::clean' => 0;
+requires 'Data::Dump::Streamer' => 0;
build_requires 'Test::Expect' => 0;
build_requires 'Test::More' => 0;
Modified: Carp-REPL/lib/Carp/REPL.pm
==============================================================================
--- Carp-REPL/lib/Carp/REPL.pm (original)
+++ Carp-REPL/lib/Carp/REPL.pm Thu Aug 7 00:38:55 2008
@@ -37,47 +37,9 @@
sub repl {
warn @_, "\n"; # tell the user what blew up
- require PadWalker;
require Devel::REPL::Script;
- my (@packages, @environments, @argses, $backtrace);
-
- my $skip = $bottom_frame;
- my $frame = 0;
- while (1) {
- if ($skip-- <= 0) {
- package DB;
- my ($package, $file, $line, $subroutine) = caller($frame)
- or last;
- $package = 'main' if !defined($package);
-
- eval {
- # PadWalker has 0 mean 'current'
- # caller has 0 mean 'immediate caller'
- push @environments, PadWalker::peek_my($frame+1);
- };
-
- Carp::carp($@), last if $@;
-
- push @argses, [@DB::args];
- push @packages, [$package, $file, $line];
-
- my $frame_display = $frame - $bottom_frame;
- $backtrace .= sprintf "%s%d: %s called at %s:%s.\n",
- $frame_display == 0 ? '' : ' ',
- $frame_display,
- $subroutine,
- $file,
- $line;
- }
-
- ++$frame;
- }
-
- warn $backtrace;
-
my ($runner, $repl);
-
if ($noprofile) {
$repl = $runner = Devel::REPL->new;
}
@@ -88,11 +50,6 @@
$repl->load_plugin('Carp::REPL');
- $repl->environments(\@environments);
- $repl->packages(\@packages);
- $repl->argses(\@argses);
- $repl->backtrace($backtrace);
- $repl->frame(0);
$runner->run;
}
Modified: Carp-REPL/lib/Devel/REPL/Plugin/Carp/REPL.pm
==============================================================================
--- Carp-REPL/lib/Devel/REPL/Plugin/Carp/REPL.pm (original)
+++ Carp-REPL/lib/Devel/REPL/Plugin/Carp/REPL.pm Thu Aug 7 00:38:55 2008
@@ -1,7 +1,8 @@
package Devel::REPL::Plugin::Carp::REPL;
use Devel::REPL::Plugin;
-use namespace::clean -except => [ 'meta' ];
+#use namespace::clean -except => [ 'meta' ];
use Devel::LexAlias;
+use Devel::StackTrace::WithLexicals;
use Data::Dump::Streamer;
sub BEFORE_PLUGIN {
@@ -9,57 +10,53 @@
$self->load_plugin('LexEnv');
}
-has 'environments' => (
- isa => 'ArrayRef',
- is => 'rw',
- required => 1,
- default => sub { [{}] },
-);
+has stacktrace => (
+ is => 'ro',
+ isa => 'Devel::StackTrace::WithLexicals',
+ handles => [qw/frame_count/],
+ default => sub {
+ my $stacktrace = Devel::StackTrace::WithLexicals->new(
+ ignore_class => ['Carp::REPL', __PACKAGE__],
+ );
+
+ shift @{ $stacktrace->{raw} }
+ until @{ $stacktrace->{raw} } == 0
+ || $stacktrace->{raw}[0]{caller}[3] eq 'Carp::REPL::repl';
-has 'packages' => (
- isa => 'ArrayRef',
- is => 'rw',
- required => 1,
- default => sub { ['main'] },
+ return $stacktrace;
+ },
);
-has 'argses' => (
- isa => 'ArrayRef',
- is => 'rw',
- required => 1,
- default => sub { [[]] },
+has frame_index => (
+ is => 'rw',
+ isa => 'Int',
+ default => 0,
);
-has 'frame' => (
- isa => 'Int',
- is => 'rw',
- required => 1,
- default => 0,
-);
+sub frame {
+ my $self = shift;
+ my $i = @_ ? shift : $self->frame_index;
-has 'backtrace' => (
- isa => 'Str',
- is => 'rw',
- required => 1,
- default => '',
-);
+ return $self->stacktrace->frame($i);
+}
-around 'frame' => sub {
+around 'frame_index' => sub {
my $orig = shift;
- my ($self, $frame) = @_;
+ my ($self, $index) = @_;
- return $orig->(@_) if !defined($frame);
+ return $orig->(@_) if !defined($index);
- if ($frame < 0) {
+ if ($index < 0) {
warn "You're already at the bottom frame.\n";
}
- elsif ($frame >= @{ $self->packages }) {
+ elsif ($index >= $self->frame_count) {
warn "You're already at the top frame.\n";
}
else {
- my ($package, $file, $line) = @{$self->packages->[$frame]};
- print "Now at $file:$line (frame $frame).\n";
$orig->(@_);
+ my $frame = $self->frame;
+ my ($file, $line) = ($frame->filename, $frame->line);
+ $self->print("Now at $file:$line (frame $index).");
}
};
@@ -72,32 +69,33 @@
return if !defined($line) || $line =~ /^\s*:q\s*/;
if ($line =~ /^\s*:b?t\b/) {
- print $self->backtrace;
+ $self->print($self->stacktrace);
return '';
}
if ($line =~ /^\s*:top\b/) {
- $self->frame(@{ $self->packages } - 1);
+ $self->frame_index($self->frame_count - 1);
return '';
}
- if ($line =~ /^\s*:bot(?:tom)?\b/) {
- $self->frame(0);
+ if ($line =~ /^\s*:b(?:ot(?:tom)?)?\b/) {
+ $self->frame_index(0);
return '';
}
if ($line =~ /^\s*:up?\b/) {
- $self->frame($self->frame + 1);
+ $self->frame_index($self->frame_index + 1);
return '';
}
if ($line =~ /^\s*:d(?:own)?\b/) {
- $self->frame($self->frame - 1);
+ $self->frame_index($self->frame_index - 1);
return '';
}
if ($line =~ /^\s*:l(?:ist)?\b/) {
- my ($package, $file, $num) = @{$self->packages->[$self->frame]};
+ my $frame = $self->frame;
+ my ($file, $num) = ($frame->filename, $frame->line);
open my $handle, '<', $file or do {
warn "Unable to open $file for reading: $!\n";
return '';
@@ -109,22 +107,22 @@
$min = 0 if $min < 0;
$max = $#code if $max > $#code;
- print "File $file:\n";
+ $self->print("File $file:\n");
for my $cur ($min .. $max) {
next if !defined($code[$cur]);
- printf "%s%*d: %s",
- $cur + 1 == $num ? '*' : ' ',
- length($max),
- $cur + 1,
- $code[$cur];
+ $self->print(sprintf "%s%*d: %s",
+ $cur + 1 == $num ? '*' : ' ',
+ length($max),
+ $cur + 1,
+ $code[$cur]);
}
return '';
}
- if ($line =~ /^\s*:e?(?:nv)?\s*/) {
- Dump($self->environments->[$self->frame])->Names('Env')->Out;
+ if ($line =~ /^\s*:e(?:nv)?\s*/) {
+ $self->print(Dump($self->frame->lexicals)->Names('Env')->Out);
return '';
}
@@ -137,17 +135,17 @@
my $line = $self->$orig(@rest);
my $frame = $self->frame;
- my $package = $self->packages->[$frame][0];
+ my $package = $frame->package;
my $declarations = join "\n",
map {"my $_;"}
- keys %{ $self->environments->[$frame] };
+ keys %{ $frame->lexicals };
my $aliases = << ' ALIASES';
- while (my ($k, $v) = each %{ $_REPL->environments->[$_REPL->frame] }) {
+ while (my ($k, $v) = each %{ $_REPL->frame->lexicals }) {
Devel::LexAlias::lexalias 0, $k, $v;
}
- my $_a; Devel::LexAlias::lexalias 0, '$_a', \$_REPL->argses->[$_REPL->frame];
+ my $_a; Devel::LexAlias::lexalias 0, '$_a', \$_REPL->frame->{args};
ALIASES
return << " CODE";
More information about the Bps-public-commit
mailing list