File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Source.pm
Criterion Covered Total %
statement 87 147 59.1
branch 0 12 0.0
condition 0 6 0.0
subroutine 29 38 76.3
pod 0 6 0.0
total 116 209 55.5


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2012, 2014 Rocky Bernstein <rocky@cpan.org>
3 12     12   99 use warnings; no warnings 'redefine';
  12     12   36  
  12     1   404  
  12     1   65  
  12         30  
  12         388  
  1         7  
  1         3  
  1         26  
  1         4  
  1         3  
  1         26  
4              
5 12     12   66 use rlib '../../../..';
  12     1   29  
  12         75  
  1         5  
  1         2  
  1         5  
6              
7             # Our local modules
8             ## use Devel::Trepan::Options; or is it default
9 12     12   8864 use Devel::Trepan::Interface::Script;
  12     1   56  
  12         594  
  1         295  
  1         2  
  1         58  
10 12     12   6264 use Devel::Trepan::IO::NullOutput;
  12     1   46  
  12         589  
  1         7  
  1         2  
  1         44  
11              
12             # Must be outside of package!
13 12     12   85 use if !@ISA, Devel::Trepan::Complete ;
  12     1   30  
  12         95  
  1         6  
  1         2  
  1         7  
14              
15             package Devel::Trepan::CmdProcessor::Command::Source;
16 12     12   590 use Cwd 'abs_path';
  12     1   32  
  12         534  
  1         47  
  1         3  
  1         57  
17 12     12   89 use Getopt::Long qw(GetOptionsFromArray);
  12     1   35  
  12         125  
  1         7  
  1         1  
  1         10  
18 12     12   1690 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   30  
  12         72  
  1         150  
  1         2  
  1         6  
19              
20             unless (@ISA) {
21 12     12   94 eval <<'EOE';
  12     12   40  
  12     12   744  
  12     12   72  
  12     12   28  
  12         486  
  12         66  
  12         31  
  12         483  
  12         75  
  12         35  
  12         521  
  12         74  
  12         32  
  12         455  
22             use constant CATEGORY => 'support';
23             use constant SHORT_HELP => 'Run debugger commands from a file';
24             use constant MIN_ARGS => 1; # Need at least this many
25             use constant MAX_ARGS => undef; # Need at most this many - undef -> unlimited.
26             use constant NEED_STACK => 0;
27             EOE
28             }
29              
30 12     12   1951 use strict;
  12     1   31  
  12         362  
  1         52  
  1         3  
  1         24  
31              
32 12     12   64 use vars qw(@ISA); @ISA = qw(Devel::Trepan::CmdProcessor::Command);
  12     1   28  
  12         545  
  1         7  
  1         2  
  1         41  
33 12     12   75 use vars @CMD_VARS; # Value inherited from parent
  12     1   30  
  12         6908  
  1         4  
  1         3  
  1         618  
34              
35             our $NAME = set_name();
36             =pod
37              
38             =head2 Synopsis:
39              
40             =cut
41             our $HELP = <<'HELP';
42             =pod
43              
44             B<source> [I<options>] I<file>
45              
46             options:
47              
48             -q | --quiet | --no-quiet
49             -c | --continue | --no-continue
50             -Y | --yes | -N | --no
51             -v | --verbose | --no-verbose
52              
53             Read debugger commands from a file named I<file>. Optional C<-v> switch
54             causes each command in FILE to be echoed as it is executed. Option C<-Y>
55             sets the default value in any confirmation command to be 'yes' and C<-N>
56             sets the default value to 'no'.
57              
58             Option C<-q> will turn off any debugger output that normally occurs in
59             the running of the program.
60              
61             An error in any command terminates execution of the command file
62             unless option C<-c> or C<--continue> is given.
63             =cut
64             HELP
65              
66             # FIXME: put back in help.
67             # Note that the command startup file ${Devel::Trepan::CMD_INITFILE_BASE} is read automatically
68             # via a ${NAME} command the debugger is started.
69              
70             my $DEFAULT_OPTIONS = {
71             abort_on_error => 0,
72             confirm_val => 0,
73             quiet => 0,
74             verbose => 0
75             };
76              
77             sub complete($$) {
78 0     0 0   my ($self, $prefix) = @_;
  0     0 0    
79 0           my @files = $self->{proc}{interfaces}[-1]->rl_filename_list($prefix);
  0            
80 0           my @opts = (qw(-c --continue -n --no -y --yes
  0            
81             -v --verbose --no-verbose), @files);
82 0           Devel::Trepan::Complete::complete_token(\@opts, $prefix) ;
  0            
83             }
84              
85             sub parse_options($$)
86             {
87 0     0 0   my ($self, $args) = @_;
  0     0 0    
88 0           my $seen_yes_no = 0;
  0            
89 0           my %opts = %$DEFAULT_OPTIONS;
  0            
90             my $result = &GetOptionsFromArray($args,
91             '--continue' => \$opts{cont},
92             '--v' => \$opts{verbose},
93             '--verbose' => \$opts{verbose},
94             '-n' => \$opts{no},
95             '--no' => \$opts{no},
96 0     0     '-y' => sub { $opts{no} = 0; },
  0            
97 0     0     '--yes' => sub { $opts{no} = 0; }
  0     0      
98 0           );
  0            
99 0           \%opts;
  0            
100             }
101              
102             sub run($$)
103             {
104 0     0 0   my ($self, $args) = @_;
  0     0 0    
105 0           my @args = @$args;
  0            
106 0           @args = splice @args, 1, scalar(@args) - 2;
  0            
107 0           my $options = parse_options($self, \@args);
  0            
108 0           my $intf = $self->{proc}{interfaces};
  0            
109             my $output = $options->{quiet} ? Devel::Trepan::IO::OutputNull->new :
110 0 0         $intf->[-1]{output};
  0 0          
111              
112 0           my $filename = $args->[-1];
  0            
113              
114 0           my $expanded_filename = abs_path(glob($filename));
  0            
115 0 0 0       unless (defined $expanded_filename && -f $expanded_filename) {
  0 0 0        
116 0           my $mess = sprintf("Debugger command file '%s' is not found", $filename);
  0            
117 0           $self->errmsg($mess);
  0            
118 0           return 0;
  0            
119             }
120 0 0         unless(-r $expanded_filename) {
  0 0          
121 0           my $mess = sprintf("Debugger command file '%s' (%s) is not a readable file", $filename, $expanded_filename);
  0            
122 0           $self->errmsg($mess);
  0            
123 0           return 0;
  0            
124             }
125              
126             # Push a new debugger interface.
127 0           my $script_intf = Devel::Trepan::Interface::Script->new($expanded_filename,
  0            
128             $output, $options);
129 0           push @{$intf}, $script_intf;
  0            
  0            
  0            
130             }
131              
132              
133             # Demo it
134             unless (caller) {
135             # require_relative '../mock'
136             # dbgr, cmd = MockDebugger::setup
137             # %w(--quiet -q --no-quiet --continue --no-continue -c -v --verbose
138             # --no-verbose).each do |opt|
139             # puts "parsing ${opt}"
140             # options =
141             # cmd.parse_options(Trepan::Command::SourceCommand::DEFAULT_OPTIONS.dup,
142             # opt)
143             # p options
144             # }
145              
146             # if ARGV.size >= 1
147             # puts "running... ${cmd.name} ${ARGV}"
148             # cmd.run([cmd.name, *ARGV])
149             # }
150             }
151              
152             1;