line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright (C) 2011-2012 Rocky Bernstein <rocky@cpan.org> |
2
|
|
|
|
|
|
|
# -*- coding: utf-8 -*- |
3
|
12
|
|
|
12
|
|
78
|
use strict; use warnings; |
|
12
|
|
|
12
|
|
32
|
|
|
12
|
|
|
|
|
313
|
|
|
12
|
|
|
|
|
58
|
|
|
12
|
|
|
|
|
29
|
|
|
12
|
|
|
|
|
289
|
|
4
|
|
|
|
|
|
|
|
5
|
12
|
|
|
12
|
|
58
|
use Exporter; |
|
12
|
|
|
|
|
31
|
|
|
12
|
|
|
|
|
4579
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Devel::Trepan::CmdProcessor; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub abbrev_stringify($$$) { |
10
|
0
|
|
|
0
|
0
|
|
my ($self, $name, $min_abbrev) = @_; |
11
|
0
|
|
|
|
|
|
sprintf "(%s)%s", substr($name, 0, $min_abbrev), substr($name, $min_abbrev); |
12
|
|
|
|
|
|
|
} |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Return constant SHORT_HELP or build it from HELP |
15
|
|
|
|
|
|
|
sub summary_help($$) { |
16
|
0
|
|
|
0
|
0
|
|
my ($self, $subcmd) = @_; |
17
|
0
|
|
|
|
|
|
my $short_help; |
18
|
0
|
0
|
0
|
|
|
|
if (defined $subcmd->{help} && !defined $subcmd->{short_help}) { |
19
|
0
|
|
|
|
|
|
my @lines = split("\n", $subcmd->{help}); |
20
|
0
|
|
|
|
|
|
$short_help = $lines[0]; |
21
|
0
|
0
|
|
|
|
|
$short_help = substr($short_help, 0, -1) if |
22
|
|
|
|
|
|
|
'.' eq substr($short_help, -1, 1); |
23
|
|
|
|
|
|
|
} else { |
24
|
0
|
|
|
|
|
|
$short_help = $subcmd->{short_help}; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sprintf(' %-13s -- %s', |
28
|
|
|
|
|
|
|
$self->abbrev_stringify($subcmd->{name}, |
29
|
0
|
|
|
|
|
|
$subcmd->{min_abbrev}), |
30
|
|
|
|
|
|
|
$short_help); |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# We were given cmd without a subcommand; cmd is something |
34
|
|
|
|
|
|
|
# like "show", "info" or "set". Generally this means list |
35
|
|
|
|
|
|
|
# all of the subcommands. |
36
|
|
|
|
|
|
|
sub summary_list($$$) { |
37
|
0
|
|
|
0
|
0
|
|
my ($self, $name, $subcmds) = @_; |
38
|
0
|
|
|
|
|
|
$self->section("List of ${name} commands (with minimum abbreviation in parenthesis):"); |
39
|
0
|
|
|
|
|
|
foreach my $subcmd_name (sort keys %{$subcmds}) { |
|
0
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Some commands have lots of output. |
41
|
|
|
|
|
|
|
# they are excluded here because 'in_list' is false. |
42
|
0
|
|
|
|
|
|
$self->msg($self->summary_help($subcmds->{$subcmd_name})); |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# Error message when subcommand asked for but doesn't exist |
47
|
|
|
|
|
|
|
sub undefined_subcmd($$$) { |
48
|
0
|
|
|
0
|
0
|
|
my ($self, $cmd, $subcmd) = @_; |
49
|
0
|
0
|
|
|
|
|
my $ambig = $self->{settings}->{abbrev} ? 'or ambiguous ' : ''; |
50
|
0
|
|
|
|
|
|
$self->errmsg([sprintf('Undefined %s"%s" subcommand: "%s". ', $ambig, $cmd, $subcmd), |
51
|
|
|
|
|
|
|
sprintf('Try "help %s *".', $cmd)]); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
if (__FILE__ eq $0) { |
55
|
|
|
|
|
|
|
print abbrev_stringify('bogus-class', 'foo-command', 3), "\n"; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
1; |