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 37 78.3
pod 0 6 0.0
total 116 208 55.7


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   120 use warnings; no warnings 'redefine';
  12     12   25  
  12     1   398  
  12     1   66  
  12         25  
  12         396  
  1         8  
  1         2  
  1         22  
  1         5  
  1         2  
  1         27  
4              
5 12     12   65 use rlib '../../../..';
  12     1   30  
  12         71  
  1         5  
  1         2  
  1         4  
6              
7             # Our local modules
8             ## use Devel::Trepan::Options; or is it default
9 12     12   9050 use Devel::Trepan::Interface::Script;
  12     1   61347  
  12         566  
  1         335  
  1         2  
  1         48  
10 12     12   5767 use Devel::Trepan::IO::NullOutput;
  12     1   11288  
  12         627  
  1         7  
  1         2  
  1         43  
11              
12             # Must be outside of package!
13 12     12   79 use if !@ISA, Devel::Trepan::Complete ;
  12     1   27  
  12         89  
  1         6  
  1         1  
  1         7  
14              
15             package Devel::Trepan::CmdProcessor::Command::Source;
16 12     12   518 use Cwd 'abs_path';
  12     1   22  
  12         506  
  1         52  
  1         2  
  1         59  
17 12     12   68 use Getopt::Long qw(GetOptionsFromArray);
  12     1   25  
  12         113  
  1         6  
  1         2  
  1         7  
18 12     12   1556 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   30  
  12         59  
  1         128  
  1         2  
  1         5  
19              
20             unless (@ISA) {
21 12     12   131 eval <<'EOE';
  12     12   28  
  12     12   724  
  12     12   80  
  12     12   37  
  12         629  
  12         69  
  12         28  
  12         593  
  12         81  
  12         26  
  12         566  
  12         71  
  12         23  
  12         524  
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   1988 use strict;
  12     1   32  
  12         386  
  1         65  
  1         9  
  1         31  
31              
32 12     12   72 use vars qw(@ISA); @ISA = qw(Devel::Trepan::CmdProcessor::Command);
  12     1   28  
  12         576  
  1         6  
  1         2  
  1         48  
33 12     12   88 use vars @CMD_VARS; # Value inherited from parent
  12     1   24  
  12         7744  
  1         6  
  1         1  
  1         614  
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            
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;