chiark / gitweb /
conditionals
authorian <ian>
Wed, 18 Jul 2001 20:31:50 +0000 (20:31 +0000)
committerian <ian>
Wed, 18 Jul 2001 20:31:50 +0000 (20:31 +0000)
gpt

diff --git a/gpt b/gpt
index 7fca9c5..d87e789 100755 (executable)
--- a/gpt
+++ b/gpt
@@ -19,9 +19,22 @@ use IO::File;
 
 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;
 
@@ -38,9 +51,24 @@ sub add_text ($) {
     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";
@@ -48,26 +76,16 @@ sub process_input () {
            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);
                        }
@@ -89,16 +107,35 @@ sub process_input () {
            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++;