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