File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Run.pm
Criterion Covered Total %
statement 63 81 77.7
branch 0 4 0.0
condition n/a
subroutine 21 23 91.3
pod 0 2 0.0
total 84 110 76.3


line stmt bran cond sub pod time code
1             # Copyright (C) 2011-2012, 2014-2015 Rocky Bernstein <rocky@cpan.org>
2             # -*- coding: utf-8 -*-
3 12     12   94 use warnings; no warnings 'redefine';
  12     12   28  
  12     1   374  
  12     1   59  
  12         29  
  12         335  
  1         7  
  1         2  
  1         23  
  1         4  
  1         2  
  1         37  
4 12     12   92 use rlib '../../../..';
  12     1   23  
  12         66  
  1         6  
  1         2  
  1         4  
5              
6             package Devel::Trepan::CmdProcessor::Command::Run;
7 12     12   4683 use English qw( -no_match_vars );
  12     1   26  
  12         75  
  1         340  
  1         2  
  1         7  
8              
9 12     12   4433 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   24  
  12         68  
  1         251  
  1         2  
  1         5  
10             unless (@ISA) {
11 12     12   73 eval <<'EOE';
  12     12   26  
  12     12   666  
  12     12   64  
  12     12   29  
  12         483  
  12         66  
  12         38  
  12         475  
  12         61  
  12         30  
  12         440  
  12         71  
  12         30  
  12         493  
12             use constant ALIASES => ('R', 'restart');
13             use constant CATEGORY => 'running';;
14             use constant SHORT_HELP => '(Hard) restart of program via exec()';
15             use constant MIN_ARGS => 0; # Need at least this many
16             use constant MAX_ARGS => undef; # Need at most this many - undef -> unlimited.
17             EOE
18             }
19              
20 12     12   1659 use strict;
  12     1   27  
  12         275  
  1         58  
  1         2  
  1         21  
21 12     12   58 use vars qw(@ISA);
  12     1   24  
  12         524  
  1         4  
  1         2  
  1         51  
22             @ISA = @CMD_ISA;
23 12     12   59 use vars @CMD_VARS; # Value inherited from parent
  12     1   71  
  12         3350  
  1         5  
  1         3  
  1         269  
24              
25             our $NAME = set_name();
26              
27             =pod
28              
29             =head2 Synopsis:
30              
31             =cut
32             our $HELP = <<'HELP';
33             =pod
34              
35             B<run>
36              
37             Restart debugger and program via an I<exec()> call.
38              
39             Hash reference variable I<$Devel::Trepan::Core::invoke_opts> contains a
40             hash of options that were used to start the debugger. These are
41             consulted in figuring out how to restart.
42              
43             =head2 See also:
44              
45             L<C<show args>|Devel::Trepan::CmdProcessor::Command:Show::Args> for
46             the exact invocation that will be used.
47              
48             =cut
49             HELP
50              
51             # This method runs the command
52             sub run($$) {
53 0     0 0   my ($self, $args) = @_;
  0     0 0    
54 0           my $proc = $self->{proc};
  0            
55 0           my $dbgr = $proc->{dbgr};
  0            
56              
57             # I may not be able to resurrect you, but here goes ...
58 0           $self->msg("Warning: some settings and command-line options may be lost!");
  0            
59              
60 0           my @script = $proc->restart_args();
  0            
61              
62 0           my $intf = $proc->{interfaces}[-1];
  0            
63 0           $intf->save_history($proc->{last_command});
  0            
64              
65 0           $self->msg( "Running: " . join(' ', @script));
  0            
66              
67             # And run Perl again. We use exec() to keep the
68             # PID stable (and that way $ini_pids is still valid).
69              
70 0 0         exec(@script) || $self->errmsg("exec failed: $!");
  0 0          
71              
72             }
73              
74             unless (caller()) {
75             require Devel::Trepan::CmdProcessor::Mock;
76             my $proc = Devel::Trepan::CmdProcessor::Mock::setup();
77             my $cmd = Devel::Trepan::CmdProcessor::Command::Run->new($proc);
78             }
79              
80             1;