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

# -*- coding: utf-8 -*-
# Copyright (C) 2011-2012 Rocky Bernstein <[e-mail]>

# 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;