[Bps-public-commit] r13442 - in Carp-REPL: lib/Carp

[sartak at bestpractical.com]

Author: sartak
Date: Fri Jun 20 02:36:30 2008
New Revision: 13442

Modified:
   Carp-REPL/   (props changed)
   Carp-REPL/lib/Carp/REPL.pm

Log:
 r62889 at dhcp184:  sartak | 2008-06-20 01:35:31 -0500
 Attempt adding support for a bottom frame


Modified: Carp-REPL/lib/Carp/REPL.pm
==============================================================================
--- Carp-REPL/lib/Carp/REPL.pm	(original)
+++ Carp-REPL/lib/Carp/REPL.pm	Fri Jun 20 02:36:30 2008
@@ -8,6 +8,7 @@
 our @EXPORT_OK = 'repl';
 
 our $noprofile = 0;
+our $bottom_frame = 0;
 
 sub import {
     my $nodie  = grep { $_ eq 'nodie'    } @_;
@@ -40,30 +41,34 @@
 
     my (@packages, @environments, @argses, $backtrace);
 
+    my $skip = $bottom_frame;
     my $frame = 0;
     while (1) {
-        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];
-
-        $backtrace .= sprintf "%s%d: %s called at %s:%s.\n",
-            $frame == 0 ? '' : '   ',
-            $frame,
-            $subroutine,
-            $file,
-            $line;
+        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;
     }