1#! /usr/bin/perl -w 2# Give an argument to use stdin, stdout instead of console 3# If argument starts with /dev, use it as console 4# If argument is '--no-print', do not print the result. 5 6BEGIN{ $ENV{PERL_RL} = 'Perl' }; # Do not test TR::Gnu ! 7use Term::ReadLine; 8 9use Carp; 10$SIG{__WARN__} = sub { warn Carp::longmess(@_) }; 11 12my $ev; 13if ($ENV{$ev = 'AUTOMATED_TESTING'} or $ENV{$ev = 'PERL_MM_NONINTERACTIVE'}) { 14 print "1..0 # skip: \$ENV{$ev} is TRUE\n"; 15 exit; 16} 17 18if (!@ARGV) { 19 $term = new Term::ReadLine 'Simple Perl calc'; 20} elsif (@ARGV == 2) { 21 open(IN,"<$ARGV[0]"); 22 open(OUT,">$ARGV[1]"); 23 $term = new Term::ReadLine 'Simple Perl calc', \*IN, \*OUT; 24} elsif ($ARGV[0] =~ m|^/dev|) { 25 open(IN,"<$ARGV[0]"); 26 open(OUT,">$ARGV[0]"); 27 $term = new Term::ReadLine 'Simple Perl calc', \*IN, \*OUT; 28} else { 29 $term = new Term::ReadLine 'Simple Perl calc', \*STDIN, \*STDOUT; 30 $no_print = $ARGV[0] eq '--no-print'; 31} 32$prompt = "Enter arithmetic or Perl expression: "; 33if ((my $l = $ENV{PERL_RL_TEST_PROMPT_MINLEN} | 0) > length $prompt) { 34 $prompt =~ s/(?=:)/ ' ' x ($l - length $prompt)/e; 35} 36$OUT = $term->OUT || STDOUT; 37%features = %{ $term->Features }; 38if (%features) { 39 @f = %features; 40 print $OUT "Features present: @f\n"; 41 #$term->ornaments(1) if $features{ornaments}; 42} else { 43 print $OUT "No additional features present.\n"; 44} 45print $OUT "\n Flipping rl_default_selected each line.\n"; 46print $OUT <<EOP; 47 48 Hint: Entering the word 49 exit 50 would exit the test. ;-) (If feature 'preput' is present, 51 this word should be already entered.) 52 53EOP 54while ( defined ($_ = $term->readline($prompt, "exit")) ) { 55 $res = eval($_); 56 warn $@ if $@; 57 print $OUT $res, "\n" unless $@ or $no_print; 58 $term->addhistory($_) if /\S/ and !$features{autohistory}; 59 $readline::rl_default_selected = !$readline::rl_default_selected; 60} 61