File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Load_Subcmd/Source.pm
Criterion Covered Total %
statement 60 96 62.5
branch 0 8 0.0
condition n/a
subroutine 20 24 83.3
pod n/a
total 80 128 62.5


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2012, 2014 Rocky Bernstein <rocky@cpan.org>
3 12     12   197 use warnings; no warnings 'redefine'; no warnings 'once';
  12     12   41  
  12     12   625  
  12     2   85  
  12     2   33  
  12     2   416  
  12         471  
  12         36  
  12         371  
  2         16  
  2         6  
  2         53  
  2         15  
  2         13  
  2         70  
  2         13  
  2         6  
  2         59  
4 12     12   77 use rlib '../../../../..';
  12     2   35  
  12         95  
  2         11  
  2         5  
  2         10  
5              
6             package Devel::Trepan::CmdProcessor::Command::Load::Source;
7 12     12   5387 use English qw( -no_match_vars );
  12     2   33  
  12         103  
  2         1064  
  2         7  
  2         19  
8 12     12   5197 use Cwd 'abs_path';
  12     2   41  
  12         1095  
  2         664  
  2         5  
  2         92  
9              
10 12     12   91 use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
  12     2   39  
  12         533  
  2         14  
  2         4  
  2         48  
11             # use Devel::Trepan::DB::LineCache qw(file_list);
12              
13 12     12   76 use strict;
  12     2   34  
  12         855  
  2         9  
  2         7  
  2         100  
14             our (@ISA, @SUBCMD_VARS);
15             # Values inherited from parent
16 12     12   71 use vars @Devel::Trepan::CmdProcessor::Command::Subcmd::SUBCMD_VARS;
  12     2   31  
  12         5831  
  2         15  
  2         13  
  2         1151  
17              
18             ## FIXME: do automatically.
19             our $CMD = "load source";
20              
21             unless (@ISA) {
22 12     12   83 eval <<"EOE";
  12     12   522  
  12         752  
  12         134  
  12         31  
  12         572  
23             use constant MAX_ARGS => 0; # Need at most this many - undef -> unlimited.
24             use constant NEED_STACK => 0;
25             EOE
26             }
27              
28             @ISA = qw(Devel::Trepan::CmdProcessor::Command::Subcmd);
29              
30             =pod
31              
32             =head2 Synopsis:
33              
34             =cut
35              
36             our $HELP = <<'HELP';
37             =pod
38              
39             B<load source> {I<Perl-source-file>}
40              
41             Read source lines of {I<Perl-source-file>}.
42              
43             This simulates what Perl does in reading a file when debugging is
44             turned on, somewhat. A description of what this means is below.
45              
46             The file contents are read in as a list of strings in
47             I<_E<lt>$filename> for the debugger to refer to; I<$filename> contains
48             the name I<Perl-source-file>. In addition, each entry of this list is
49             a dual variable. In a non-numeric context, an entry is a string of the
50             line contents including the trailing C<\n>.
51              
52             But in numeric context, an entry of the list is I<true> if that line
53             is traceable or has a COP instruction in it which allows the debugger
54             to take control.
55             =cut
56             HELP
57              
58             our $SHORT_HELP = 'Read Perl source file(s)';
59             our $MIN_ABBREV = length('so');
60              
61             sub complete($$)
62             {
63 0     0     my ($self, $prefix) = @_;
  0     0      
64 0           $self->{proc}->filename_complete($prefix);
  0            
65             }
66              
67             sub run($$)
68             {
69 0     0     my ($self, $args) = @_;
  0     0      
70 0           my $proc = $self->{proc};
  0            
71 0           my @args = @$args; shift @args; shift @args;
  0            
  0            
  0            
  0            
  0            
72 0           foreach my $source (@args) {
  0            
73 0 0         if (-r $source) {
  0 0          
74             ## FIXME put into a common routine and use in bin/trepan.pl as
75             ## well
76             # Check that the debugged Perl program is syntactically valid.
77 0           my $cmd = "$EXECUTABLE_NAME -c $source 2>&1";
  0            
78 0           my $output = `$cmd`;
  0            
79 0           my $rc = $? >>8;
  0            
80 0 0         if ($rc) {
  0 0          
81 0           $proc->errmsg("$output");
  0            
82             } else {
83              
84             # FIXME: These two things should be one routine. Also change
85             # 10test-linecache.t
86 0           Devel::Trepan::DB::LineCache::load_file($source);
  0            
87 0           Devel::Trepan::DB::LineCache::update_cache($source,
  0            
88             {use_perl_d_file => 1});
89              
90 0           $proc->msg("Read in lines of Perl source file $source");
  0            
91             }
92             } else {
93 0           $proc->errmsg("Don't see ${source} for reading");
  0            
94             }
95             }
96             }
97              
98             unless (caller) {
99             require Devel::Trepan;
100             # Demo it.
101             # require_relative '../../mock'
102             # my($dbgr, $parent_cmd) = MockDebugger::setup('show');
103             # $cmd = __PACKAGE__->new(parent_cmd);
104             # $cmd->run(@$cmd->prefix);
105             }
106              
107             # Suppress a "used-once" warning;
108             $HELP || scalar @SUBCMD_VARS;