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