diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/TermReadKey.java b/src/main/java/org/perlonjava/runtime/perlmodule/TermReadKey.java index 4988c951a..39ad90e56 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/TermReadKey.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/TermReadKey.java @@ -75,8 +75,8 @@ public static void initialize() { try { readkey.registerMethod("ReadMode", "readMode", "$;$"); - readkey.registerMethod("ReadKey", "readKey", ";$"); - readkey.registerMethod("ReadLine", "readLine", ";$"); + readkey.registerMethod("ReadKey", "readKey", ";$$"); // ReadKey([timeout [, $fh]]) + readkey.registerMethod("ReadLine", "readLine", ";$$"); // ReadLine([timeout [, $fh]]) readkey.registerMethod("GetTerminalSize", "getTerminalSize", ";$"); readkey.registerMethod("SetTerminalSize", "setTerminalSize", "$;$"); readkey.registerMethod("GetSpeed", "getSpeed", ";$"); diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/TermReadLine.java b/src/main/java/org/perlonjava/runtime/perlmodule/TermReadLine.java index 94e03df5b..c3b7f5707 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/TermReadLine.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/TermReadLine.java @@ -1,5 +1,7 @@ package org.perlonjava.runtime.perlmodule; +import org.perlonjava.runtime.mro.InheritanceResolver; +import org.perlonjava.runtime.operators.ModuleOperators; import org.perlonjava.runtime.operators.ReferenceOperators; import org.perlonjava.runtime.runtimetypes.*; @@ -29,9 +31,12 @@ public class TermReadLine extends PerlModuleBase { /** * Constructor initializes the module. + * We pass false for setInc so %INC is NOT pre-set at startup; the companion + * Perl file Term/ReadLine.pm (which defines Term::ReadLine::Stub and friends) + * is allowed to execute when `use Term::ReadLine` is called normally. */ public TermReadLine() { - super("Term::ReadLine"); + super("Term::ReadLine", false); this.history = new ArrayList<>(); this.minLine = 1; this.autoHistory = true; @@ -47,6 +52,8 @@ public TermReadLine(String appName, InputStream in, OutputStream out) { this.appName = appName; this.inputReader = new BufferedReader(new InputStreamReader(in != null ? in : System.in)); this.outputWriter = new PrintWriter(out != null ? out : System.out, true); + // Re-initialise attributes so appname is reflected correctly. + initializeAttributes(); } /** @@ -58,14 +65,19 @@ public static void initialize() { try { readline.registerMethod("new", "newReadLine", "$;$"); readline.registerMethod("ReadLine", "getReadLinePackage", ""); - readline.registerMethod("readline", "readLine", "$$"); + readline.registerMethod("readline", "readLine", "$;$$"); readline.registerMethod("addhistory", "addHistory", "$$"); + readline.registerMethod("AddHistory", "addHistory", "$$"); + readline.registerMethod("GetHistory", "getHistoryList", "$"); + readline.registerMethod("SetHistory", "setHistoryList", "$@"); readline.registerMethod("IN", "getInputHandle", "$"); readline.registerMethod("OUT", "getOutputHandle", "$"); readline.registerMethod("MinLine", "minLine", "$;$"); readline.registerMethod("findConsole", "findConsole", "$"); readline.registerMethod("Attribs", "getAttribs", "$"); readline.registerMethod("Features", "getFeatures", "$"); + readline.registerMethod("ornaments", "ornaments", "$;$"); + readline.registerMethod("newTTY", "newTTY", "$$$"); } catch (NoSuchMethodException e) { System.err.println("Warning: Missing Term::ReadLine method: " + e.getMessage()); } @@ -73,17 +85,52 @@ public static void initialize() { /** * Creates a new Term::ReadLine object. + * + * If $ENV{PERL_RL} contains "Perl" (case-insensitive) and the CPAN module + * Term::ReadLine::Perl is available, we delegate to it so the caller gets + * the full readline (history, key-bindings, completion) implementation. + * On any failure we fall back to the built-in Java implementation. */ public static RuntimeList newReadLine(RuntimeArray args, int ctx) { - String appName = args.size() > 0 ? args.get(0).toString() : "perl"; + // Check Perl-level %ENV (not the JVM environment, so BEGIN-block + // assignments like BEGIN{ $ENV{PERL_RL} = 'Perl' } are visible here). + String perlRL = GlobalVariable.getGlobalHash("main::ENV").get("PERL_RL").toString(); + if (!perlRL.isEmpty()) { + String which = perlRL.split("\\s+")[0]; + if (which.toLowerCase().contains("perl")) { + try { + // Make sure Term::ReadLine::Stub (defined in Term/ReadLine.pm) + // is available before loading the CPAN module. + ModuleOperators.require(new RuntimeScalar("Term/ReadLine.pm")); + // Load Term::ReadLine::Perl from ~/.perlonjava/lib (installed by jcpan). + ModuleOperators.require(new RuntimeScalar("Term/ReadLine/Perl.pm")); + // Find Term::ReadLine::Perl::new + RuntimeScalar newMethod = InheritanceResolver.findMethodInHierarchy( + "new", "Term::ReadLine::Perl", null, 0, false); + if (newMethod != null && newMethod.type == RuntimeScalarType.CODE) { + // Build the argument list: class name + caller's args (skip $self arg) + RuntimeArray newArgs = new RuntimeArray(); + RuntimeArray.push(newArgs, new RuntimeScalar("Term::ReadLine::Perl")); + for (int i = 1; i < args.size(); i++) { + RuntimeArray.push(newArgs, args.get(i)); + } + return RuntimeCode.apply(newMethod, newArgs, RuntimeContextType.LIST); + } + } catch (Exception e) { + // CPAN module not installed or failed to load – fall through to Java impl. + } + } + } + + String appName = args.size() > 1 ? args.get(1).toString() : "perl"; InputStream in = System.in; OutputStream out = System.out; - // Handle optional IN and OUT filehandles if provided - if (args.size() > 1 && args.get(1).getDefinedBoolean()) { + // Handle optional IN and OUT filehandles if provided (args.get(2) and args.get(3)) + if (args.size() > 2 && args.get(2).getDefinedBoolean()) { // TODO: Convert Perl filehandle to Java InputStream } - if (args.size() > 2 && args.get(2).getDefinedBoolean()) { + if (args.size() > 3 && args.get(3).getDefinedBoolean()) { // TODO: Convert Perl filehandle to Java OutputStream } @@ -110,16 +157,26 @@ public static RuntimeList getReadLinePackage(RuntimeArray args, int ctx) { /** * Gets an input line with readline support. Trailing newline is removed. * Returns undef on EOF. + * Optional second arg is the preput (default text); if the terminal is not + * interactive we cannot actually inject it, but we display it in the prompt + * so the user can see what the default is. */ public static RuntimeList readLine(RuntimeArray args, int ctx) { RuntimeHash termHash = args.get(0).hashDeref(); TermReadLine instance = (TermReadLine) termHash.get("_instance").value; String prompt = args.size() > 1 ? args.get(1).toString() : ""; + String preput = args.size() > 2 && args.get(2).getDefinedBoolean() ? args.get(2).toString() : null; try { + // Build the display prompt, appending preput hint when present + String displayPrompt = prompt; + if (preput != null && !preput.isEmpty()) { + displayPrompt = prompt + "[" + preput + "] "; + } + // Print prompt to STDOUT using RuntimeIO - if (!prompt.isEmpty()) { - RuntimeIO.stdout.write(prompt); + if (!displayPrompt.isEmpty()) { + RuntimeIO.stdout.write(displayPrompt); RuntimeIO.stdout.flush(); } @@ -131,6 +188,11 @@ public static RuntimeList readLine(RuntimeArray args, int ctx) { return new RuntimeList(scalarUndef); } + // When the user just presses Enter with no input, use preput as the value + if (line.isEmpty() && preput != null) { + line = preput; + } + // Auto-add to history if enabled and line meets criteria if (instance.autoHistory && line.trim().length() >= instance.minLine) { instance.addToHistory(line); @@ -267,6 +329,60 @@ public static RuntimeList getFeatures(RuntimeArray args, int ctx) { return new RuntimeList(featuresHash.createReference()); } + /** + * Returns the history list as a Perl list (GetHistory). + */ + public static RuntimeList getHistoryList(RuntimeArray args, int ctx) { + RuntimeHash termHash = args.get(0).hashDeref(); + TermReadLine instance = (TermReadLine) termHash.get("_instance").value; + RuntimeList result = new RuntimeList(); + for (String entry : instance.history) { + result.add(new RuntimeScalar(entry)); + } + return result; + } + + /** + * Replaces the history with the supplied list (SetHistory). + * Called as $term->SetHistory(@lines). + */ + public static RuntimeList setHistoryList(RuntimeArray args, int ctx) { + RuntimeHash termHash = args.get(0).hashDeref(); + TermReadLine instance = (TermReadLine) termHash.get("_instance").value; + instance.history.clear(); + // args.get(0) is $self; remaining elements are the new history entries + for (int i = 1; i < args.size(); i++) { + String entry = args.get(i).toString(); + if (!entry.isEmpty()) { + instance.history.add(entry); + } + } + return new RuntimeList(); + } + + /** + * ornaments() – controls terminal highlighting of the prompt/input line. + * The JVM does not have direct termcap access, so this is a no-op stub + * that keeps the interface contract without dying. + */ + public static RuntimeList ornaments(RuntimeArray args, int ctx) { + // No-op: return the current (empty) ornament string for compatibility + return new RuntimeList(new RuntimeScalar("")); + } + + /** + * newTTY($in, $out) – switches the readline object to use different + * input/output filehandles. + * Full stream-level switching is not supported on the JVM backend; this + * stub accepts the call without dying so code that calls newTTY continues + * to work (using the original stdin/stdout). + */ + public static RuntimeList newTTY(RuntimeArray args, int ctx) { + // No-op: JVM backend cannot rewire streams through Perl glob references. + // The method exists so that callers don't get "Can't locate object method". + return new RuntimeList(); + } + // Cross-platform console detection private static boolean isConsoleAvailable() { return System.console() != null; @@ -294,10 +410,14 @@ private void initializeFeatures() { features.put("appname", true); features.put("minline", true); features.put("autohistory", true); - features.put("addhistory", true); + features.put("addhistory", true); // lowercase alias kept for compatibility + features.put("addHistory", true); // canonical camelCase name features.put("attribs", true); features.put("setHistory", true); features.put("getHistory", true); + features.put("ornaments", true); // no-op stub present + features.put("newTTY", true); + features.put("preput", true); // readline($prompt, $preput) supported } private void addToHistory(String line) { diff --git a/src/main/perl/lib/Term/ReadLine.pm b/src/main/perl/lib/Term/ReadLine.pm new file mode 100644 index 000000000..78c1ebf5b --- /dev/null +++ b/src/main/perl/lib/Term/ReadLine.pm @@ -0,0 +1,487 @@ +=head1 NAME + +Term::ReadLine - Perl interface to various C packages. +If no real package is found, substitutes stubs instead of basic functions. + +=head1 SYNOPSIS + + use Term::ReadLine; + my $term = Term::ReadLine->new('Simple Perl calc'); + my $prompt = "Enter your arithmetic expression: "; + my $OUT = $term->OUT || \*STDOUT; + while ( defined ($_ = $term->readline($prompt)) ) { + my $res = eval($_); + warn $@ if $@; + print $OUT $res, "\n" unless $@; + $term->addhistory($_) if /\S/; + } + +=head1 DESCRIPTION + +This package is just a front end to some other packages. It's a stub to +set up a common interface to the various ReadLine implementations found on +CPAN (under the C namespace). + +=head1 Minimal set of supported functions + +All the supported functions should be called as methods, i.e., either as + + $term = Term::ReadLine->new('name'); + +or as + + $term->addhistory('row'); + +where $term is a return value of Term::ReadLine-Enew(). + +=over 12 + +=item C + +returns the actual package that executes the commands. Among possible +values are C, C, +C. + +=item C + +returns the handle for subsequent calls to following +functions. Argument is the name of the application. Optionally can be +followed by two arguments for C and C filehandles. These +arguments should be globs. + +=item C + +gets an input line, I with actual C +support. Trailing newline is removed. Returns C on C. + +=item C + +adds the line to the history of input, from where it can be used if +the actual C is present. + +=item C, C + +return the filehandles for input and output or C if C +input and output cannot be used for Perl. + +=item C + +If argument is specified, it is an advice on minimal size of line to +be included into history. C means do not include anything into +history. Returns the old value. + +=item C + +returns an array with two strings that give most appropriate names for +files for input and output using conventions C<"E$in">, C<"Eout">. + +The strings returned may not be useful for 3-argument open(). + +=item Attribs + +returns a reference to a hash which describes internal configuration +of the package. Names of keys in this hash conform to standard +conventions with the leading C stripped. + +=item C + +Returns a reference to a hash with keys being features present in +current implementation. Several optional features are used in the +minimal interface: C should be present if the first argument +to C is recognized, and C should be present if +C method is not dummy. C should be present if +lines are put into history automatically (maybe subject to +C), and C if C method is not dummy. + +If C method reports a feature C as present, the +method C is not dummy. + +=back + +=head1 Additional supported functions + +Actually C can use some other package, that will +support a richer set of commands. + +All these commands are callable via method interface and have names +which conform to standard conventions with the leading C stripped. + +The stub package included with the perl distribution allows some +additional methods: + +=over 12 + +=item C + +makes Tk event loop run when waiting for user input (i.e., during +C method). + +=item C + +Registers call-backs to wait for user input (i.e., during C +method). This supersedes 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-Ereadline. + +Deregistration is done in this case by calling event_loop with C +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 + +makes the command line stand out by using termcap data. The argument +to C should be 0, 1, or a string of a form +C<"aa,bb,cc,dd">. Four components of this string should be names of +I, first two will be issued to make the prompt +standout, last two to make the input line standout. + +=item C + +takes two arguments which are input filehandle and output filehandle. +Switches to use these filehandles. + +=back + +One can check whether the currently loaded ReadLine package supports +these methods by checking for corresponding C. + +=head1 EXPORTS + +None + +=head1 ENVIRONMENT + +The environment variable C governs which ReadLine clone is +loaded. If the value is false, a dummy interface is used. If the value +is true, it should be tail of the name of the package to use, such as +C or C. + +As a special case, if the value of this variable is space-separated, +the tail might be used to disable the ornaments by setting the tail to +be C or C. 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 sans ornaments + export "PERL_RL= o=0" # Use best available ReadLine sans ornaments + +(Note that processing of C for ornaments is in the discretion of the +particular used C package). + +=cut + +use strict; + +package Term::ReadLine::Stub; +our @ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap'; + +$DB::emacs = $DB::emacs; # To pacify -w +our @rl_term_set; +*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set; + +sub PERL_UNICODE_STDIN () { 0x0001 } + +sub ReadLine {'Term::ReadLine::Stub'} +sub readline { + my $self = shift; + my ($in,$out,$str) = @$self; + 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; + #$str = scalar <$in>; + $str = $self->get_line; + 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 creates length -1: + chomp $str if defined $str; + $str; +} +sub addhistory {} + +# used for testing purpose +sub devtty { return '/dev/tty' } + +sub findConsole { + my $console; + my $consoleOUT; + + my $devtty = devtty(); + + if ($^O ne 'MSWin32' and -e $devtty) { + $console = $devtty; + } elsif ($^O eq 'MSWin32' or $^O eq 'msys' or -e "con") { + $console = 'CONIN$'; + $consoleOUT = 'CONOUT$'; + } elsif ($^O eq 'VMS') { + $console = "sys\$command"; + } elsif ($^O eq 'os2' && !$DB::emacs) { + $console = "/dev/con"; + } else { + $console = undef; + } + + $consoleOUT = $console unless defined $consoleOUT; + $console = "&STDIN" unless defined $console; + if ($console eq $devtty && !open(my $fh, "<", $console)) { + $console = "&STDIN"; + undef($consoleOUT); + } + if (!defined $consoleOUT) { + $consoleOUT = defined fileno(STDERR) && $^O ne 'MSWin32' ? "&STDERR" : "&STDOUT"; + } + ($console,$consoleOUT); +} + +sub new { + die "method new called with wrong number of arguments" + unless @_==2 or @_==4; + #local (*FIN, *FOUT); + my ($FIN, $FOUT, $ret); + if (@_==2) { + my($console, $consoleOUT) = $_[0]->findConsole; + + # the Windows CONIN$ needs GENERIC_WRITE mode to allow + # a SetConsoleMode() if we end up using Term::ReadKey + open FIN, (( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? '+<' : '<' ), $console; + # RT #132008: Still need 2-arg open here + open FOUT,">$consoleOUT"; + + #OUT->autoflush(1); # Conflicts with debugger? + my $sel = select(FOUT); + $| = 1; # for DB::OUT + select($sel); + $ret = bless [\*FIN, \*FOUT]; + } else { # Filehandles supplied + $FIN = $_[2]; $FOUT = $_[3]; + #OUT->autoflush(1); # Conflicts with debugger? + my $sel = select($FOUT); + $| = 1; # for DB::OUT + select($sel); + $ret = bless [$FIN, $FOUT]; + } + if ($ret->Features->{ornaments} + and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) { + local $Term::ReadLine::termcap_nowarn = 1; + $ret->ornaments(1); + } + return $ret; +} + +sub newTTY { + my ($self, $in, $out) = @_; + $self->[0] = $in; + $self->[1] = $out; + my $sel = select($out); + $| = 1; # for DB::OUT + select($sel); +} + +sub IN { shift->[0] } +sub OUT { shift->[1] } +sub MinLine { undef } +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>; +#} + +package Term::ReadLine; # So late to allow the above code be defined? + +our $VERSION = '1.17'; + +my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef; +if ($which) { + if ($which =~ /\bgnu\b/i){ + eval "use Term::ReadLine::Gnu;"; + } elsif ($which =~ /\bperl\b/i) { + eval "use Term::ReadLine::Perl;"; + } elsif ($which =~ /^(Stub|TermCap|Tk)$/) { + # it is already in memory to avoid false exception as seen in: + # PERL_RL=Stub perl -e'$SIG{__DIE__} = sub { print @_ }; require Term::ReadLine' + } else { + eval "use Term::ReadLine::$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::EditLine; 1" or eval "use Term::ReadLine::Perl; 1"; +} + +#require FileHandle; + +# To make possible switch off RL in debugger: (Not needed, work done +# in debugger). +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"}) { + @ISA = "Term::ReadLine::$which"; +} else { + @ISA = qw(Term::ReadLine::Stub); +} + +package Term::ReadLine::TermCap; + +# Prompt-start, prompt-end, command-line-start, command-line-end +# -- zero-width beautifies to emit around prompt and the command line. +our @rl_term_set = ("","","",""); +# string encoded: +our $rl_term_set = ',,,'; + +our $terminal; +sub LoadTermCap { + return if defined $terminal; + + require Term::Cap; + $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning. +} + +sub ornaments { + shift; + return $rl_term_set unless @_; + $rl_term_set = shift; + $rl_term_set ||= ',,,'; + $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1'; + my @ts = split /,/, $rl_term_set, 4; + eval { LoadTermCap }; + unless (defined $terminal) { + warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn; + $rl_term_set = ',,,'; + return; + } + @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts; + return $rl_term_set; +} + + +package Term::ReadLine::Tk; + +# 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. + +my ($giveup); + +# 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; + 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 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; + my ($in,$out,$str) = @$self; + + if ($Term::ReadLine::toloop) { + $self->register_Tk if not $Term::ReadLine::registered; + $self->Tk_loop; + } + + local ($/) = "\n"; + $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 creates length -1: + chomp $str if defined $str; + + $str; +} + +1; +