Core.pm: Don't trace into SelfLoader now that we know it works. selfl…

…oadertest.pl: this really works now. Add "set substitute command". SelfLoader.pm: protoype->prototype.

example/selfloadtest.pl

@@ -1,12 +1,13 @@
 #!/usr/bin/env perl
 use rlib '../lib';
-eval {use SelfLoader;};
+use SelfLoader;
 use strict; use warnings;
 
 package main;
 
 unless (caller()) {
     printf "%d\n", F_Undo();
+    F_Also();
     # print $Devel::Trepan::SelfLoader::Cache{'main::F_Undo'};
 }
 
@@ -19,3 +20,8 @@ sub F_Undo
     print "F_Undo called\n";
     return $x + $y;
 }
+
+sub F_Also
+{
+    print "That's all!\n";
+}

lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute.pm

@@ -0,0 +1,44 @@
+# -*- coding: utf-8 -*-
+# Copyright (C) 2013 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::Set::Substitute;
+
+use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
+use Devel::Trepan::CmdProcessor::Command::Subcmd::SubsubMgr;
+use vars qw(@ISA @SUBCMD_VARS);
+our $MIN_ABBREV = length('sub');
+our $HELP   = <<"HELP";
+=pod
+
+Set filename remapping.
+
+Sometimes the filename or line ranges reported inside the debugger
+might not match the filenames or line ranges where you can find the
+source in the OS filesystem. This may happen because of pathnames do
+not match or program text comes from evaluated lines in code.
+=cut
+HELP
+
+our $SHORT_HELP = "Set filename remapping";
+
+@ISA = qw(Devel::Trepan::CmdProcessor::Command::SubsubcmdMgr);
+
+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;

lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute_Subcmd/Path.pm

@@ -0,0 +1,65 @@
+# -*- coding: utf-8 -*-
+# Copyright (C) 2013 Rocky Bernstein <rocky@cpan.org>
+use warnings; no warnings 'redefine'; no warnings 'once';
+use rlib '../../../../../..';
+
+package Devel::Trepan::CmdProcessor::Command::Set::Substitute::Path;
+use Devel::Trepan::DB::LineCache;
+
+use Devel::Trepan::CmdProcessor::Command::Subcmd::Subsubcmd;
+use strict;
+use vars qw(@ISA @SUBCMD_VARS);
+@ISA = qw(Devel::Trepan::CmdProcessor::Command::Subsubcmd);
+
+# Values inherited from parent
+
+use vars @Devel::Trepan::CmdProcessor::Command::Subsubcmd::SUBCMD_VARS;
+our $CMD = 'set display eval';
+my @DISPLAY_TYPES = @Devel::Trepan::CmdProcessor::DISPLAY_TYPES;
+my $param = join('|', @DISPLAY_TYPES);
+our $HELP   = <<"HELP";
+=pod
+
+B<set substitute path> [I<from-path>] I<to-path>
+
+Add a substitution rule replacing I<from-path> into I<to-path> in
+source file names.  If a substitution rule was previously set for
+I<from-path>, the old rule is replaced by the new one. If I<from_path>
+is not given use the current filename.
+
+=cut
+
+HELP
+
+our $MIN_ABBREV = length('pa');
+use constant MIN_ARGS => 1;
+use constant MAX_ARGS => 2;
+our $SHORT_HELP = 'Use PATH in place of a filename';
+
+sub run($$)
+{
+    my ($self, $args) = @_;
+    my ($from_path, $to_path);
+    my $proc = $self->{proc};
+    if (scalar(@$args) == 5) {
+	$from_path = $args->[3];
+	$to_path   = $args->[4];
+    } else {
+	$from_path = $proc->{frame}{file};
+	$to_path   = $args->[3];
+    }
+    # FIXME: Check from_path name to see if it is loaded
+    if (-f $to_path) {
+	remap_file($from_path, $to_path);
+    } else {
+	$proc->errmsg("File ${to_path} doesn't exist");
+    }
+}
+
+unless(caller) {
+    # requre File::Basename;
+    # Demo it.
+    # my $name = basename(__FILE__, '.pm')
+}
+
+1;

lib/Devel/Trepan/Core.pm

@@ -51,6 +51,7 @@ sub new {
     $self->awaken();
     $self->skippkg('Devel::Trepan::Core');
     $self->skippkg('Devel::Trepan::DB::Use');
+    $self->skippkg('SelfLoader');
     $self->register();
     $self->ready();
     return $self;

lib/Devel/Trepan/DB/SelfLoader.pm

@@ -43,7 +43,7 @@ use Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT = qw(AUTOLOAD);
 sub Version {$VERSION}
-sub DEBUG () { 1 }
+sub DEBUG () { 0 }
 
 our %Cache;      # private cache for all SelfLoader's client packages
 
@@ -91,7 +91,7 @@ sub _load_stubs {
     my $fh = \*{"${callpack}::DATA"};
     use strict;
     my $currpack = $callpack;
-    my($line,$name,@lines, @stubs, $protoype);
+    my($line, $name, @lines, @stubs, $prototype);
 
     print STDERR "SelfLoader::load_stubs($callpack)\n" if DEBUG;
     croak("$callpack doesn't contain an __DATA__ token")
@@ -109,8 +109,9 @@ sub _load_stubs {
     local($/) = "\n";
     while(defined($line = <$fh>) and $line !~ m/^__END__/) {
 	if ($line =~ m/^\s*sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$AttrList)?)/) {
-            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
-            $protoype = $2;
+            push(@stubs,
+		 $self->_add_to_cache($name, $currpack, \@lines, $prototype));
+            $prototype = $2;
             @lines = ($line);
             if (index($1,'::') == -1) {         # simple sub name
                 $name = "${currpack}::$1";
@@ -126,7 +127,8 @@ sub _load_stubs {
                 }
             }
         } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared
-            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+            push(@stubs,
+		 $self->_add_to_cache($name, $currpack, \@lines, $prototype));
             $self->_package_defined($line);
             $name = '';
             @lines = ();
@@ -153,22 +155,22 @@ sub _load_stubs {
             close($fh);
         }
     }
-    push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+    push(@stubs,
+	 $self->_add_to_cache($name, $currpack, \@lines, $prototype));
     no strict;
     eval join('', @stubs) if @stubs;
 }
 
 
 sub _add_to_cache {
-    my($self,$fullname,$pack,$lines, $protoype) = @_;
-    return () unless $fullname;
-    carp("Redefining sub $fullname")
-      if exists $Cache{$fullname};
-    $Cache{$fullname} = join('', "\n\#line 1 \"sub $fullname\"\npackage $pack; ", @$lines);
-    #$Cache{$fullname} = join('', "package $pack; ",@$lines);
-    print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if DEBUG;
+    my($self, $funcname, $pack, $lines, $prototype) = @_;
+    return () unless $funcname;
+    carp("Redefining sub $funcname") if exists $Cache{$funcname};
+    my $header = qq(\n\#line 1 "sub $funcname"\npackage $pack; );
+    $Cache{$funcname} = join('', $header, @$lines);
+    print STDERR "SelfLoader cached $funcname: $Cache{$funcname}" if DEBUG;
     # return stub to be eval'd
-    defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;"
+    defined($prototype) ? "sub $funcname $prototype;" : "sub $funcname;"
 }
 
 sub _package_defined {}