[Bps-public-commit] r12391 - in Carp-REPL: .
sartak at bestpractical.com
sartak at bestpractical.com
Fri May 16 08:31:04 EDT 2008
Author: sartak
Date: Fri May 16 08:31:04 2008
New Revision: 12391
Modified:
Carp-REPL/ (props changed)
Carp-REPL/lib/Devel/REPL/Plugin/LexEnvCarp.pm
Log:
r55998 at onn: sartak | 2008-05-16 08:13:55 -0400
perltidy
Modified: Carp-REPL/lib/Devel/REPL/Plugin/LexEnvCarp.pm
==============================================================================
--- Carp-REPL/lib/Devel/REPL/Plugin/LexEnvCarp.pm (original)
+++ Carp-REPL/lib/Devel/REPL/Plugin/LexEnvCarp.pm Fri May 16 08:31:04 2008
@@ -14,51 +14,46 @@
);
has 'packages' => (
- isa => 'ArrayRef',
- is => 'rw',
+ isa => 'ArrayRef',
+ is => 'rw',
required => 1,
- default => sub { ['main'] },
+ default => sub { ['main'] },
);
has 'argses' => (
- isa => 'ArrayRef',
- is => 'rw',
+ isa => 'ArrayRef',
+ is => 'rw',
required => 1,
- default => sub { [[]] },
+ default => sub { [[]] },
);
has 'frame' => (
- isa => 'Int',
- is => 'rw',
+ isa => 'Int',
+ is => 'rw',
required => 1,
- default => 0,
+ default => 0,
);
has 'backtrace' => (
- isa => 'Str',
- is => 'rw',
+ isa => 'Str',
+ is => 'rw',
required => 1,
- default => '',
+ default => '',
);
-around 'frame' => sub
-{
+around 'frame' => sub {
my $orig = shift;
-
my ($self, $frame) = @_;
return $orig->(@_) if !defined($frame);
- if ($frame < 0)
- {
+ if ($frame < 0) {
warn "You're already at the bottom frame.\n";
}
- elsif ($frame >= @{ $self->packages })
- {
+ elsif ($frame >= @{ $self->packages }) {
warn "You're already at the top frame.\n";
}
- else
- {
+ else {
my ($package, $file, $line) = @{$self->packages->[$frame]};
print "Now at $file:$line (frame $frame).\n";
$orig->(@_);
@@ -66,99 +61,95 @@
};
# this is totally the wrong spot for this. oh well.
-around 'read' => sub
-{
- my $orig = shift;
- my ($self, @rest) = @_;
- my $line = $self->$orig(@rest);
-
- return if !defined($line) || $line =~ /^\s*:q\s*/;
-
- if ($line =~ /^\s*:b?t\s*/)
- {
- print $self->backtrace;
- return '';
- }
-
- if ($line =~ /^\s*:up?\s*/)
- {
- $self->frame($self->frame + 1);
- return '';
- }
-
- if ($line =~ /^\s*:d(?:own)?\s*/)
- {
- $self->frame($self->frame - 1);
- return '';
- }
-
- if ($line =~ /^\s*:l(?:ist)?\s*/) {
- my ($package, $file, $num) = @{$self->packages->[$self->frame]};
- open my $handle, '<', $file or do {
- warn "Unable to open $file for reading: $!\n";
- return '';
- };
- my @code = <$handle>;
+around 'read' => sub {
+ my $orig = shift;
+ my ($self, @rest) = @_;
+ my $line = $self->$orig(@rest);
- my $min = $num - 6;
- my $max = $num + 4;
- $min = 0 if $min < 0;
- $max = $#code if $max > $#code;
+ return if !defined($line) || $line =~ /^\s*:q\s*/;
+
+ if ($line =~ /^\s*:b?t\s*/) {
+ print $self->backtrace;
+ return '';
+ }
- for my $cur ($min .. $max) {
- next if !defined($code[$cur]);
+ if ($line =~ /^\s*:up?\s*/) {
+ $self->frame($self->frame + 1);
+ return '';
+ }
- printf "%s%*d: %s",
- $cur + 1 == $num ? '*' : ' ',
- length($max),
- $cur + 1,
- $code[$cur];
+ if ($line =~ /^\s*:d(?:own)?\s*/) {
+ $self->frame($self->frame - 1);
+ return '';
}
- return '';
- }
+ if ($line =~ /^\s*:l(?:ist)?\s*/) {
+ my ($package, $file, $num) = @{$self->packages->[$self->frame]};
+ open my $handle, '<', $file or do {
+ warn "Unable to open $file for reading: $!\n";
+ return '';
+ };
+ my @code = <$handle>;
+
+ my $min = $num - 6;
+ my $max = $num + 4;
+ $min = 0 if $min < 0;
+ $max = $#code if $max > $#code;
+
+ for my $cur ($min .. $max) {
+ next if !defined($code[$cur]);
+
+ printf "%s%*d: %s",
+ $cur + 1 == $num ? '*' : ' ',
+ length($max),
+ $cur + 1,
+ $code[$cur];
+ }
- if ($line =~ /^\s*:e?(?:nv)?\s*/)
- {
- Dump($self->environments->[$self->frame])->Names('Env')->Out;
- return '';
- }
+ return '';
+ }
+ if ($line =~ /^\s*:e?(?:nv)?\s*/) {
+ Dump($self->environments->[$self->frame])->Names('Env')->Out;
+ return '';
+ }
- return $line;
+ return $line;
};
-around 'mangle_line' => sub
-{
- my $orig = shift;
- my ($self, @rest) = @_;
- my $line = $self->$orig(@rest);
-
- my $frame = $self->frame;
- my $package = $self->packages->[$frame][0];
-
- my $declarations = join "\n",
- map {"my $_;"}
- keys %{ $self->environments->[$frame] };
-
- my $aliases = << 'ALIASES';
-while (my ($k, $v) = each %{ $_REPL->environments->[$_REPL->frame] })
-{
- Devel::LexAlias::lexalias 0, $k, $v;
-}
-my $_a; Devel::LexAlias::lexalias 0, '$_a', \$_REPL->argses->[$_REPL->frame];
-ALIASES
-
- return << "CODE";
-package $package;
-no warnings 'misc'; # declaration in same scope masks earlier instance
-no strict 'vars'; # so we get all the global variables in our package
-$declarations
-$aliases
-$line
-CODE
+around 'mangle_line' => sub {
+ my $orig = shift;
+ my ($self, @rest) = @_;
+ my $line = $self->$orig(@rest);
+
+ my $frame = $self->frame;
+ my $package = $self->packages->[$frame][0];
+
+ my $declarations = join "\n",
+ map {"my $_;"}
+ keys %{ $self->environments->[$frame] };
+
+ my $aliases = << 'ALIASES';
+ while (my ($k, $v) = each %{ $_REPL->environments->[$_REPL->frame] }) {
+ Devel::LexAlias::lexalias 0, $k, $v;
+ }
+ my $_a; Devel::LexAlias::lexalias 0, '$_a', \$_REPL->argses->[$_REPL->frame];
+ ALIASES
+
+ return << "CODE";
+ package $package;
+ no warnings 'misc'; # declaration in same scope masks earlier instance
+ no strict 'vars'; # so we get all the global variables in our package
+ $declarations
+ $aliases
+ $line
+ CODE
};
+1;
+
+__END__
+
=head1 NAME
Devel::REPL::Plugin::LexEnvCarp - Devel::REPL plugin for Carp::REPL
@@ -197,4 +188,3 @@
=cut
-1; # End of Devel::REPL::Plugin::LexEnvCarp
More information about the Bps-public-commit
mailing list