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
12if ($ENV{AUTOMATED_TESTING}) {
13  print "1..0 # skip: \$ENV{AUTOMATED_TESTING} is TRUE\n";
14  exit;
15}
16
17if (!@ARGV) {
18  $term = new Term::ReadLine 'Simple Perl calc';
19} elsif (@ARGV == 2) {
20  open(IN,"<$ARGV[0]");
21  open(OUT,">$ARGV[1]");
22  $term = new Term::ReadLine 'Simple Perl calc', \*IN, \*OUT;
23} elsif ($ARGV[0] =~ m|^/dev|) {
24  open(IN,"<$ARGV[0]");
25  open(OUT,">$ARGV[0]");
26  $term = new Term::ReadLine 'Simple Perl calc', \*IN, \*OUT;
27} else {
28  $term = new Term::ReadLine 'Simple Perl calc', \*STDIN, \*STDOUT;
29  $no_print = $ARGV[0] eq '--no-print';
30}
31$prompt = "Enter arithmetic or Perl expression: ";
32$OUT = $term->OUT || STDOUT;
33%features = %{ $term->Features };
34if (%features) {
35  @f = %features;
36  print $OUT "Features present: @f\n";
37  #$term->ornaments(1) if $features{ornaments};
38} else {
39  print $OUT "No additional features present.\n";
40}
41print $OUT "Flipping rl_default_selected each line.\n";
42while ( defined ($_ = $term->readline($prompt, "exit")) ) {
43  $res = eval($_);
44  warn $@ if $@;
45  print $OUT $res, "\n" unless $@ or $no_print;
46  $term->addhistory($_) if /\S/ and !$features{autohistory};
47  $readline::rl_default_selected = !$readline::rl_default_selected;
48}
49