X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=ian-dotfiles.git;a=blobdiff_plain;f=gpt;h=6bb3a4ea7ac11519531373ad72368d72d6f14b16;hp=7fca9c5f531695cc6e2ac5f961481eea753efcee;hb=8ca1ad00ce51b96b86238efb2fbbc98da4ef63f6;hpb=d0a23a28764f62522461516baf582705c21bb007 diff --git a/gpt b/gpt index 7fca9c5..6bb3a4e 100755 --- a/gpt +++ b/gpt @@ -1,5 +1,56 @@ #!/usr/bin/perl +# +# =====deeper=nesting===>> +# +# end of Perl fragment +# \n@@ \_@@ ;@@ )@@ }@@ \w@@ +# <------------------------------------ +# +# ------------------------------------> +# if eval eval+ eval+ +# @@? @@\_ ignore include +# @@$ @@- file +# ___ @@\n @@< +# ,' ` +# | processing processing +# `---> as TEXT as PERL +# endif +# @@; vA <------------------------------------ +# || then +# comment || ?@@ +# @@# || +# || included text fragment as +# else || string value code to write out +# @@: || (@@ {@@ +# || <------------------------------------ +# `' +# ------------------------------------> +# end of included text fragment +# @@) @@} +# +# <<====deeper=nesting==== +# + +# gpt - a generic preprocessing tool +# +# This file is +# Copyright (C) 2001 Ian Jackson +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + package GenericPrepTemplate; #BEGIN { @@ -17,14 +68,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,''); +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= ''; +if (!@main::ARGV) { + $lno= ''; + $fh= new IO::Handle; + $fh->fdopen(fileno(STDIN),'r') or err("fdopen stdin: $!"); + process_fh($fh,''); + $fh->close or err("close stdin: $!\n"); +} else { + for ($i=0; $i<@main::ARGV; $i++) { + $lno= ''; + 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,36 +118,46 @@ 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"; + print DEBUG "L $fn:${lno}_",join('',@oplist), + "_`$l' e\`$expr' s\`$substr'\n"; if (@oplist & 1) { # scanning perl - if ($l =~ m/(.)\@\@/m || $l =~ m/^()\@\@/m) { + if ($l =~ m/^()\@\@/ || $l =~ m/([^\000])\@\@/) { ($to,$op,$esc,$l) = ($`,$1,$&,$'); add_perl($to); - if ($op =~ m/[ 0-9a-zA-Z_\;\)\}]/ || $op eq '') { + if ($op =~ m/[ \t\n0-9a-zA-Z_\;\)\}?]/ || $op eq '') { $top= pop @oplist; + if ($top eq '?') { + $op eq '?' or err("expected ?\@\@, got \@\@"); + } else { + $op ne '?' or err("found ?\@\@ not after \@\@?"); + } 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 eq '?'; + $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 +179,39 @@ sub process_input () { if ($l =~ m/\@\@(.|\n)/) { ($to,$op,$esc,$l) = ($`,$1,$&,$'); add_text($to); - if ($op =~ m/[-< \$]/) { - $substr.= $esc if @oplist; + if ($op =~ m/[-< \$?\n]/) { + if (!@oplist) { + add_perl($op) if $op =~ m/[\$]/; + } else { + $substr.= $esc; + } 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++; @@ -111,6 +224,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 +237,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 +266,9 @@ sub process_fh ($$) { $lno= $.; process_input(); } + die "gpt: $fn: read error: $!" if $fh->error; + close_nesteds(); } sub output ($) { @@ -150,5 +287,6 @@ sub process_i ($) { local ($outbuf, @oplist,$substr,$expr,$to,$op); $outbuf=''; process_input(); + close_nesteds(); return $outbuf; }