Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 6f49cae0f4
Fetching contributors…

Cannot retrieve contributors at this time

file 144 lines (129 sloc) 3.767 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <rocky@cpan.org>

# Debugger user/command-oriented input possibly attached to IO-style
# input or GNU Readline.
#

package Devel::Trepan::IO::Input;
use warnings;
use strict;
use Exporter;
use Term::ReadLine;


# TODO : Shouldn't this use lib be removed?
use lib '../../..';
use Devel::Trepan::Util qw(hash_merge);
use Devel::Trepan::IO;

use vars qw(@EXPORT @ISA $HAVE_GNU_READLINE);
@ISA = qw(Devel::Trepan::IO::InputBase Exporter);
@EXPORT = qw($HAVE_GNU_READLINE);

BEGIN {
    $ENV{'PERL_RL'} ||= 'Gnu';
    my $term = Term::ReadLine->new('testing');
    if ($term->ReadLine eq 'Term::ReadLine::Gnu') {
      $HAVE_GNU_READLINE=1;
    } else {
      $HAVE_GNU_READLINE=0;
    }
    # Don't know how to close $term
    $term = undef;
}

my $readline_finalized = 0;
sub new($;$$) {
    my ($class, $inp, $opts) = @_;
    $inp ||= *STDIN;
    my $self = Devel::Trepan::IO::InputBase->new($inp, $opts);
    if ($opts->{readline} && $HAVE_GNU_READLINE) {
$self->{readline} = Term::ReadLine->new('trepanpl');
$self->{gnu_readline} = 1;
    } else {
$self->{readline} = undef;
$self->{gnu_readline} = 0;
    }
    bless ($self, $class);
    return $self;
}

sub have_gnu_readline($)
{
    my $self = shift;
    $self->{gnu_readline};
}

sub is_interactive($) {
    my $self = shift;
    return -t $self->{input};
}

# Read a line of input. EOFError will be raised on EOF.
# Prompt is ignored if we don't have GNU readline. In that
# case, it should have been handled prior to this call.
sub readline($;$) {
    my ($self, $prompt) = @_;
    my $line;
    if (defined $self->{readline}) {
$line = $self->{readline}->readline($prompt);
    } else {
$self->{eof} = eof($self->{input});
return '' if $self->{eof};
$line = CORE::readline $self->{input};
    }
    return $line;
}
    
# class << self
# # Use this to set where to read from.
# #
# # Set opts[:line_edit] if you want this input to interact with
# # GNU-like readline library. By default, we will assume to try
# # using readline.
# def open(inp=nil, opts={})
# inp ||= STDIN
# inp = File.new(inp, 'r') if inp.is_a?(String)
# opts[:line_edit] = @line_edit =
# inp.respond_to?(:isatty) && inp.isatty && Trepan::GNU_readline?
# self.new(inp, opts)
# end

# # finalize
# END {
# if (defined(RbReadline) && !@@readline_finalized) {
# begin
# RbReadline.rl_cleanup_after_signal();
# rescue
# end
# begin
# RbReadline.rl_deprep_terminal();
# rescue
# end
# @@readline_finalized = 1;
# }

# end
# end

# package Trepan
# def Trepan::GNU_readline?
# @have_readline ||= nil
# begin
# return @have_readline unless @have_readline.nil?
# @have_readline = require 'readline'
# at_exit { Trepan::UserInput::finalize }
# return true
# rescue LoadError
# return false
# end
# end
    
# Demo
unless (caller) {
    my $in = __PACKAGE__->new(*main::STDIN, {line_edit => 1});
    require Data::Dumper; import Data::Dumper;
    print Dumper($in), "\n";
    printf "Is interactive: %s\n", ($in->is_interactive ? "yes" : "no");
    printf "Have GNU Readline: %s\n", ($HAVE_GNU_READLINE ? "yes" : "no");
    if (scalar(@ARGV) > 0) {
print "Enter some text: ";
my $line = $in->readline;
if ($in->is_eof) {
print "EOF seen\n";
} else {
print "You entered ${line}";
}
    }
    my $inp = __PACKAGE__->new(undef, {readline => 0});
    printf "Input open has GNU Readline: %s\n", ($inp->have_gnu_readline ? "yes" : "no");
    $inp = __PACKAGE__->new(undef, {readline => 1});
    printf "Input open now has GNU Readline: %s\n", ($inp->have_gnu_readline ? "yes" : "no");
}
1;
Something went wrong with that request. Please try again.