File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Server.pm
Criterion Covered Total %
statement 72 102 70.5
branch n/a
condition n/a
subroutine 24 28 85.7
pod 0 4 0.0
total 96 134 71.6


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   104 use warnings; no warnings 'redefine';
  12     12   36  
  12     1   506  
  12     1   70  
  12         34  
  12         402  
  1         11  
  1         5  
  1         43  
  1         9  
  1         3  
  1         34  
4              
5 12     12   67 use rlib '../../../..';
  12     1   29  
  12         74  
  1         6  
  1         3  
  1         7  
6              
7             # Our local modules
8             ## use Devel::Trepan::Options; or is it default
9 12     12   8680 use Devel::Trepan::Interface::Server;
  12     1   100  
  12         875  
  1         377  
  1         3  
  1         73  
10              
11             package Devel::Trepan::CmdProcessor::Command::Server;
12 12     12   89 use Cwd 'abs_path';
  12     1   31  
  12         532  
  1         6  
  1         2  
  1         43  
13 12     12   75 use Getopt::Long qw(GetOptionsFromArray);
  12     1   32  
  12         124  
  1         6  
  1         2  
  1         12  
14 12     12   2149 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   40  
  12         82  
  1         121  
  1         3  
  1         4  
15              
16             unless (@ISA) {
17 12     12   90 eval <<'EOE';
  12     12   27  
  12     12   748  
  12     12   84  
  12         51  
  12         565  
  12         73  
  12         43  
  12         535  
  12         72  
  12         33  
  12         413  
18             use constant CATEGORY => 'support';
19             use constant SHORT_HELP => 'Allow remote debugger connections';
20             use constant MIN_ARGS => 0; # Need at least this many
21             use constant MAX_ARGS => undef; # Need at most this many - undef -> unlimited.
22             EOE
23             }
24              
25 12     12   1964 use strict;
  12     1   32  
  12         352  
  1         49  
  1         3  
  1         19  
26              
27 12     12   79 use vars qw(@ISA); @ISA = qw(Devel::Trepan::CmdProcessor::Command);
  12     1   36  
  12         760  
  1         5  
  1         2  
  1         46  
28 12     12   80 use vars @CMD_VARS; # Value inherited from parent
  12     1   41  
  12         4072  
  1         5  
  1         2  
  1         292  
29              
30             $NAME = set_name();
31             =pod
32              
33             =head2 Synopsis:
34              
35             =cut
36             $HELP = <<'HELP';
37             =pod
38              
39             B<server> [I<options>]
40              
41             options:
42              
43             -p | --port NUMBER
44             -a | --address
45              
46             Suspends interactive debugger session and puts debugger in server mode
47             which opens a socket for debugger connections.
48              
49             =cut
50             HELP
51              
52             # FIXME: put back in help.
53             # Note that the command startup file ${Devel::Trepan::CMD_INITFILE_BASE} is read automatically
54             # via a ${NAME} command the debugger is started.
55              
56             my $DEFAULT_OPTIONS = {
57             port => 1954,
58             host => '127.0.0.1',
59             };
60              
61             # sub complete($$) {
62             # my ($self, $prefix) = @_;
63             # my $files = Readline::FILENAME_COMPLETION_PROC.call(prefix) || []
64             # my $opts = (qw(-c --continue --no-continue -N --no -y --yes
65             # --verbose --no-verbose), $files);
66             # Devel::Trepan::Complete::complete_token($opts, $prefix) ;
67             # }
68              
69             sub parse_options($$)
70             {
71 0     0 0   my ($self, $args) = @_;
  0     0 0    
72 0           my $seen_yes_no = 0;
  0            
73 0           my %opts = %{$DEFAULT_OPTIONS};
  0            
  0            
  0            
74             my $result = &GetOptionsFromArray($args,
75             'port:n' => \$opts{port},
76             'host:s' => \$opts{host},
77 0           );
  0            
78 0           \%opts;
  0            
79             }
80              
81             sub run($$)
82             {
83 0     0 0   my ($self, $args) = @_;
  0     0 0    
84 0           my @args = @$args;
  0            
85 0           my $proc = $self->{proc};
  0            
86 0           my $options = parse_options($self, \@args);
  0            
87 0           my $intf = $proc->{interfaces};
  0            
88 0           $options->{logger} = $intf->[-1]{output}{output};
  0            
89             # Push a new server interface.
90 0           my $script_intf = Devel::Trepan::Interface::Server->new(undef, undef,
  0            
91             $options);
92 0           push @{$intf}, $script_intf;
  0            
  0            
  0            
93             }
94              
95              
96             # Demo it
97             unless (caller) {
98             # require_relative '../mock'
99             # dbgr, cmd = MockDebugger::setup
100             # %w(--quiet -q --no-quiet --continue --no-continue -c -v --verbose
101             # --no-verbose).each do |opt|
102             # puts "parsing ${opt}"
103             # options =
104             # cmd.parse_options(Trepan::Command::SourceCommand::DEFAULT_OPTIONS.dup,
105             # opt)
106             # p options
107             # }
108              
109             # if ARGV.size >= 1
110             # puts "running... ${cmd.name} ${ARGV}"
111             # cmd.run([cmd.name, *ARGV])
112             # }
113             }
114              
115             1;