File Coverage

blib/lib/Term/ReadLine/Caroline.pm
Criterion Covered Total %
statement 17 63 26.9
branch 0 24 0.0
condition 0 21 0.0
subroutine 6 22 27.2
pod 0 16 0.0
total 23 146 15.7


line stmt bran cond sub pod time code
1             package Term::ReadLine::Caroline;
2 1     1   906 use strict;
  1         2  
  1         27  
3 1     1   3 use warnings;
  1         2  
  1         24  
4 1     1   3 use utf8;
  1         1  
  1         6  
5 1     1   26 use 5.008_001;
  1         2  
6 1     1   394 use Term::Encoding qw/term_encoding/;
  1         447  
  1         63  
7              
8             our @ISA = qw(Term::ReadLine::Stub);
9              
10 1     1   8 use Caroline;
  1         1  
  1         580  
11              
12 0     0 0   sub ReadLine { __PACKAGE__ }
13              
14             sub new {
15 0     0 0   my $class = shift;
16              
17             # Support multi byte characters
18 0           my $encoding = term_encoding();
19 0           binmode *STDIN, ":encoding(${encoding})";
20 0           binmode *STDOUT, ":encoding(${encoding})";
21              
22 0           my $self = bless {
23             caroline => Caroline->new(),
24             IN => *STDIN,
25             OUT => *STDOUT,
26             Attribs => {},
27             }, $class;
28             }
29              
30 0     0 0   sub caroline { shift->{caroline} }
31              
32              
33             sub readline {
34 0     0 0   my ( $self, $prompt ) = @_;
35 0 0         if (my $cb = $self->{Attribs}->{completion_callback}) {
36 0           $self->caroline->completion_callback($cb);
37             }
38 0           my $line = $self->caroline->readline($prompt);
39 0 0 0       $self->caroline->history_add($line) if defined($line) && $line =~ /\S/;
40 0           return $line;
41             }
42              
43             sub WriteHistory {
44 0     0 0   my ($self, $filename) = @_;
45 0           $self->caroline->write_history_file($filename);
46             }
47              
48             sub StifleHistory {
49 0     0 0   my ($self, $limit) = @_;
50 0           $self->caroline->history_max_len($limit);
51             }
52              
53             sub addhistory {
54 0     0 0   my $self = shift;
55 0           for my $entry (@_) {
56 0           $self->caroline->history_add($entry);
57             }
58             }
59 0     0 0   sub AddHistory { shift->addhistory(@_) }
60 0     0 0   sub GetHistory { shift->{history} }
61              
62 0     0 0   sub IN { shift->{IN} }
63 0     0 0   sub OUT { shift->{OUT} }
64              
65 0     0 0   sub MinLine { undef }
66              
67              
68              
69             sub findConsole {
70 0     0 0   my $console;
71             my $consoleOUT;
72              
73 0 0 0       if (-e "/dev/tty" and $^O ne 'MSWin32') {
    0 0        
74 0           $console = "/dev/tty";
75             } elsif (-e "con" or $^O eq 'MSWin32') {
76 0           $console = 'CONIN$';
77 0           $consoleOUT = 'CONOUT$';
78             } else {
79 0           $console = "sys\$command";
80             }
81              
82 0 0 0       if (($^O eq 'amigaos') || ($^O eq 'beos') || ($^O eq 'epoc')) {
    0 0        
83 0           $console = undef;
84             }
85             elsif ($^O eq 'os2') {
86 0 0         if ($DB::emacs) {
87 0           $console = undef;
88             } else {
89 0           $console = "/dev/con";
90             }
91             }
92              
93 0 0         $consoleOUT = $console unless defined $consoleOUT;
94 0 0         $console = "&STDIN" unless defined $console;
95 0 0 0       if ($console eq "/dev/tty" && !open(my $fh, "<", $console)) {
96 0           $console = "&STDIN";
97 0           undef($consoleOUT);
98             }
99 0 0         if (!defined $consoleOUT) {
100 0 0 0       $consoleOUT = defined fileno(STDERR) && $^O ne 'MSWin32' ? "&STDERR" : "&STDOUT";
101             }
102 0           ($console,$consoleOUT);
103             }
104              
105             our %Features = (
106             addHistory => 1,
107             getHistory => 1,
108             );
109              
110 0     0 0   sub Attribs { shift->{Attribs} }
111              
112 0     0 0   sub Features { \%Features }
113              
114       0 0   sub ornaments {
115             # NIY
116             }
117              
118             1;
119              
120             __END__