autotitle builds and installs. Various fixes.

[ian-dotfiles.git] / gpt

diff --git a/gpt b/gpt
index 7fca9c5f531695cc6e2ac5f961481eea753efcee..f16320caa464853689ee842154c95949592222ac 100755 (executable)
--- a/gpt
+++ b/gpt
@@ -17,14 +17,43 @@ package GenericPrepTemplate;
 use IO::Handle;
 use IO::File;
 
-open DEBUG, ">&4";
+open DEBUG, ">/dev/null" or die "gpt: /dev/null: $!\n";
 
-$fh= new IO::Handle;
-$fh->fdopen(fileno(STDIN),'r') or die;
-process_fh($fh,'<standard input>');
+while ($main::ARGV[0] =~ m/^-/) {
+    $_= shift @main::ARGV;
+    next if m/^--$/;
+    while (m/^-./) {
+       if (s/^-d/-/) {
+           open DEBUG, ">&2" or die "gpt: debug to stderr: $!\n";
+       } else {
+           die "gpt: unknown option \`$_'\n";
+       }
+    }
+}
+
+$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).'>';
+       process_file($main::ARGV[$i]);
+    }
+}
 close STDOUT or die "gpt: close stdout: $!\n";
 exit 0;
 
+sub process_file ($) {
+    my ($value) = @_;
+    $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': $!");
+}
+
 sub err ($) { die "gpt: $fn:$lno: $_[0]\n"; }
 
 sub add_perl ($) {
@@ -38,9 +67,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 +92,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 +123,36 @@ 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/[\)\}]/) {
+                   add_perl($op) if $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++;
@@ -111,6 +165,8 @@ sub process_input () {
                    } else {
                        $substr.= $esc;
                    }
+               } elsif ($op eq '#') {
+                   $l =~ s/^[^\n]*//; $l =~ s/^\n//;
                } else {
                    err("bad escape sequence \@\@$op in text part");
                }
@@ -122,6 +178,26 @@ sub process_input () {
     }
 }
 
+sub close_nesteds () {
+    my ($op);
+    while (@oplist) {
+       $op= $oplist[$#oplist];
+       if (@oplist & 1) {
+           err("unterminated \@\@?") if $op eq '?';
+           $l=' @@';
+       } else {
+           if ($op =~ y/({/)}/) {
+               $l= '@@'.$op;
+           } elsif ($op =~ m/^[;:]+/) {
+               $l= '@@;';
+           } else {
+               die "intern /@oplist/";
+           }
+       }
+       process_input();
+    }
+}
+
 sub process_fh ($$) {
     local ($fh,$fn) = @_;
     local ($l,$lno, @oplist,$substr,$expr,$to,$op);
@@ -131,7 +207,9 @@ sub process_fh ($$) {
        $lno= $.;
        process_input();
     }
+    
     die "gpt: $fn: read error: $!" if $fh->error;
+    close_nesteds();
 }
 
 sub output ($) {
@@ -150,5 +228,6 @@ sub process_i ($) {
     local ($outbuf, @oplist,$substr,$expr,$to,$op);
     $outbuf='';
     process_input();
+    close_nesteds();
     return $outbuf;
 }