File Coverage

lib/Term/ReadLine/Perl5.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             # -*- Perl -*-
2             package Term::ReadLine::Perl5;
3             =encoding utf8
4              
5             =head1 Name
6              
7             Term::ReadLine::Perl5 - A Perl5 implementation GNU Readline
8              
9             =head2 Overview
10              
11             This is a implementation of the GNU Readline/History Library written
12             in Perl5.
13              
14             GNU Readline reads lines from an interactive terminal with I or
15             I editing capabilities. It provides as mechanism for saving
16             history of previous input.
17              
18             This package typically used in command-line interfaces and REPLs (Read,
19             Eval, Print, Loop).
20              
21             =head2 Demo program
22              
23             Another package, L is available to let
24             you run I to experiment with its capabilities
25             and show how to use the API.
26              
27             =head1 Synopsis
28              
29             use Term::ReadLine::Perl5;
30             $term = Term::ReadLine::Perl5->new('ProgramName');
31             while ( defined ($_ = $term->readline('prompt>')) ) {
32             ...
33             }
34              
35             =cut
36 8     8   152427 use warnings; use strict;
  8     8   15  
  8         263  
  8         34  
  8         11  
  8         227  
37 8     8   6376 use Term::ReadLine::Perl5::readline;
  0            
  0            
38             no warnings 'once';
39              
40             our $VERSION = '1.42';
41              
42             use Carp;
43             eval "use rlib '.' "; # rlib is now optional
44             use Term::ReadLine::Perl5::History;
45             use Term::ReadLine::Perl5::OO;
46             use Term::ReadLine::Perl5::OO::History;
47             use Term::ReadLine::Perl5::Tie;
48             use Term::ReadLine::Perl5::readline;
49              
50             if (require Term::ReadLine) {
51             our @ISA = qw(Term::ReadLine::Stub);
52             }
53             my (%attribs, $term);
54              
55             =head2 Variables
56              
57             Following GNU Readline/History Library variables can be accessed from
58             Perl program. See 'GNU Readline Library Manual' and ' GNU History
59             Library Manual' for each variable. You can access them via the
60             C method. Names of keys in this hash conform to standard
61             conventions with the leading C stripped.
62              
63             Example:
64              
65             $term = Term::ReadLine::Perl5->new('ReadLineTest');
66             $attribs = $term->Attribs;
67             $v = $attribs->{history_base}; # history_base
68              
69             =head3 Attribute Names
70              
71             completion_suppress_append (bool)
72             history_base (int)
73             history_stifled (int)
74             max_input_history (int)
75             outstream (file handle)
76              
77             =cut
78              
79             my %features = (
80             appname => 1, # "new" is recognized
81             minline => 1, # we have a working MinLine()
82             autohistory => 1, # lines are put into history automatically,
83             # subject to MinLine()
84             getHistory => 1, # we have a working getHistory()
85             setHistory => 1, # we have a working setHistory()
86             addHistory => 1, # we have a working add_history(), addhistory(),
87             # or addHistory()
88             readHistory => 1, # we have read_history() or readHistory()
89             writeHistory => 1, # we have writeHistory()
90             preput => 1, # the second argument to readline is processed
91             attribs => 1,
92             newTTY => 1, # we have newTTY()
93             stiflehistory => 1, # we have stifle_history()
94             );
95              
96             tie %attribs, 'Term::ReadLine::Perl5::Tie' or die ;
97             sub Attribs {
98             \%attribs;
99             }
100              
101             =head1 Subroutine
102              
103             =head2 Standard Term::ReadLine Methods
104              
105             These methods are standard methods defined by
106             L.
107              
108             =head3 C
109              
110             Readline() -> 'Term::ReadLine::Perl5'
111              
112             returns the actual package that executes the commands. If this package
113             is used, the value is C.
114              
115             =cut
116             sub ReadLine {'Term::ReadLine::Perl5'}
117              
118              
119             =head3 readline
120              
121             $bool = $term->readline($prompt, $default)
122              
123             The main routine to call interactively read lines. Parameter
124             I<$prompt> is the text you want to prompt with If it is empty string,
125             no preceding prompt text is given. It is I a default value of
126             "INPUT> " is used.
127              
128             Parameter I<$default> is the default value; it can be can be
129             omitted. The next input line is returned or I on EOF.
130              
131             =cut
132              
133             sub readline {
134             shift;
135             &Term::ReadLine::Perl5::readline::readline(@_);
136             }
137              
138             =head3 new
139              
140             B(I<$name>,[I[,I]])
141              
142             returns the handle for subsequent calls to following functions.
143             Argument is the name of the application. Optionally can be followed
144             by two arguments for C and C file handles. These arguments
145             should be globs.
146              
147             I<$name> is the name of the application.
148              
149             This routine may also get called via
150             Cnew($term_name)> if you have
151             C<$ENV{PERL_RL}> set to 'Perl5';
152              
153             At present, because this code has lots of global state, we currently don't
154             support more than one readline instance.
155              
156             =cut
157             sub new {
158             my $class = shift;
159             if (require Term::ReadLine) {
160             $features{tkRunning} = Term::ReadLine::Stub->Features->{'tkRunning'};
161             $features{ornaments} = Term::ReadLine::Stub->Features->{'ornaments'};
162             }
163             if (defined $term) {
164             my $stderr = $Term::ReadLine::Perl5::readline::term_OUT;
165             print $stderr "Cannot create second readline interface\n";
166             print "Using experimental OO interface based on Caroline\n";
167             my ($name, $in, $out) = @_;
168             my $opts = {
169             name => $name,
170             in => $in,
171             out => $out,
172             };
173             return Term::ReadLine::Perl5::OO->new($opts);
174             }
175             shift; # Package name
176             if (@_) {
177             if ($term) {
178             warn "Ignoring name of second readline interface.\n"
179             if defined $term;
180             shift;
181             } else {
182             # Set Name
183             $Term::ReadLine::Perl5::readline::rl_readline_name = shift;
184             }
185             }
186             if (!@_) {
187             if (!defined $term) {
188             my ($IN,$OUT) = Term::ReadLine->findConsole();
189             # Old Term::ReadLine did not have a workaround for a bug
190             # in Win devdriver
191             $IN = 'CONIN$' if $^O eq 'MSWin32' and "\U$IN" eq 'CON';
192             open(my $in_fh,
193             # A workaround for another bug in Win device driver
194             (($IN eq 'CONIN$' and $^O eq 'MSWin32') ? "+< $IN" : "< $IN"))
195             or croak "Cannot open $IN for read";
196             open(my $out_fh, ">$OUT") || croak "Cannot open $OUT for write: $!";
197             $Term::ReadLine::Perl5::readline::term_IN = $in_fh;
198             $Term::ReadLine::Perl5::readline::term_OUT = $out_fh;
199             }
200             } else {
201             if (defined $term and ($term->IN ne $_[0] or $term->OUT ne $_[1]) ) {
202             croak "Request for a second readline interface with different terminal";
203             }
204             $Term::ReadLine::Perl5::readline::term_IN = shift;
205             $Term::ReadLine::readline::term_OUT = shift
206             }
207             # The following is here since it is mostly used for perl input:
208             # $readline::rl_basic_word_break_characters .= '-:+/*,[])}';
209             $term = bless [$readline::term_IN,$readline::term_OUT];
210             my $self = {
211             'IN' => $readline::term_IN,
212             'OUT' => $readline::term_OUT,
213             };
214             bless $self, $class;
215              
216             unless ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/) {
217             local $Term::ReadLine::termcap_nowarn = 1; # With newer Perls
218             local $SIG{__WARN__} = sub {}; # With older Perls
219             $term->ornaments(1);
220             }
221              
222             # FIXME: something rl_term_set in here causes terminal attributes
223             # like bold and underline to work.
224             Term::ReadLine::Perl5::readline::rl_term_set();
225              
226             return $self;
227             }
228              
229             =head3 newTTY
230              
231             BnewTTY>(I, I)
232              
233             takes two arguments which are input filehandle and output filehandle.
234             Switches to use these filehandles.
235             =cut
236             sub newTTY($$$) {
237             my ($self, $in, $out) = @_;
238             $Term::ReadLine::Perl5::readline::term_IN = $self->{'IN'} = $in;
239             $Term::ReadLine::Perl5::readline::term_OUT = $self->{'OUT'} = $out;
240             my $sel = select($out);
241             $| = 1; # for DB::OUT
242             select($sel);
243             }
244              
245             =head3 Minline
246              
247             B([I<$minlength>])>
248              
249             If B<$minlength> is given, set C<$readline::minlength> the minimum
250             length a $line for it to go into the readline history.
251              
252             The previous value is returned.
253             =cut
254             sub MinLine($;$) {
255             my $old = $minlength;
256             $minlength = $_[1] if @_ == 2;
257             return $old;
258             }
259              
260             #################### History ##########################################
261              
262             =head3 add_history
263              
264             $term->add_history>($line1, $line2, ...)
265              
266             adds the lines, I<$line1>, etc. to the input history list.
267              
268             I is an alias for this function.
269              
270             =cut
271              
272             # GNU ReadLine names
273             *add_history = \&Term::ReadLine::Perl5::History::add_history;
274             *remove_history = \&Term::ReadLine::Perl5::History::remove_history;
275             *replace_history_entry = \&Term::ReadLine::Perl5::History::replace_history_entry;
276              
277             *clear_history = \&Term::ReadLine::Perl5::History::clear_history;
278              
279             *history_is_stifled = \&Term::ReadLine::Perl5::History::history_is_stifled;
280             *read_history = \&Term::ReadLine::Perl5::History::read_history;
281             *unstifle_history = \&Term::ReadLine::Perl5::History::unstifle_history;
282             *write_history = \&Term::ReadLine::Perl5::History::write_history;
283              
284             # Not sure about the difference between history_list and GetHistory.
285             *history_list = \&Term::ReadLine::Perl5::OO::GetHistory;
286              
287             *rl_History = *Term::ReadLine::Perl5::rl_History;
288              
289              
290             # Some Term::ReadLine::Gnu names
291             *AddHistory = \&add_history;
292             *GetHistory = \&Term::ReadLine::Perl5::History::GetHistory;
293             *SetHistory = \&Term::ReadLine::Perl5::History::SetHistory;
294             *ReadHistory = \&Term::ReadLine::Perl5::History::ReadHistory;
295             *WriteHistory = \&Term::ReadLine::Perl5::History::WriteHistory;
296              
297             # Backward compatibility:
298             *addhistory = \&add_history;
299             *StifleHistory = \&stifle_history;
300              
301             =head3 stifle_history
302              
303             $term->stifle_history($max)
304              
305             Stifle or put a cap on the history list, remembering only C<$max>
306             number of lines.
307              
308             I is an alias for this function.
309              
310             =cut
311             ### FIXME: stifle_history is still here because it updates $attribs.
312             ## Pass a reference?
313             sub stifle_history($$) {
314             my ($self, $max) = @_;
315             $max = 0 if !defined($max) || $max < 0;
316              
317             if (scalar @rl_History > $max) {
318             splice @rl_History, $max;
319             $attribs{history_length} = scalar @rl_History;
320             }
321              
322             $Term::ReadLine::Perl5::History::history_stifled = 1;
323             $attribs{max_input_history} = $self->{rl_max_input_history} = $max;
324             }
325              
326             =head3 Features
327              
328             B
329              
330             Returns a reference to a hash with keys being features present in
331             current implementation. Several optional features are used in the
332             minimal interface:
333              
334             =over
335              
336             =item *
337             I is present if you can add lines to history list via
338             the I method
339              
340             =item *
341             I is be present if a name, the first argument
342             to I was given
343              
344             =item *
345             I is present if lines are put into history automatically
346             subject to the line being longer than I.
347              
348             =item *
349             I is present if we get retrieve history via the I
350             method
351              
352             =item *
353             I is present if the I method available.
354              
355             =item *
356             I is present if the second argument to I method can
357             append text to the input to be read subsequently
358              
359             =item *
360             I is present you can read history
361             items previosly saved in a file.
362              
363             =item *
364             I is present if we can set history
365              
366             =item *
367             I is present you can put a limit of the nubmer of history
368             items to save via the I method
369              
370             =item *
371             I is present if a Tk application may run while I is
372             getting input.
373              
374             =item *
375             I is present you can save history to a file via the
376             I method
377              
378             =back
379              
380             =cut
381              
382             sub Features { \%features; }
383              
384             =head1 See also
385              
386             =over
387              
388             =item *
389              
390             L is the newer but unfinished fully OO version.
391              
392             =item *
393              
394             L is the first try at the OO package that most
395             programmers will use.
396              
397             =item *
398              
399             L is guide to the guts of the
400             non-OO portion of L
401              
402             =item *
403              
404             L describes the history
405             mechanism
406              
407             =item *
408              
409             L is a generic package which can be used to
410             select this among other compatible GNU Readline packages.
411              
412             =back
413              
414             =cut
415             1;