diff options
author | Karl Berry <karl@freefriends.org> | 2015-04-26 22:16:26 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2015-04-26 22:16:26 +0000 |
commit | 342e672574c4e67d510e46ab6acd0e21a7d0cf54 (patch) | |
tree | 79e04202d08c0404bbd780bd26c1e34710e539b6 /Master/tlpkg/tlperl/lib/Term | |
parent | be2706af7c57a0ef0f4d4e9f684ca4ef74922a82 (diff) |
(tl)perl 5.20.2 for windows, from siep
git-svn-id: svn://tug.org/texlive/trunk@37064 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Term')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Term/Cap.pm | 24 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Term/ReadLine.pm | 12 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Term/UI.pm | 627 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Term/UI/History.pm | 139 |
4 files changed, 23 insertions, 779 deletions
diff --git a/Master/tlpkg/tlperl/lib/Term/Cap.pm b/Master/tlpkg/tlperl/lib/Term/Cap.pm index 5430091efda..9a70251270d 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.13'; +$VERSION = '1.15'; # 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 @@ -59,7 +59,11 @@ $VERSION = '1.13'; # 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> -# +# Version 1.14 Sat Oct 26 19:16:38 BST 2013 +# Applied all patches from RT and updated contact details +# Version 1.15 Sat Oct 26 21:32:24 BST 2013 +# Metadata change from David Steinbrunner +# Forgot to update the email somewhere # TODO: # support Berkeley DB termcaps # force $FH into callers package? @@ -185,7 +189,7 @@ It takes a hash reference as an argument with two optional keys: The terminal output bit rate (often mistakenly called the baud rate) for this terminal - if not set a warning will be generated -and it will be defaulted to 9600. I<OSPEED> can be be specified as +and it will be defaulted to 9600. I<OSPEED> can be specified as either a POSIX termios/SYSV termio speeds (where 9600 equals 9600) or an old DSD-style speed ( where 13 equals 9600). @@ -245,7 +249,7 @@ sub Tgetent } else { - if ( $^O eq 'Win32' ) + if ( $^O eq 'MSWin32' ) { $self->{TERM} = 'dumb'; } @@ -298,6 +302,7 @@ sub Tgetent $entry = $tmp; } }; + warn "Can't run infocmp to get a termcap entry: $@" if $@; } else { @@ -478,7 +483,7 @@ It takes three arguments: The literal string to be output. If it starts with a number and an optional '*' then the padding will be increased by an amount relative to this number, -if the '*' is present then this amount will me multiplied by $cnt. This part +if the '*' is present then this amount will be multiplied by $cnt. This part of $string is removed before output/ =item B<$cnt> @@ -681,9 +686,9 @@ sub Tgoto elsif ( $code eq '>' ) { ( $code, $tmp, $string ) = unpack( "CCa99", $string ); - if ( $tmp[$[] > $code ) + if ( $tmp[0] > $code ) { - $tmp[$[] += $tmp; + $tmp[0] += $tmp; } } elsif ( $code eq '2' ) @@ -770,7 +775,10 @@ Please see the README file in distribution. =head1 AUTHOR This module is part of the core Perl distribution and is also maintained -for CPAN by Jonathan Stowe <jns@gellyfish.com>. +for CPAN by Jonathan Stowe <jns@gellyfish.co.uk>. + +The code is hosted on Github: https://github.com/jonathanstowe/Term-Cap +please feel free to fork, submit patches etc, etc there. =head1 SEE ALSO diff --git a/Master/tlpkg/tlperl/lib/Term/ReadLine.pm b/Master/tlpkg/tlperl/lib/Term/ReadLine.pm index 1aa19d397ec..80a0d4bac88 100644 --- a/Master/tlpkg/tlperl/lib/Term/ReadLine.pm +++ b/Master/tlpkg/tlperl/lib/Term/ReadLine.pm @@ -203,7 +203,7 @@ use strict; package Term::ReadLine::Stub; our @ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap'; -$DB::emacs = $DB::emacs; # To peacify -w +$DB::emacs = $DB::emacs; # To pacify -w our @rl_term_set; *rl_term_set = \@Term::ReadLine::TermCap::rl_term_set; @@ -223,7 +223,7 @@ sub readline { 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: + # bug in 5.000: chomping empty string creates length -1: chomp $str if defined $str; $str; } @@ -320,7 +320,7 @@ sub Features { \%features } package Term::ReadLine; # So late to allow the above code be defined? -our $VERSION = '1.12'; +our $VERSION = '1.14'; my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef; if ($which) { @@ -337,7 +337,7 @@ if ($which) { } elsif (defined $which and $which ne '') { # Defined but false # Do nothing fancy } else { - eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1"; + eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::EditLine; 1" or eval "use Term::ReadLine::Perl; 1"; } #require FileHandle; @@ -347,6 +347,8 @@ if ($which) { our @ISA; if (defined &Term::ReadLine::Gnu::readline) { @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub); +} elsif (defined &Term::ReadLine::EditLine::readline) { + @ISA = qw(Term::ReadLine::EditLine Term::ReadLine::Stub); } elsif (defined &Term::ReadLine::Perl::readline) { @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub); } elsif (defined $which && defined &{"Term::ReadLine::$which\::readline"}) { @@ -469,7 +471,7 @@ sub get_line { 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: + # bug in 5.000: chomping empty string creates length -1: chomp $str if defined $str; $str; diff --git a/Master/tlpkg/tlperl/lib/Term/UI.pm b/Master/tlpkg/tlperl/lib/Term/UI.pm deleted file mode 100644 index fb335272c07..00000000000 --- a/Master/tlpkg/tlperl/lib/Term/UI.pm +++ /dev/null @@ -1,627 +0,0 @@ -package Term::UI; - -use if $] > 5.017, 'deprecate'; - -use Carp; -use Params::Check qw[check allow]; -use Term::ReadLine; -use Locale::Maketext::Simple Style => 'gettext'; -use Term::UI::History; - -use strict; - -BEGIN { - use vars qw[$VERSION $AUTOREPLY $VERBOSE $INVALID]; - $VERBOSE = 1; - $VERSION = '0.34'; - $INVALID = loc('Invalid selection, please try again: '); -} - -push @Term::ReadLine::Stub::ISA, __PACKAGE__ - unless grep { $_ eq __PACKAGE__ } @Term::ReadLine::Stub::ISA; - - -=pod - -=head1 NAME - -Term::UI - Term::ReadLine UI made easy - -=head1 SYNOPSIS - - use Term::UI; - use Term::ReadLine; - - my $term = Term::ReadLine->new('brand'); - - my $reply = $term->get_reply( - prompt => 'What is your favourite colour?', - choices => [qw|blue red green|], - default => 'blue', - ); - - my $bool = $term->ask_yn( - prompt => 'Do you like cookies?', - default => 'y', - ); - - - my $string = q[some_command -option --no-foo --quux='this thing']; - - my ($options,$munged_input) = $term->parse_options($string); - - - ### don't have Term::UI issue warnings -- default is '1' - $Term::UI::VERBOSE = 0; - - ### 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; - -=head1 DESCRIPTION - -C<Term::UI> is a transparent way of eliminating the overhead of having -to format a question and then validate the reply, informing the user -if the answer was not proper and re-issuing the question. - -Simply give it the question you want to ask, optionally with choices -the user can pick from and a default and C<Term::UI> will DWYM. - -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<@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 -C<Term::UI::History> manpage or the C<SYNOPSIS> for details. - -=head1 METHODS - -=head2 $reply = $term->get_reply( prompt => 'question?', [choices => \@list, default => $list[0], multi => BOOL, print_me => "extra text to print & record", allow => $ref] ); - -C<get_reply> asks a user a question, and then returns the reply to the -caller. If the answer is invalid (more on that below), the question will -be reposed, until a satisfactory answer has been entered. - -You have the option of providing a list of choices the user can pick from -using the C<choices> argument. If the answer is not in the list of choices -presented, the question will be reposed. - -If you provide a C<default> answer, this will be returned when either -C<$AUTOREPLY> is set to true, (see the C<GLOBAL VARIABLES> section further -below), or when the user just hits C<enter>. - -You can indicate that the user is allowed to enter multiple answers by -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. - -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 -as the rest of the questions, so you can use this to keep track of a -full session of Q&A with the user, and retrieve it later using the -C<< Term::UI->history_as_string >> function. - -See the C<EXAMPLES> section for samples of how to use this function. - -=cut - -sub get_reply { - my $term = shift; - my %hash = @_; - - my $tmpl = { - default => { default => undef, strict_type => 1 }, - prompt => { default => '', strict_type => 1, required => 1 }, - choices => { default => [], strict_type => 1 }, - multi => { default => 0, allow => [0, 1] }, - allow => { default => qr/.*/ }, - print_me => { default => '', strict_type => 1 }, - }; - - my $args = check( $tmpl, \%hash, $VERBOSE ) - or ( carp( loc(q[Could not parse arguments]) ), return ); - - - ### 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}} ) { - my $i; - - 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}); - - ### create a "DIGIT> choice" type line - $args->{print_me} .= sprintf "\n%3s> %-s", $i, $choice; - } - - ### we listed some choices -- add another newline for - ### pretty printing - $args->{print_me} .= "\n" if $i; - - ### allowable answers are now equal to the choices listed - $args->{allow} = $args->{choices}; - - ### no choices, but a default? set 'prompt_add' to the default - ### to construct a 'foo? [DEFAULT]' type prompt - } elsif ( defined $args->{default} ) { - $prompt_add = $args->{default}; - } - - ### 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 -C<enter> or if C<$AUTOREPLY> is set to true. See the C<GLOBAL VARIABLES> -section further below. - -Also, 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 -as the rest of the questions, so you can use this to keep track of a -full session of Q&A with the user, and retrieve it later using the -C<< Term::UI->history_as_string >> function. - - -See the C<EXAMPLES> section for samples of how to use this function. - -=cut - -sub ask_yn { - my $term = shift; - my %hash = @_; - - my $tmpl = { - 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 }, - multi => { default => 0, no_override => 1 }, - choices => { default => [qw|y n|], no_override => 1 }, - allow => { default => [qr/^y(?:es)?$/i, qr/^n(?:o)?$/i], - no_override => 1 - }, - }; - - 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; - { my @list = @{$args->{choices}}; - if( defined $args->{default} ) { - - ### if you supplied the default as a boolean, rather than y/n - ### transform it to a y/n now - $args->{default} = $args->{default} =~ /\d/ - ? { 0 => 'n', 1 => 'y' }->{ $args->{default} } - : $args->{default}; - - @list = map { lc $args->{default} eq lc $_ - ? uc $args->{default} - : $_ - } @list; - } - - $prompt_add .= join("/", @list); - } - - my $rv = $term->_tt_readline( %$args, prompt_add => $prompt_add ); - - return $rv =~ /^y/i ? 1 : 0; -} - - - -sub _tt_readline { - my $term = shift; - my %hash = @_; - - local $Params::Check::VERBOSE = 0; # why is this? - local $| = 1; # print ASAP - - - my ($default, $prompt, $choices, $multi, $allow, $prompt_add, $print_me); - my $tmpl = { - default => { default => undef, strict_type => 1, - store => \$default }, - prompt => { default => '', strict_type => 1, required => 1, - store => \$prompt }, - choices => { default => [], strict_type => 1, - store => \$choices }, - multi => { default => 0, allow => [0, 1], store => \$multi }, - allow => { default => qr/.*/, store => \$allow, }, - prompt_add => { default => '', store => \$prompt_add }, - print_me => { default => '', store => \$print_me }, - }; - - check( $tmpl, \%hash, $VERBOSE ) or return; - - ### prompts for Term::ReadLine can't be longer than one line, or - ### it can display wonky on some terminals. - history( $print_me ) if $print_me; - - - if ($prompt_add) { - ### we might have to add a default value to the prompt, to - ### show the user what will be picked by default: - $prompt .= " [$prompt_add]: " ; - } - else { - $prompt .= " : "; - } - - - ### are we in autoreply mode? - if ($AUTOREPLY) { - - ### you used autoreply, but didnt provide a default! - carp loc( - q[You have '%1' set to true, but did not provide a default!], - '$AUTOREPLY' - ) if( !defined $default && $VERBOSE); - - ### print it out for visual feedback - history( join ' ', grep { defined } $prompt, $default ); - - ### and return the default - return $default; - } - - - ### 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; - - $term->addhistory( $answer ) if length $answer; - - ### add both prompt and answer to the history - history( "$prompt $answer", 0 ); - - ### if we're allowed to give multiple answers, split - ### the answer on whitespace - my @answers = $multi ? split(/\s+/, $answer) : $answer; - - ### the return value list - my @rv; - - if( @$choices ) { - - for my $answer (@answers) { - - ### a digit implies a multiple choice question, - ### a non-digit is an open answer - if( $answer =~ /\D/ ) { - push @rv, $answer if allow( $answer, $allow ); - } else { - - ### 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 ] - 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 { - push @rv, grep { allow( $_, $allow ) } - 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 - ### user do it again - if( (@rv != @answers) or - (scalar(@$choices) and not scalar(@answers)) - ) { - $prompt = $INVALID; - $prompt .= "[$prompt_add] " if $prompt_add; - redo LOOP; - - ### otherwise just return the answer, or answers, depending - ### on the multi setting - } else { - return $multi ? @rv : $rv[0]; - } - } -} - -=head2 ($opts, $munged) = $term->parse_options( STRING ); - -C<parse_options> will convert all options given from an input string -to a hash reference. If called in list context it will also return -the part of the input string that it found no options in. - -Consider this example: - - my $str = q[command --no-foo --baz --bar=0 --quux=bleh ] . - q[--option="some'thing" -one-dash -single=blah' arg]; - - my ($options,$munged) = $term->parse_options($str); - - ### $options would contain: ### - $options = { - 'foo' => 0, - 'bar' => 0, - 'one-dash' => 1, - 'baz' => 1, - 'quux' => 'bleh', - 'single' => 'blah\'', - 'option' => 'some\'thing' - }; - - ### and this is the munged version of the input string, - ### ie what's left of the input minus the options - $munged = 'command arg'; - -As you can see, you can either use a single or a double C<-> to -indicate an option. -If you prefix an option with C<no-> and do not give it a value, it -will be set to 0. -If it has no prefix and no value, it will be set to 1. -Otherwise, it will be set to its value. Note also that it can deal -fine with single/double quoting issues. - -=cut - -sub parse_options { - my $term = shift; - my $input = shift; - - my $return = {}; - - ### there's probably a more elegant way to do this... ### - while ( $input =~ s/(?:^|\s+)--?([-\w]+=("|').+?\2)(?=\Z|\s+)// or - $input =~ s/(?:^|\s+)--?([-\w]+=\S+)(?=\Z|\s+)// or - $input =~ s/(?:^|\s+)--?([-\w]+)(?=\Z|\s+)// - ) { - my $match = $1; - - if( $match =~ /^([-\w]+)=("|')(.+?)\2$/ ) { - $return->{$1} = $3; - - } elsif( $match =~ /^([-\w]+)=(\S+)$/ ) { - $return->{$1} = $2; - - } elsif( $match =~ /^no-?([-\w]+)$/i ) { - $return->{$1} = 0; - - } elsif ( $match =~ /^([-\w]+)$/ ) { - $return->{$1} = 1; - - } else { - carp(loc(q[I do not understand option "%1"\n], $match)) if $VERBOSE; - } - } - - return wantarray ? ($return,$input) : $return; -} - -=head2 $str = $term->history_as_string - -Convenience wrapper around C<< Term::UI::History->history_as_string >>. - -Consult the C<Term::UI::History> man page for details. - -=cut - -sub history_as_string { return Term::UI::History->history_as_string }; - -1; - -=head1 GLOBAL VARIABLES - -The behaviour of Term::UI can be altered by changing the following -global variables: - -=head2 $Term::UI::VERBOSE - -This controls whether Term::UI will issue warnings and explanations -as to why certain things may have failed. If you set it to 0, -Term::UI will not output any warnings. -The default is 1; - -=head2 $Term::UI::AUTOREPLY - -This will make every question be answered by the default, and warn if -there was no default provided. This is particularly useful if your -program is run in non-interactive mode. -The default is 0; - -=head2 $Term::UI::INVALID - -This holds the string that will be printed when the user makes an -invalid choice. -You can override this string from your program if you, for example, -wish to do localization. -The default is C<Invalid selection, please try again: > - -=head2 $Term::UI::History::HISTORY_FH - -This is the filehandle all the print statements from this module -are being sent to. Please consult the C<Term::UI::History> manpage -for details. - -This defaults to C<*STDOUT>. - -=head1 EXAMPLES - -=head2 Basic get_reply sample - - ### ask a user (with an open question) for their favourite colour - $reply = $term->get_reply( prompt => 'Your favourite colour? ); - -which would look like: - - Your favourite colour? - -and C<$reply> would hold the text the user typed. - -=head2 get_reply with choices - - ### now provide a list of choices, so the user has to pick one - $reply = $term->get_reply( - prompt => 'Your favourite colour?', - choices => [qw|red green blue|] ); - -which would look like: - - 1> red - 2> green - 3> blue - - 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 -list of choices. The string presented is held in the C<$Term::UI::INVALID> -variable (see the C<GLOBAL VARIABLES> section for details. - -=head2 get_reply with choices and default - - ### provide a sensible default option -- everyone loves blue! - $reply = $term->get_reply( - prompt => 'Your favourite colour?', - choices => [qw|red green blue|], - default => 'blue' ); - -which would look like: - - 1> red - 2> green - 3> blue - - 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 -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 - ### introduction text - @reply = $term->get_reply( - print_me => 'Tell us what colours you like', - prompt => 'Your favourite colours?', - choices => [qw|red green blue|], - multi => 1 ); - -which would look like: - - Tell us what colours you 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 - ### the answer matches the allow handler. - $reply = $term->get_reply( - prompt => "What is the magic number?", - allow => 42 ); - -Unless the user now enters C<42>, the question will be reposed over -and over again. You can use more sophisticated C<allow> handlers (even -subroutines can be used). The C<allow> handler is implemented using -C<Params::Check>'s C<allow> function. Check its manpage for details. - -=head2 an elaborate ask_yn sample - - ### ask a user if he likes cookies. Default to a sensible 'yes' - ### and inform him first what cookies are. - $bool = $term->ask_yn( prompt => 'Do you like cookies?', - default => 'y', - print_me => 'Cookies are LOVELY!!!' ); - -would print: - - Cookies are LOVELY!!! - 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 -return C<true>. Hitting 'n' would return C<false>) - -We could later retrieve this interaction by printing out the Q&A -history as follows: - - print $term->history_as_string; - -which would then print: - - Cookies are LOVELY!!! - Do you like cookies? [Y/n]: y - -There's a chance we're doing this non-interactively, because a console -is missing, the user indicated he just wanted the defaults, etc. - -In this case, simply setting C<$Term::UI::AUTOREPLY> to true, will -return from every question with the default answer set for the question. -Do note that if C<AUTOREPLY> is true, and no default is set, C<Term::UI> -will warn about this and return C<undef>. - -=head1 See Also - -C<Params::Check>, C<Term::ReadLine>, C<Term::UI::History> - -=head1 BUG REPORTS - -Please report bugs or other issues to E<lt>bug-term-ui@rt.cpan.org<gt>. - -=head1 AUTHOR - -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 -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 deleted file mode 100644 index 6da99ed5aaf..00000000000 --- a/Master/tlpkg/tlperl/lib/Term/UI/History.pm +++ /dev/null @@ -1,139 +0,0 @@ -package Term::UI::History; - -use strict; -use base 'Exporter'; -use base 'Log::Message::Simple'; - -=pod - -=head1 NAME - -Term::UI::History - history function - -=head1 SYNOPSIS - - use Term::UI::History qw[history]; - - history("Some message"); - - ### retrieve the history in printable form - $hist = Term::UI::History->history_as_string; - - ### redirect output - local $Term::UI::History::HISTORY_FH = \*STDERR; - -=head1 DESCRIPTION - -This module provides the C<history> function for C<Term::UI>, -printing and saving all the C<UI> interaction. - -Refer to the C<Term::UI> manpage for details on usage from -C<Term::UI>. - -This module subclasses C<Log::Message::Simple>. Refer to its -manpage for additional functionality available via this package. - -=head1 FUNCTIONS - -=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 -below), if the C<VERBOSE> option is true. - -The C<VERBOSE> option defaults to true. - -=cut - -BEGIN { - use Log::Message private => 0; - - use vars qw[ @EXPORT $HISTORY_FH ]; - @EXPORT = qw[ history ]; - my $log = new Log::Message; - $HISTORY_FH = \*STDOUT; - - for my $func ( @EXPORT ) { - no strict 'refs'; - - *$func = sub { my $msg = shift; - $log->store( - message => $msg, - tag => uc $func, - level => $func, - extra => [@_] - ); - }; - } - - sub history_as_string { - my $class = shift; - - return join $/, map { $_->message } __PACKAGE__->stack; - } -} - - -{ - package # hide this from PAUSE - Log::Message::Handlers; - - sub history { - my $self = shift; - my $verbose = shift; - $verbose = 1 unless defined $verbose; # default to true - - ### so you don't want us to print the msg? ### - return if defined $verbose && $verbose == 0; - - local $| = 1; - my $old_fh = select $Term::UI::History::HISTORY_FH; - - print $self->message . "\n"; - select $old_fh; - - return; - } -} - - -=head1 GLOBAL VARIABLES - -=over 4 - -=item $HISTORY_FH - -This is the filehandle all the messages sent to C<history()> are being -printed. This defaults to C<*STDOUT>. - -=back - -=head1 See Also - -C<Log::Message::Simple>, C<Term::UI> - -=head1 AUTHOR - -This module by -Jos Boumans E<lt>kane@cpan.orgE<gt>. - -=head1 COPYRIGHT - -This module is -copyright (c) 2005 Jos Boumans E<lt>kane@cpan.orgE<gt>. -All rights reserved. - -This library is free software; -you may redistribute and/or modify it under the same -terms as Perl itself. - -=cut - -1; - -# Local variables: -# c-indentation-style: bsd -# c-basic-offset: 4 -# indent-tabs-mode: nil -# End: -# vim: expandtab shiftwidth=4: |