diff options
author | Karl Berry <karl@freefriends.org> | 2012-11-20 18:08:54 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2012-11-20 18:08:54 +0000 |
commit | c5add2ea5067382269ae6f19e345fda0b9a7bd21 (patch) | |
tree | 02f512fda46d93079c9dc59c0d76f0e398150f83 /Master/tlpkg/tlperl/lib/Term | |
parent | 6c35e87bdc5a3f64833dbbc42e7d42e683db9d5b (diff) |
perl 5.16.2, compiled without optimization for Windows (from siep)
git-svn-id: svn://tug.org/texlive/trunk@28315 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Term')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Term/ANSIColor.pm | 32 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Term/Cap.pm | 8 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Term/ReadLine.pm | 149 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Term/UI.pm | 114 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Term/UI/History.pm | 14 |
5 files changed, 208 insertions, 109 deletions
diff --git a/Master/tlpkg/tlperl/lib/Term/ANSIColor.pm b/Master/tlpkg/tlperl/lib/Term/ANSIColor.pm index 72b941f6211..bc2fc7e483e 100644 --- a/Master/tlpkg/tlperl/lib/Term/ANSIColor.pm +++ b/Master/tlpkg/tlperl/lib/Term/ANSIColor.pm @@ -1,7 +1,7 @@ # Term::ANSIColor -- Color screen output using ANSI escape sequences. # -# Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010 -# Russ Allbery <rra@stanford.edu> and Zenin +# Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010, +# 2011 Russ Allbery <rra@stanford.edu> and Zenin # PUSH/POP support submitted 2007 by openmethods.com voice solutions # # This program is free software; you may redistribute it and/or modify it @@ -17,7 +17,7 @@ package Term::ANSIColor; require 5.001; -$VERSION = '3.00'; +$VERSION = '3.01'; use strict; use vars qw($AUTOLOAD $AUTOLOCAL $AUTORESET @COLORLIST @COLORSTACK $EACHLINE @@ -226,7 +226,7 @@ sub uncolor { # piped to a pager or some other program). sub colored { my ($string, @codes); - if (ref $_[0]) { + if (ref ($_[0]) && ref ($_[0]) eq 'ARRAY') { @codes = @{+shift}; $string = join ('', @_); } else { @@ -296,8 +296,8 @@ grey ATTR print colored ("Yellow on magenta.", 'yellow on_magenta'), "\n"; print "This text is normal.\n"; print colored ['yellow on_magenta'], 'Yellow on magenta.', "\n"; - print colored ['red on_bright_yellow'] 'Red on bright yellow.', "\n"; - print colored ['bright_red on_black], 'Bright red on black.', "\n"; + print colored ['red on_bright_yellow'], 'Red on bright yellow.', "\n"; + print colored ['bright_red on_black'], 'Bright red on black.', "\n"; print "\n"; use Term::ANSIColor qw(uncolor); @@ -644,6 +644,16 @@ For easier debugging, you may prefer to always use the commas when not setting $Term::ANSIColor::AUTORESET or PUSHCOLOR/POPCOLOR so that you'll get a fatal compile error rather than a warning. +It's not possible to use this module to embed formatting and color +attributes using Perl formats. They replace the escape character with a +space (as documented in L<perlform(1)>), resulting in garbled output from +the unrecognized attribute. Even if there were a way around that problem, +the format doesn't know that the non-printing escape sequence is +zero-length and would incorrectly format the output. For formatted output +using color or other attributes, either use sprintf() instead or use +formline() and then add the color or other attributes after formatting and +before output. + =head1 NOTES The codes generated by this module are standard terminal control codes, @@ -695,7 +705,7 @@ currently supported by this module. =head1 SEE ALSO ECMA-048 is available on-line (at least at the time of this writing) at -L<http://www.ecma-international.org/publications/standards/ECMA-048.HTM>. +L<http://www.ecma-international.org/publications/standards/Ecma-048.htm>. ISO 6429 is available from ISO for a charge; the author of this module does not own a copy of it. Since the source material for ISO 6429 was @@ -714,10 +724,10 @@ Russ with input from Zenin. Russ Allbery now maintains this module. =head1 COPYRIGHT AND LICENSE -Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010 -Russ Allbery <rra@stanford.edu> and Zenin. This program is free software; -you may redistribute it and/or modify it under the same terms as Perl -itself. +Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010, +2011 Russ Allbery <rra@stanford.edu> and Zenin. This program is free +software; you may redistribute it and/or modify it under the same terms as +Perl itself. PUSHCOLOR, POPCOLOR, and LOCALCOLOR were contributed by openmethods.com voice solutions. diff --git a/Master/tlpkg/tlperl/lib/Term/Cap.pm b/Master/tlpkg/tlperl/lib/Term/Cap.pm index 004a03c4124..5430091efda 100644 --- a/Master/tlpkg/tlperl/lib/Term/Cap.pm +++ b/Master/tlpkg/tlperl/lib/Term/Cap.pm @@ -19,7 +19,7 @@ use strict; use vars qw($VERSION $VMS_TERMCAP); use vars qw($termpat $state $first $entry); -$VERSION = '1.12'; +$VERSION = '1.13'; # Version undef: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com # Version 1.00: Thu Nov 30 23:34:29 EST 2000 by schwern@pobox.com @@ -57,6 +57,8 @@ $VERSION = '1.12'; # EBDIC fixes from Chun Bing Ge <gecb@cn.ibm.com> # Version 1.12: Sat Dec 8 00:10:21 GMT 2007 # QNX test fix from Matt Kraai <kraai@ftbfs.org> +# Version 1.13: Thu Dec 22 22:21:09 GMT 2011 +# POD error fix from Domin Hargreaves <dom@earth.li> # # TODO: # support Berkeley DB termcaps @@ -86,8 +88,6 @@ termcap manpage on most Unix-like systems. =head2 METHODS -=over 4 - The output strings for B<Tputs> are cached for counts of 1 for performance. B<Tgoto> and B<Tpad> do not cache. C<$self-E<gt>{_xx}> is the raw termcap data and C<$self-E<gt>{xx}> is the cached version. @@ -145,6 +145,8 @@ sub termcap_path return grep { defined $_ && -f $_ } @termcap_path; } +=over 4 + =item B<Tgetent> Returns a blessed object reference which the user can diff --git a/Master/tlpkg/tlperl/lib/Term/ReadLine.pm b/Master/tlpkg/tlperl/lib/Term/ReadLine.pm index 0121cdfd065..3770df05529 100644 --- a/Master/tlpkg/tlperl/lib/Term/ReadLine.pm +++ b/Master/tlpkg/tlperl/lib/Term/ReadLine.pm @@ -114,6 +114,46 @@ additional methods: makes Tk event loop run when waiting for user input (i.e., during C<readline> method). +=item C<event_loop> + +Registers call-backs to wait for user input (i.e., during C<readline> +method). This supercedes tkRunning. + +The first call-back registered is the call back for waiting. It is +expected that the callback will call the current event loop until +there is something waiting to get on the input filehandle. The parameter +passed in is the return value of the second call back. + +The second call-back registered is the call back for registration. The +input filehandle (often STDIN, but not necessarily) will be passed in. + +For example, with AnyEvent: + + $term->event_loop(sub { + my $data = shift; + $data->[1] = AE::cv(); + $data->[1]->recv(); + }, sub { + my $fh = shift; + my $data = []; + $data->[0] = AE::io($fh, 0, sub { $data->[1]->send() }); + $data; + }); + +The second call-back is optional if the call back is registered prior to +the call to $term-E<gt>readline. + +Deregistration is done in this case by calling event_loop with C<undef> +as its parameter: + + $term->event_loop(undef); + +This will cause the data array ref to be removed, allowing normal garbage +collection to clean it up. With AnyEvent, that will cause $data->[0] to +be cleaned up, and AnyEvent will automatically cancel the watcher at that +time. If another loop requires more than that to clean up a file watcher, +that will be up to the caller to handle. + =item C<ornaments> makes the command line stand out by using termcap data. The argument @@ -150,8 +190,8 @@ be C<o=0> or C<ornaments=0>. The head should be as described above, say If the variable is not set, or if the head of space-separated list is empty, the best available package is loaded. - export "PERL_RL=Perl o=0" # Use Perl ReadLine without ornaments - export "PERL_RL= o=0" # Use best available ReadLine without ornaments + export "PERL_RL=Perl o=0" # Use Perl ReadLine sans ornaments + export "PERL_RL= o=0" # Use best available ReadLine sans ornaments (Note that processing of C<PERL_RL> for ornaments is in the discretion of the particular used C<Term::ReadLine::*> package). @@ -176,8 +216,7 @@ sub readline { my $prompt = shift; print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2]; $self->register_Tk - if not $Term::ReadLine::registered and $Term::ReadLine::toloop - and defined &Tk::DoOneEvent; + if not $Term::ReadLine::registered and $Term::ReadLine::toloop; #$str = scalar <$in>; $str = $self->get_line; utf8::upgrade($str) @@ -279,16 +318,16 @@ sub Attribs { {} } my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1); sub Features { \%features } -sub get_line { - my $self = shift; - my $in = $self->IN; - local ($/) = "\n"; - return scalar <$in>; -} +#sub get_line { +# my $self = shift; +# my $in = $self->IN; +# local ($/) = "\n"; +# return scalar <$in>; +#} package Term::ReadLine; # So late to allow the above code be defined? -our $VERSION = '1.07'; +our $VERSION = '1.09'; my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef; if ($which) { @@ -359,42 +398,88 @@ sub ornaments { package Term::ReadLine::Tk; -our($count_handle, $count_DoOne, $count_loop); -$count_handle = $count_DoOne = $count_loop = 0; +# This package inserts a Tk->fileevent() before the diamond operator. +# The Tk watcher dispatches Tk events until the filehandle returned by +# the$term->IN() accessor becomes ready for reading. It's assumed +# that the diamond operator will return a line of input immediately at +# that point. -our($giveup); -sub handle {$giveup = 1; $count_handle++} +my ($giveup); -sub Tk_loop { - # Tk->tkwait('variable',\$giveup); # needs Widget - $count_DoOne++, Tk::DoOneEvent(0) until $giveup; - $count_loop++; - $giveup = 0; -} +# maybe in the future the Tk-specific aspects will be removed. +sub Tk_loop{ + if (ref $Term::ReadLine::toloop) + { + $Term::ReadLine::toloop->[0]->($Term::ReadLine::toloop->[2]); + } + else + { + Tk::DoOneEvent(0) until $giveup; + $giveup = 0; + } +}; sub register_Tk { - my $self = shift; - $Term::ReadLine::registered++ - or Tk->fileevent($self->IN,'readable',\&handle); -} + my $self = shift; + unless ($Term::ReadLine::registered++) + { + if (ref $Term::ReadLine::toloop) + { + $Term::ReadLine::toloop->[2] = $Term::ReadLine::toloop->[1]->($self->IN) if $Term::ReadLine::toloop->[1]; + } + else + { + Tk->fileevent($self->IN,'readable',sub { $giveup = 1}); + } + } +}; sub tkRunning { $Term::ReadLine::toloop = $_[1] if @_ > 1; $Term::ReadLine::toloop; } -sub get_c { - my $self = shift; - $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent; - return getc $self->IN; +sub event_loop { + shift; + + # T::RL::Gnu and T::RL::Perl check that this exists, if not, + # it doesn't call the loop. Those modules will need to be + # fixed before this can be removed. + if (not defined &Tk::DoOneEvent) + { + *Tk::DoOneEvent = sub { + die "what?"; # this shouldn't be called. + } + } + + # store the callback in toloop, again so that other modules will + # recognise it and call us for the loop. + $Term::ReadLine::toloop = [ @_ ] if @_ > 0; # 0 because we shifted off $self. + $Term::ReadLine::toloop; } +sub PERL_UNICODE_STDIN () { 0x0001 } + sub get_line { my $self = shift; - $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent; - my $in = $self->IN; + my ($in,$out,$str) = @$self; + + if ($Term::ReadLine::toloop) { + $self->register_Tk if not $Term::ReadLine::registered; + $self->Tk_loop; + } + local ($/) = "\n"; - return scalar <$in>; + $str = <$in>; + + utf8::upgrade($str) + if (${^UNICODE} & PERL_UNICODE_STDIN || defined ${^ENCODING}) && + utf8::valid($str); + print $out $rl_term_set[3]; + # bug in 5.000: chomping empty string creats length -1: + chomp $str if defined $str; + + $str; } 1; diff --git a/Master/tlpkg/tlperl/lib/Term/UI.pm b/Master/tlpkg/tlperl/lib/Term/UI.pm index ba7a30421ba..34f13f8d513 100644 --- a/Master/tlpkg/tlperl/lib/Term/UI.pm +++ b/Master/tlpkg/tlperl/lib/Term/UI.pm @@ -11,7 +11,7 @@ use strict; BEGIN { use vars qw[$VERSION $AUTOREPLY $VERBOSE $INVALID]; $VERBOSE = 1; - $VERSION = '0.26'; + $VERSION = '0.30'; $INVALID = loc('Invalid selection, please try again: '); } @@ -35,7 +35,7 @@ Term::UI - Term::ReadLine UI made easy my $reply = $term->get_reply( prompt => 'What is your favourite colour?', choices => [qw|blue red green|], - default => blue, + default => 'blue', ); my $bool = $term->ask_yn( @@ -55,7 +55,7 @@ Term::UI - Term::ReadLine UI made easy ### always pick the default (good for non-interactive terms) ### -- default is '0' $Term::UI::AUTOREPLY = 1; - + ### Retrieve the entire session as a printable string: $hist = Term::UI::History->history_as_string; $hist = $term->history_as_string; @@ -73,12 +73,12 @@ For asking a yes or no question, there's even a shortcut. =head1 HOW IT WORKS -C<Term::UI> places itself at the back of the C<Term::ReadLine> +C<Term::UI> places itself at the back of the C<Term::ReadLine> C<@ISA> array, so you can call its functions through your term object. C<Term::UI> uses C<Term::UI::History> to record all interactions with the commandline. You can retrieve this history, or alter -the filehandle the interaction is printed to. See the +the filehandle the interaction is printed to. See the C<Term::UI::History> manpage or the C<SYNOPSIS> for details. =head1 METHODS @@ -102,8 +102,8 @@ toggling the C<multi> flag. Note that a list of answers will then be returned to you, rather than a simple string. By specifying an C<allow> hander, you can yourself validate the answer -a user gives. This can be any of the types that the Params::Check C<allow> -function allows, so please refer to that manpage for details. +a user gives. This can be any of the types that the Params::Check C<allow> +function allows, so please refer to that manpage for details. Finally, you have the option of adding a C<print_me> argument, which is simply printed before the prompt. It's printed to the same file handle @@ -135,7 +135,7 @@ sub get_reply { ### add this to the prompt to indicate the default ### answer to the question if there is one. my $prompt_add; - + ### if you supplied several choices to pick from, ### we'll print them separately before the prompt if( @{$args->{choices}} ) { @@ -144,7 +144,7 @@ sub get_reply { for my $choice ( @{$args->{choices}} ) { $i++; # the answer counter -- but humans start counting # at 1 :D - + ### so this choice is the default? add it to 'prompt_add' ### so we can construct a "foo? [DIGIT]" type prompt $prompt_add = $i if (defined $args->{default} and $choice eq $args->{default}); @@ -153,7 +153,7 @@ sub get_reply { $args->{print_me} .= sprintf "\n%3s> %-s", $i, $choice; } - ### we listed some choices -- add another newline for + ### we listed some choices -- add another newline for ### pretty printing $args->{print_me} .= "\n" if $i; @@ -169,14 +169,14 @@ sub get_reply { ### we set up the defaults, prompts etc, dispatch to the readline call return $term->_tt_readline( %$args, prompt_add => $prompt_add ); -} +} =head2 $bool = $term->ask_yn( prompt => "your question", [default => (y|1,n|0), print_me => "extra text to print & record"] ) Asks a simple C<yes> or C<no> question to the user, returning a boolean indicating C<true> or C<false> to the caller. -The C<default> answer will automatically returned, if the user hits +The C<default> answer will automatically returned, if the user hits C<enter> or if C<$AUTOREPLY> is set to true. See the C<GLOBAL VARIABLES> section further below. @@ -199,7 +199,7 @@ sub ask_yn { default => { default => undef, allow => [qw|0 1 y n|], strict_type => 1 }, prompt => { default => '', required => 1, strict_type => 1 }, - print_me => { default => '', strict_type => 1 }, + print_me => { default => '', strict_type => 1 }, multi => { default => 0, no_override => 1 }, choices => { default => [qw|y n|], no_override => 1 }, allow => { default => [qr/^y(?:es)?$/i, qr/^n(?:o)?$/i], @@ -208,7 +208,7 @@ sub ask_yn { }; my $args = check( $tmpl, \%hash, $VERBOSE ) or return undef; - + ### uppercase the default choice, if there is one, to be added ### to the prompt in a 'foo? [Y/n]' type style. my $prompt_add; @@ -217,10 +217,10 @@ sub ask_yn { ### if you supplied the default as a boolean, rather than y/n ### transform it to a y/n now - $args->{default} = $args->{default} =~ /\d/ + $args->{default} = $args->{default} =~ /\d/ ? { 0 => 'n', 1 => 'y' }->{ $args->{default} } : $args->{default}; - + @list = map { lc $args->{default} eq lc $_ ? uc $args->{default} : $_ @@ -231,7 +231,7 @@ sub ask_yn { } my $rv = $term->_tt_readline( %$args, prompt_add => $prompt_add ); - + return $rv =~ /^y/i ? 1 : 0; } @@ -247,11 +247,11 @@ sub _tt_readline { my ($default, $prompt, $choices, $multi, $allow, $prompt_add, $print_me); my $tmpl = { - default => { default => undef, strict_type => 1, + default => { default => undef, strict_type => 1, store => \$default }, prompt => { default => '', strict_type => 1, required => 1, store => \$prompt }, - choices => { default => [], strict_type => 1, + choices => { default => [], strict_type => 1, store => \$choices }, multi => { default => 0, allow => [0, 1], store => \$multi }, allow => { default => qr/.*/, store => \$allow, }, @@ -265,7 +265,7 @@ sub _tt_readline { ### it can display wonky on some terminals. history( $print_me ) if $print_me; - + ### we might have to add a default value to the prompt, to ### show the user what will be picked by default: $prompt .= " [$prompt_add]: " if $prompt_add; @@ -273,16 +273,16 @@ sub _tt_readline { ### are we in autoreply mode? if ($AUTOREPLY) { - + ### you used autoreply, but didnt provide a default! - carp loc( + carp loc( q[You have '%1' set to true, but did not provide a default!], - '$AUTOREPLY' + '$AUTOREPLY' ) if( !defined $default && $VERBOSE); ### print it out for visual feedback history( join ' ', grep { defined } $prompt, $default ); - + ### and return the default return $default; } @@ -290,16 +290,16 @@ sub _tt_readline { ### so, no AUTOREPLY, let's see what the user will answer LOOP: { - + ### annoying bug in T::R::Perl that mucks up lines with a \n ### in them; So split by \n, save the last line as the prompt ### and just print the rest { my @lines = split "\n", $prompt; $prompt = pop @lines; - + history( "$_\n" ) for @lines; } - + ### pose the question my $answer = $term->readline($prompt); $answer = $default unless length $answer; @@ -315,12 +315,12 @@ sub _tt_readline { ### the return value list my @rv; - + if( @$choices ) { - + for my $answer (@answers) { - - ### a digit implies a multiple choice question, + + ### a digit implies a multiple choice question, ### a non-digit is an open answer if( $answer =~ /\D/ ) { push @rv, $answer if allow( $answer, $allow ); @@ -328,24 +328,24 @@ sub _tt_readline { ### remember, the answer digits are +1 compared to ### the choices, because humans want to start counting - ### at 1, not at 0 - push @rv, $choices->[ $answer - 1 ] + ### at 1, not at 0 + push @rv, $choices->[ $answer - 1 ] if $answer > 0 && defined $choices->[ $answer - 1]; - } + } } - + ### no fixed list of choices.. just check if the answers ### (or otherwise the default!) pass the allow handler - } else { + } else { push @rv, grep { allow( $_, $allow ) } - scalar @answers ? @answers : ($default); + scalar @answers ? @answers : ($default); } ### if not all the answers made it to the return value list, - ### at least one of them was an invalid answer -- make the + ### at least one of them was an invalid answer -- make the ### user do it again - if( (@rv != @answers) or - (scalar(@$choices) and not scalar(@answers)) + if( (@rv != @answers) or + (scalar(@$choices) and not scalar(@answers)) ) { $prompt = $INVALID; $prompt .= "[$prompt_add] " if $prompt_add; @@ -486,7 +486,7 @@ This defaults to C<*STDOUT>. which would look like: - Your favourite colour? + Your favourite colour? and C<$reply> would hold the text the user typed. @@ -502,8 +502,8 @@ which would look like: 1> red 2> green 3> blue - - Your favourite colour? + + Your favourite colour? C<$reply> will hold one of the choices presented. C<Term::UI> will repose the question if the user attempts to enter an answer that's not in the @@ -523,8 +523,8 @@ which would look like: 1> red 2> green 3> blue - - Your favourite colour? [3]: + + Your favourite colour? [3]: Note the default answer after the prompt. A user can now just hit C<enter> (or set C<$Term::UI::AUTOREPLY> -- see the C<GLOBAL VARIABLES> section) and @@ -532,10 +532,10 @@ the sensible answer 'blue' will be returned. =head2 get_reply using print_me & multi - ### allow the user to pick more than one colour and add an + ### allow the user to pick more than one colour and add an ### introduction text @reply = $term->get_reply( - print_me => 'Tell us what colours you like', + print_me => 'Tell us what colours you like', prompt => 'Your favourite colours?', choices => [qw|red green blue|], multi => 1 ); @@ -546,15 +546,15 @@ which would look like: 1> red 2> green 3> blue - + Your favourite colours? An answer of C<3 2 1> would fill C<@reply> with C<blue green red> =head2 get_reply & allow - ### pose an open question, but do a custom verification on - ### the answer, which will only exit the question loop, if + ### pose an open question, but do a custom verification on + ### the answer, which will only exit the question loop, if ### the answer matches the allow handler. $reply = $term->get_reply( prompt => "What is the magic number?", @@ -571,18 +571,18 @@ C<Params::Check>'s C<allow> function. Check its manpage for details. ### and inform him first what cookies are. $bool = $term->ask_yn( prompt => 'Do you like cookies?', default => 'y', - print_me => 'Cookies are LOVELY!!!' ); + print_me => 'Cookies are LOVELY!!!' ); -would print: +would print: Cookies are LOVELY!!! - Do you like cookies? [Y/n]: + Do you like cookies? [Y/n]: -If a user then simply hits C<enter>, agreeing with the default, -C<$bool> would be set to C<true>. (Simply hitting 'y' would also +If a user then simply hits C<enter>, agreeing with the default, +C<$bool> would be set to C<true>. (Simply hitting 'y' would also return C<true>. Hitting 'n' would return C<false>) -We could later retrieve this interaction by printing out the Q&A +We could later retrieve this interaction by printing out the Q&A history as follows: print $term->history_as_string; @@ -614,7 +614,7 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut diff --git a/Master/tlpkg/tlperl/lib/Term/UI/History.pm b/Master/tlpkg/tlperl/lib/Term/UI/History.pm index 1d77c01c6f6..6da99ed5aaf 100644 --- a/Master/tlpkg/tlperl/lib/Term/UI/History.pm +++ b/Master/tlpkg/tlperl/lib/Term/UI/History.pm @@ -8,7 +8,7 @@ use base 'Log::Message::Simple'; =head1 NAME -Term::UI::History +Term::UI::History - history function =head1 SYNOPSIS @@ -37,8 +37,8 @@ manpage for additional functionality available via this package. =head2 history("message string" [,VERBOSE]) -Records a message on the stack, and prints it to C<STDOUT> -(or actually C<$HISTORY_FH>, see the C<GLOBAL VARIABLES> section +Records a message on the stack, and prints it to C<STDOUT> +(or actually C<$HISTORY_FH>, see the C<GLOBAL VARIABLES> section below), if the C<VERBOSE> option is true. The C<VERBOSE> option defaults to true. @@ -55,7 +55,7 @@ BEGIN { for my $func ( @EXPORT ) { no strict 'refs'; - + *$func = sub { my $msg = shift; $log->store( message => $msg, @@ -74,8 +74,10 @@ BEGIN { } -{ package Log::Message::Handlers; - +{ + package # hide this from PAUSE + Log::Message::Handlers; + sub history { my $self = shift; my $verbose = shift; |