File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Load_Subcmd/Module.pm
Criterion Covered Total %
statement 45 79 56.9
branch 0 16 0.0
condition 0 6 0.0
subroutine 15 19 78.9
pod n/a
total 60 120 50.0


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   102 use warnings; no warnings 'redefine';
  12     12   33  
  12     2   461  
  12     2   70  
  12         29  
  12         464  
  2         19  
  2         7  
  2         67  
  2         13  
  2         6  
  2         74  
4 12     12   73 use rlib '../../../../..';
  12     2   35  
  12         83  
  2         14  
  2         5  
  2         12  
5              
6             package Devel::Trepan::CmdProcessor::Command::Load::Module;
7 12     12   5060 use Cwd 'abs_path';
  12     2   36  
  12         731  
  2         989  
  2         7  
  2         129  
8              
9             # FIXME: allow specifiying just the Perl module name,
10             # e.g. File::Basename.
11              
12 12     12   88 use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
  12     2   38  
  12         321  
  2         15  
  2         8  
  2         51  
13              
14 12     12   66 use strict;
  12     2   33  
  12         580  
  2         11  
  2         7  
  2         104  
15             our (@ISA, @SUBCMD_VARS);
16             # Values inherited from parent
17 12     12   78 use vars @Devel::Trepan::CmdProcessor::Command::Subcmd::SUBCMD_VARS;
  12     2   35  
  12         5007  
  2         11  
  2         6  
  2         899  
18              
19             unless (@ISA) {
20 12     12   85 eval <<"EOE";
  12         35  
  12         631  
21             use constant MAX_ARGS => 0; # Need at most this many - undef -> unlimited.
22             EOE
23             }
24              
25             @ISA = qw(Devel::Trepan::CmdProcessor::Command::Subcmd);
26              
27             =pod
28              
29             =head2 Synopsis:
30              
31             =cut
32              
33             our $HELP = <<'HELP';
34             =pod
35              
36             B<load module> {I<Perl-module-file>}
37              
38             Load or reload a Perl module. This is like I<require> with a file
39             name, but we force the load or reload. Use this if you change the Perl
40             module while you are debugging and it want those changes to take
41             effect in both the debugged program and inside the debugger.
42              
43             Note however that any functions along the call stack will not be
44             changed.
45             =cut
46             HELP
47              
48             our $SHORT_HELP = '(re)load Perl module file(s)';
49             our $MIN_ABBREV = length('mo');
50              
51             sub complete($$)
52             {
53 0     0     my ($self, $prefix) = @_;
  0     0      
54 0           $self->{proc}->filename_complete($prefix);
  0            
55             }
56              
57             sub run($$)
58             {
59 0     0     my ($self, $args) = @_;
  0     0      
60 0           my $proc = $self->{proc};
  0            
61 0           my @args = @$args; shift @args; shift @args;
  0            
  0            
  0            
  0            
  0            
62 0           foreach my $module (@args) {
  0            
63 0 0 0       $module .= '.pm' unless -r $module || substr($module,-3,3) eq '.pm';
  0 0 0        
64 0 0         if (-r $module) {
  0 0          
65 0           my $rc = do $module;
  0            
66 0 0         if ($rc) {
  0 0          
67 0           $proc->msg("Perl module file $module loaded");
  0            
68             } else {
69 0 0         if ($@) {
  0 0          
70 0           $proc->errmsg("Trouble reading ${module}: $@");
  0            
71             } else {
72 0           $proc->errmsg("Perl module ${module} gave invalid return");
  0            
73             }
74             }
75             } else {
76 0           $proc->errmsg("Can't find Perl module file $module");
  0            
77             }
78             }
79             }
80              
81             unless (caller) {
82             require Devel::Trepan;
83             # Demo it.
84             # require_relative '../../mock'
85             # my($dbgr, $parent_cmd) = MockDebugger::setup('show');
86             # $cmd = __PACKAGE__->new(parent_cmd);
87             # $cmd->run(@$cmd->prefix);
88             }
89              
90             # Suppress a "used-once" warning;
91             $HELP || scalar @SUBCMD_VARS;