chiark / gitweb /
remoteshell as found on jura
[ian-dotfiles.git] / gpt
diff --git a/gpt b/gpt
index d87e7891c03d651fd00c8eecab3d6ad39a71eb0d..f16320caa464853689ee842154c95949592222ac 100755 (executable)
--- a/gpt
+++ b/gpt
@@ -17,7 +17,19 @@ package GenericPrepTemplate;
 use IO::Handle;
 use IO::File;
 
-open DEBUG, ">&4";
+open DEBUG, ">/dev/null" or die "gpt: /dev/null: $!\n";
+
+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) {
@@ -29,15 +41,19 @@ if (!@main::ARGV) {
 } 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': $!");
+       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 ($) {
@@ -110,6 +126,7 @@ sub process_input () {
                if ($op =~ m/[-< \$?]/) {
                    $substr.= $esc if @oplist;
                    push @oplist, $op;
+                   add_perl($op) if $op =~ m/[\$]/;
                } elsif ($op =~ m/[\)\}\;\:]/) {
                    err("unmatched closing \@\@$op") unless @oplist;
                    $want= pop @oplist;
@@ -148,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");
                }
@@ -159,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);
@@ -168,7 +207,9 @@ sub process_fh ($$) {
        $lno= $.;
        process_input();
     }
+    
     die "gpt: $fn: read error: $!" if $fh->error;
+    close_nesteds();
 }
 
 sub output ($) {
@@ -187,5 +228,6 @@ sub process_i ($) {
     local ($outbuf, @oplist,$substr,$expr,$to,$op);
     $outbuf='';
     process_input();
+    close_nesteds();
     return $outbuf;
 }