File Coverage

lib/Devel/Trepan/Interface.pm
Criterion Covered Total %
statement 37 57 64.9
branch 2 14 14.2
condition 5 14 35.7
subroutine 11 20 55.0
pod 0 12 0.0
total 55 117 47.0


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2012 Rocky Bernstein <rocky@cpan.org>
3              
4             # A base class for a debugger interface.
5              
6 14     14   5798 use strict;
  14         89  
  14         442  
7 14     14   114 use Exporter;
  14         35  
  14         470  
8 14     14   166 use warnings;
  14         39  
  14         477  
9 14     14   82 use Carp ();
  14         36  
  14         362  
10              
11             package Devel::Trepan::Interface;
12 14     14   68 use rlib '../..';
  14         36  
  14         90  
13 14     14   5113 use vars qw(@EXPORT @ISA @YN);
  14         80  
  14         1066  
14             @ISA = qw(Exporter);
15             @EXPORT = qw(readline close new);
16              
17 14     14   409 use Devel::Trepan::IO::Input;
  14         36  
  14         1230  
18 14     14   6223 use Devel::Trepan::IO::Output;
  14         39  
  14         8009  
19              
20             # A debugger interface handles the communication or interaction with between
21             # the program and the outside portion which could be
22             # - a user,
23             # - a front-end that talks to a user, or
24             # - another interface in another process or computer
25              
26             # attr_accessor :history_save, :interactive, :input, :output
27              
28             sub new {
29 14     14 0 155 my($class, $inp, $out, $opts) = @_;
30 14   50     60 $opts ||= {};
31 14         58 my $input_opts = {
32             readline => 0
33             };
34              
35             my $self = {
36             histfile => undef,
37             history_save => 0,
38             histsize => undef,
39             line_edit => $opts->{line_edit},
40 14   66     203 input => $inp || Devel::Trepan::IO::Input->new(undef, $input_opts),
      66        
41             opts => $opts,
42             output => $out || Devel::Trepan::IO::Output->new
43             };
44 14         96 bless $self, $class;
45 14         191 $self;
46             }
47              
48       0 0   sub add_history($$) {}
49              
50             # Closes all input and/or output.
51             sub close($) {
52 0     0 0 0 my($self) = shift;
53 0         0 eval {
54             $self->{input}->close if
55 0 0 0     0 defined($self->{input}) && !$self->{input}->is_closed;
56             $self->{output}->close if
57 0 0 0     0 defined($self->{output}) && !$self->{output}->is_closed;
58             };
59             }
60              
61             # Called when a dangerous action is about to be done to make sure
62             # it's okay. `prompt' is printed; user response is returned.
63             sub confirm($;$) {
64 0     0 0 0 my($self, $prompt, $default) = @_;
65 0         0 Carp::croak "RuntimeError, Trepan::NotImplementedMessage";
66             }
67              
68             # Common routine for reporting debugger error messages.
69             sub errmsg($;$$) {
70 2     2 0 6 my($self, $str, $prefix) = @_;
71 2 50       6 $prefix = '** ' unless defined $prefix;
72 2 50       12 if (ref($str) eq 'ARRAY') {
73 0         0 foreach my $s (@$str) {
74 0         0 $self->errmsg($s);
75             }
76             } else {
77 2         7 foreach my $s (split /\n/, $str) {
78 2         10 $self->msg(sprintf("%s%s" , $prefix, $s));
79             }
80             }
81             }
82              
83             sub is_input_eof($) {
84 0     0 0 0 my $self = shift;
85 0 0       0 return 1 unless defined $self->{input};
86 0         0 my $input = $self->{input};
87 0 0       0 $input->can("is_eof") ? $input->is_eof : $input->eof;
88             }
89              
90             # # Return true if interface is interactive.
91             # def interactive?
92             # # Default false and making subclasses figure out how to determine
93             # # interactiveness.
94             # false
95             # end
96              
97             # used to write to a debugger that is connected to this
98             # server; `str' written will have a newline added to it.
99             sub msg($$) {
100 7     7 0 16 my($self, $str) = @_;
101             # if (str.is_a?(Array)) {
102             # foreach my $s (@$str) {
103             # errmsg($s);
104             # }
105             # } else {
106 7         27 $self->{output}->writeline($str);
107             # }
108             }
109              
110             # used to write to a debugger that is connected to this
111             # server; `str' written will not have a newline added to it
112             sub msg_nocr($$) {
113 0     0 0   my($self, $msg) = @_;
114 0           $self->{output}->write($msg);
115             }
116              
117             sub read_command($;$) {
118 0     0 0   my($self, $prompt) = @_;
119 0           my $line = readline($prompt);
120             # FIXME: Do something with history?
121 0           return $line;
122             }
123              
124       0 0   sub read_history($$) {}
125              
126             sub readline($;$) {
127 0     0 0   my($self, $prompt) = @_;
128             ## FIXME
129             ## $self->{output}->flush;
130 0 0         $self->{output}->write($prompt) if $prompt;
131 0           $self->{input}->readline();
132             }
133              
134       0 0   sub save_history($$) {}
135              
136             #sub DESTROY {
137             # my $self = shift;
138             # if ($self->{output} && defined($self->{output}) && ! $self->{output}->is_closed) {
139             # eval {
140             # $self->msg(sprintf("%sThat's all, folks...",
141             # (defined($Devel::Trepan::PROGRAM) ?
142             # "${Devel::Trepan::PROGRAM}: " : '')));
143             # };
144             # }
145             # $self->close;
146             #}
147              
148             # Demo
149             unless (caller) {
150             my $interface = Devel::Trepan::Interface->new;
151             }
152              
153             1;