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
|
|
100
|
use warnings; no warnings 'redefine'; |
|
12
|
|
|
12
|
|
34
|
|
|
12
|
|
|
2
|
|
447
|
|
|
12
|
|
|
2
|
|
72
|
|
|
12
|
|
|
|
|
32
|
|
|
12
|
|
|
|
|
405
|
|
|
2
|
|
|
|
|
18
|
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
66
|
|
|
2
|
|
|
|
|
14
|
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
88
|
|
4
|
12
|
|
|
12
|
|
74
|
use rlib '../../../../..'; |
|
12
|
|
|
2
|
|
37
|
|
|
12
|
|
|
|
|
71
|
|
|
2
|
|
|
|
|
14
|
|
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
12
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Devel::Trepan::CmdProcessor::Command::Load::Command; |
7
|
12
|
|
|
12
|
|
4923
|
use Cwd 'abs_path'; |
|
12
|
|
|
2
|
|
34
|
|
|
12
|
|
|
|
|
631
|
|
|
2
|
|
|
|
|
993
|
|
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
140
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# FIXME: allow specifying just the Perl module name, |
10
|
|
|
|
|
|
|
# e.g. File::Basename a command name, e.g. alias. |
11
|
|
|
|
|
|
|
|
12
|
12
|
|
|
12
|
|
84
|
use Devel::Trepan::CmdProcessor::Command::Subcmd::Core; |
|
12
|
|
|
2
|
|
35
|
|
|
12
|
|
|
|
|
278
|
|
|
2
|
|
|
|
|
16
|
|
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
51
|
|
13
|
|
|
|
|
|
|
|
14
|
12
|
|
|
12
|
|
65
|
use strict; |
|
12
|
|
|
2
|
|
30
|
|
|
12
|
|
|
|
|
555
|
|
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
99
|
|
15
|
|
|
|
|
|
|
our (@ISA, @SUBCMD_VARS); |
16
|
|
|
|
|
|
|
# Values inherited from parent |
17
|
12
|
|
|
12
|
|
74
|
use vars @Devel::Trepan::CmdProcessor::Command::Subcmd::SUBCMD_VARS; |
|
12
|
|
|
2
|
|
40
|
|
|
12
|
|
|
|
|
4176
|
|
|
2
|
|
|
|
|
14
|
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
797
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
unless (@ISA) { |
20
|
12
|
|
|
12
|
|
84
|
eval <<"EOE"; |
|
12
|
|
|
|
|
36
|
|
|
12
|
|
|
|
|
586
|
|
21
|
|
|
|
|
|
|
use constant MAX_ARGS => 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 commmand> {I<file-or-directory-name-1> [I<file-or-directory-name-2>...]} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Load debugger commands or directories containing debugger |
39
|
|
|
|
|
|
|
commands. This is also useful if you want add, change, or fix a debugger |
40
|
|
|
|
|
|
|
command while inside the debugger. |
41
|
|
|
|
|
|
|
=cut |
42
|
|
|
|
|
|
|
HELP |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
our $SHORT_HELP = 'Load debugger command(s)'; |
45
|
|
|
|
|
|
|
our $MIN_ABBREV = length('co'); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub complete($$) |
48
|
|
|
|
|
|
|
{ |
49
|
0
|
|
|
0
|
|
|
my ($self, $prefix) = @_; |
|
0
|
|
|
0
|
|
|
|
50
|
0
|
|
|
|
|
|
$self->{proc}->filename_complete($prefix); |
|
0
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub run($$) |
54
|
|
|
|
|
|
|
{ |
55
|
0
|
|
|
0
|
|
|
my ($self, $args) = @_; |
|
0
|
|
|
0
|
|
|
|
56
|
0
|
|
|
|
|
|
my $proc = $self->{proc}; |
|
0
|
|
|
|
|
|
|
57
|
0
|
|
|
|
|
|
my @args = @$args; shift @args; shift @args; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
foreach my $file_or_dir (@args) { |
|
0
|
|
|
|
|
|
|
59
|
0
|
|
|
|
|
|
my @errs = $proc->load_debugger_commands($file_or_dir); |
|
0
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
|
unless(@errs) { |
|
0
|
0
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
$proc->msg("Devel::Trepan command $file_or_dir loaded ok") |
|
0
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
unless (caller) { |
67
|
|
|
|
|
|
|
require Devel::Trepan; |
68
|
|
|
|
|
|
|
# Demo it. |
69
|
|
|
|
|
|
|
# require_relative '../../mock' |
70
|
|
|
|
|
|
|
# my($dbgr, $parent_cmd) = MockDebugger::setup('show'); |
71
|
|
|
|
|
|
|
# $cmd = __PACKAGE__->new(parent_cmd); |
72
|
|
|
|
|
|
|
# $cmd->run(@$cmd->prefix); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# Suppress a "used-once" warning; |
76
|
|
|
|
|
|
|
$HELP || scalar @SUBCMD_VARS; |