# -*- coding: utf-8 -*- # Copyright (C) 2011-2012 Rocky Bernstein # A base class for a debugger interface. use strict; use Exporter; use warnings; use Carp (); package Devel::Trepan::Interface; use rlib '../..'; use vars qw(@EXPORT @ISA @YN); @ISA = qw(Exporter); @EXPORT = qw(readline close new); use Devel::Trepan::IO::Input; use Devel::Trepan::IO::Output; # A debugger interface handles the communication or interaction with between # the program and the outside portion which could be # - a user, # - a front-end that talks to a user, or # - another interface in another process or computer # attr_accessor :history_save, :interactive, :input, :output sub new { my($class, $inp, $out, $opts) = @_; $opts ||= {}; my $input_opts = { readline => 0 }; my $self = { histfile => undef, history_save => 0, histsize => undef, line_edit => $opts->{line_edit}, input => $inp || Devel::Trepan::IO::Input->new(undef, $input_opts), opts => $opts, output => $out || Devel::Trepan::IO::Output->new }; bless $self, $class; $self; } sub add_history($$) {} # Closes all input and/or output. sub close($) { my($self) = shift; eval { $self->{input}->close if defined($self->{input}) && !$self->{input}->is_closed; $self->{output}->close if defined($self->{output}) && !$self->{output}->is_closed; }; } # Called when a dangerous action is about to be done to make sure # it's okay. `prompt' is printed; user response is returned. sub confirm($;$) { my($self, $prompt, $default) = @_; Carp::croak "RuntimeError, Trepan::NotImplementedMessage"; } # Common routine for reporting debugger error messages. sub errmsg($;$$) { my($self, $str, $prefix) = @_; $prefix = '** ' unless defined $prefix; if (ref($str) eq 'ARRAY') { foreach my $s (@$str) { $self->errmsg($s); } } else { foreach my $s (split /\n/, $str) { $self->msg(sprintf("%s%s" , $prefix, $s)); } } } sub is_input_eof($) { my $self = shift; return 1 unless defined $self->{input}; my $input = $self->{input}; $input->can("is_eof") ? $input->is_eof : $input->eof; } # # Return true if interface is interactive. # def interactive? # # Default false and making subclasses figure out how to determine # # interactiveness. # false # end # used to write to a debugger that is connected to this # server; `str' written will have a newline added to it. sub msg($$) { my($self, $str) = @_; # if (str.is_a?(Array)) { # foreach my $s (@$str) { # errmsg($s); # } # } else { $self->{output}->writeline($str); # } } # used to write to a debugger that is connected to this # server; `str' written will not have a newline added to it sub msg_nocr($$) { my($self, $msg) = @_; $self->{output}->write($msg); } sub read_command($;$) { my($self, $prompt) = @_; my $line = readline($prompt); # FIXME: Do something with history? return $line; } sub read_history($$) {} sub readline($;$) { my($self, $prompt) = @_; ## FIXME ## $self->{output}->flush; $self->{output}->write($prompt) if $prompt; $self->{input}->readline(); } sub save_history($$) {} #sub DESTROY { # my $self = shift; # if ($self->{output} && defined($self->{output}) && ! $self->{output}->is_closed) { # eval { # $self->msg(sprintf("%sThat's all, folks...", # (defined($Devel::Trepan::PROGRAM) ? # "${Devel::Trepan::PROGRAM}: " : ''))); # }; # } # $self->close; #} # Demo unless (caller) { my $interface = Devel::Trepan::Interface->new; } 1;