open DEBUG, ">&4";
-$fh= new IO::Handle;
-$fh->fdopen(fileno(STDIN),'r') or die;
-process_fh($fh,'<standard input>');
+$fn= '<command line>';
+if (!@main::ARGV) {
+ $lno= '<empty>';
+ $fh= new IO::Handle;
+ $fh->fdopen(fileno(STDIN),'r') or err("fdopen stdin: $!");
+ process_fh($fh,'<standard input>');
+ $fh->close or err("close stdin: $!\n");
+} else {
+ for ($i=0; $i<@main::ARGV; $i++) {
+ $lno= '<arg#'.($i+1).'>';
+ $value= $main::ARGV[$i];
+ $fh= new IO::File $value,'r' or err("cannot open file \`$value': $!");
+ process_fh($fh,$value);
+ $fh->close or err("gpt: cannot close file \`$value': $!");
+ }
+}
close STDOUT or die "gpt: close stdout: $!\n";
exit 0;
if (@oplist) { $substr.=$str; }
else { output($str); }
}
-
+
+sub eval_expr () {
+ my ($value);
+ $@='';
+ print DEBUG "E $fn:$lno:e\`$expr'\n";
+ $value= do {
+ package main;
+ eval $GenericPrepTemplate::expr;
+ };
+ if (length $@) {
+ chomp $@; err("error: $@");
+ }
+ print DEBUG "E $fn:$lno:v\`$value'\n";
+ $value;
+}
+
sub process_input () {
- my ($esc,$top,$want,$fh,$value);
+ my ($esc,$top,$want,$fh,$value,$wasyes);
while (length $l) {
print DEBUG "L $fn:$lno:",join('',@oplist),
":`$l' e\`$expr' s\`$substr'\n";
if ($l =~ m/(.)\@\@/m || $l =~ m/^()\@\@/m) {
($to,$op,$esc,$l) = ($`,$1,$&,$');
add_perl($to);
- if ($op =~ m/[ 0-9a-zA-Z_\;\)\}]/ || $op eq '') {
+ if ($op =~ m/[ 0-9a-zA-Z_\;\)\}?]/ || $op eq '') {
$top= pop @oplist;
if (!@oplist) {
# And evaluate.
- $expr.= $op;
- $@='';
- print DEBUG "E $fn:$lno:e\`$expr'\n";
- $value= do {
- package main;
- eval $GenericPrepTemplate::expr;
- };
- if (length $@) {
- chomp $@; err("error: $@");
- }
- print DEBUG "E $fn:$lno:v\`$value'\n";
+ $expr.= $op unless $op =~ m/[?]/;
+ $value= eval_expr();
if ($top eq '<') {
- $fh= new IO::File $value,'r'
- or err("cannot open file \`$value': $!");
- process_fh($fh,$value);
- $fh->close;
+ process_file($value);
+ } elsif ($top eq '?') {
+ push @oplist, '?',':;'.!!$value;
} elsif ($top ne '-') {
output($value);
}
if ($l =~ m/\@\@(.|\n)/) {
($to,$op,$esc,$l) = ($`,$1,$&,$');
add_text($to);
- if ($op =~ m/[-< \$]/) {
+ if ($op =~ m/[-< \$?]/) {
$substr.= $esc if @oplist;
push @oplist, $op;
- } elsif ($op =~ m/[\)\}]/) {
+ } elsif ($op =~ m/[\)\}\;\:]/) {
err("unmatched closing \@\@$op") unless @oplist;
- my ($want);
- $want= $oplist[$#oplist] eq '(' ? ')' : '}';
- err("found \@\@$op but wanted \@\@$want")
- unless $want eq $op;
- pop @oplist;
+ $want= pop @oplist;
+ if ($want =~ y/({/)}/) {
+ $wasyes=-1;
+ err("found \@\@$op but wanted \@\@$want")
+ unless $want eq $op;
+ } elsif ($want =~ m/^([:;]+)(1?)$/) {
+ ($want,$wasyes)=($1,$2);
+ err("found \@\@$op where not expected (wanted ".
+ join(' or ', map { "\@\@$_" } split //, $want).")")
+ unless $op =~ m/^[$want]$/;
+ '?' eq pop @oplist or die;
+ if ($wasyes) {
+ local ($l) = ($substr);
+ local ($substr,$expr,$to,$op);
+ process_input();
+ };
+ $substr='';
+ $esc='';
+ if ($op eq ':') {
+ push @oplist, '?',';'.!$wasyes;
+ }
+ } else {
+ die "internal /$want/ /$op/";
+ }
if (@oplist==1) {
# Just finished a substr.
$substri++;