Use "info var my" code goodness of in "info var our".

rocky · Nov 24, 2011 · 0169ab1 · 0169ab1
1 parent 0441c23
commit 0169ab1
Show file tree

Hide file tree

Showing 5 changed files with 64 additions and 55 deletions.
diff --git a/MANIFEST b/MANIFEST
@@ -9,6 +9,7 @@ example/gcd-dbg.pl
 example/gcd.pl
 example/my.pl
 example/nexting.pl
+example/our.pl
 example/TCPPack.pm
 example/test-module.pm
 example/test-require.pl
@@ -237,4 +238,3 @@ t/data/watch2.cmd
 t/data/watch2.right
 t/Helper.pm
 t/Makefile
-
diff --git a/example/our.pl b/example/our.pl
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+use strict; use warnings;
+our $a = 1;
+sub bar($) {
+    our $h = shift;
+    return $h;
+}
+
+sub foo($) {
+    our $a = shift;
+    our @b = (1, "b");
+    our %h = (1 =>'foo', 'food' => 'fight');
+    bar \%h;
+    our $c = scalar @b;
+}
+foo 5;
diff --git a/lib/Devel/Trepan/CmdProcessor/Command/Down.pm b/lib/Devel/Trepan/CmdProcessor/Command/Down.pm
@@ -23,6 +23,7 @@ HELP
 use constant ALIASES    => qw(u);
 use constant CATEGORY   => 'stack';
 use constant SHORT_HELP => 'Move frame in the direction of the least recent frame';
+our $MIN_ARGS     = 0;  # Need at least this many
 our $MAX_ARGS     = 1;  # Need at most this many
 our $NEED_STACK   = 1;
 

diff --git a/lib/Devel/Trepan/CmdProcessor/Command/Info_Subcmd/Variables_Subcmd/My.pm b/lib/Devel/Trepan/CmdProcessor/Command/Info_Subcmd/Variables_Subcmd/My.pm
@@ -4,18 +4,19 @@ use warnings; no warnings 'redefine'; no warnings 'once';
 use feature 'switch';
 use rlib '../../../../..';
 use strict;
-use vars qw(@ISA @SUBCMD_VARS);
+use Data::Dumper;
 
 package Devel::Trepan::CmdProcessor::Command::Info::Variables::My;
+our vars (@ISA, @SUBCMD_VARS);
+
 use Devel::Trepan::CmdProcessor::Command::Subcmd::Subsubcmd;
 use PadWalker qw(peek_my);
-use Data::Dumper;
-
 use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
 
 use vars qw(@ISA @SUBCMD_VARS);
-our $CMD = "info variables our";
-our $MIN_ABBREV = length('o');
+our $CMD = "info variables my";
+our $MAX_ARGS = 1000;
+our $MIN_ABBREV = length('m');
 our $HELP   = <<"HELP";
 ${CMD}
 ${CMD} -v
@@ -32,7 +33,7 @@ See also 'set variable', and frame changing commands
 HELP
 our $SHORT_HELP   = "Information about 'my' variables.";
 
-@ISA = qw(Devel::Trepan::CmdProcessor::Command::SubsubcmdMgr);
+@ISA = qw(Devel::Trepan::CmdProcessor::Command::Subsubcmd);
 
 sub show_var($$$) 
 {
@@ -70,52 +71,57 @@ sub show_var($$$)
     };
 }
 
-sub run($$)
-{
-    my ($self, $args) = @_;
-    my @ARGS = @${args};
-    shift @ARGS; shift @ARGS; shift @ARGS;
 
-    # FIXME: combine with My.pm
-    my $i = 0;
-    while (my ($pkg, $file, $line, $fn) = caller($i++)) { ; };
-    my $diff = $i - $DB::stack_depth;
+sub process_args($$$$) {
+    my ($self, $args, $hash_ref, $lex_type) = @_;
     my $proc = $self->{proc};
-
-    # FIXME: 4 is a magic fixup constant, also found in DB::finish.
-    # Remove it.
-    my $my_hash = peek_my($diff + $proc->{frame_index} + 4);
-    my @names = sort keys %{$my_hash};
+    my @ARGS = @${args};
+    shift @ARGS; shift @ARGS; shift @ARGS;
+    my @names = sort keys %{$hash_ref};
 
     if (0 == scalar @ARGS) {
 	if (scalar @names) {
-	    $proc->section("my variables");
+	    $proc->section("$lex_type variables");
 	    $proc->msg($self->{parent}{parent}->columnize_commands(\@names));
 	} else {
-	    $proc->errmsg("No 'my' variables at this level");
+	    $proc->errmsg("No '$lex_type' variables at this level");
 	}
     } else {
 	if ($ARGS[0] eq '-v') {
 	    if (scalar @names) {
-		$proc->section("my variables");
+		$proc->section("$lex_type variables");
 		for my $name (@names) {
-		    show_var($proc, $name, $my_hash->{$name});
+		    show_var($proc, $name, $hash_ref->{$name});
 		}
 	    } else {
 		$proc->errmsg("No 'my' variables at this level");
 	    }
 	} else {
 	    for my $name (@ARGS) {
-		if (exists($my_hash->{$name})) {
-		    show_var($proc, $name, $my_hash->{$name});
+		if (exists($hash_ref->{$name})) {
+		    show_var($proc, $name, $hash_ref->{$name});
 		} else {
-		    $proc->errmsg("No 'my' variable $name found at this level");
+		    $proc->errmsg("No '$lex_type' variable $name found at this level");
 		}
 	    }
 	}
     }
 }
 
+sub run($$)
+{
+    my ($self, $args) = @_;
+    # FIXME: combine with My.pm
+    my $i = 0;
+    while (my ($pkg, $file, $line, $fn) = caller($i++)) { ; };
+    my $diff = $i - $DB::stack_depth;
+
+    # FIXME: 4 is a magic fixup constant, also found in DB::finish.
+    # Remove it.
+    my $my_hash = peek_my($diff + $self->{proc}->{frame_index} + 4);
+    $self->process_args($args, $my_hash, 'my');
+}
+
 unless (caller) { 
     # Demo it.
     require Devel::Trepan;

diff --git a/lib/Devel/Trepan/CmdProcessor/Command/Info_Subcmd/Variables_Subcmd/Our.pm b/lib/Devel/Trepan/CmdProcessor/Command/Info_Subcmd/Variables_Subcmd/Our.pm
@@ -2,58 +2,44 @@
 # Copyright (C) 2011 Rocky Bernstein <rocky@cpan.org>
 use warnings; no warnings 'redefine'; no warnings 'once';
 use rlib '../../../../..';
-use strict;
-use vars qw(@ISA @SUBCMD_VARS);
-
 package Devel::Trepan::CmdProcessor::Command::Info::Variables::Our;
+
+our (@ISA, @SUBCMD_VARS);
+use strict;
 use Devel::Trepan::CmdProcessor::Command::Subcmd::Subsubcmd;
 use PadWalker qw(peek_our);
-
 use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
-use vars qw(@ISA @SUBCMD_VARS);
-our $CMD = "info variables my";
-our $MIN_ABBREV = length('m');
+
+our $CMD = "info variables our";
+our $MAX_ARGS = 1000;
+our $MIN_ABBREV = length('o');
 our $HELP   = <<"HELP";
 ${CMD}
 
-List 'my' variables at the current stack level.
+List 'our' variables at the current stack level.
 HELP
 our $SHORT_HELP   = "Information about 'our' variables.";
 
-@ISA = qw(Devel::Trepan::CmdProcessor::Command::SubsubcmdMgr);
+@ISA = qw(Devel::Trepan::CmdProcessor::Command::Subsubcmd);
 
 sub run($$)
 {
     my ($self, $args) = @_;
     # FIXME: combine with My.pm
     my $i = 0;
+
     while (my ($pkg, $file, $line, $fn) = caller($i++)) { ; };
     my $diff = $i - $DB::stack_depth;
-    my $proc = $self->{proc};
+
     # FIXME: 4 is a magic fixup constant, also found in DB::finish.
     # Remove it.
-    my $our_hash = peek_our($diff + $proc->{frame_index} + 4);
-    my @names = sort keys %{$our_hash};
-    if (scalar @names) {
-	$proc->section("'our' variables");
-	$proc->msg($self->{parent}{parent}->columnize_commands(\@names));
-    } else {
-	$proc->msg("No 'our' variables at this level");
-    }
+    my $my_hash = peek_our($diff + $self->{proc}->{frame_index} + 4);
+    Devel::Trepan::CmdProcessor::Command::Info::Variables::My::process_args($self, $args, $my_hash, 'our');
 }
 
 unless (caller) { 
     # Demo it.
     require Devel::Trepan;
-    # require_relative '../../mock'
-    # dbgr, parent_cmd = MockDebugger::setup('set', false)
-    # cmd              = Trepan::SubSubcommand::SetMax.new(dbgr.core.processor, 
-    #                                                      parent_cmd)
-    # cmd.run(cmd.prefix + ['string', '30'])
-
-    # %w(s lis foo).each do |prefix|
-    #   p [prefix, cmd.complete(prefix)]
-    # end
 }
 
 1;