4 # =====deeper=nesting===>>
7 # \n@@ \_@@ ;@@ )@@ }@@ \w@@
8 # <------------------------------------
10 # ------------------------------------>
12 # @@? @@\_ ignore include
16 # | processing processing
17 # `---> as TEXT as PERL
19 # @@; vA <------------------------------------
23 # /\ included text fragment as
24 # else || string value code to write out
26 # || <------------------------------------
28 # ------------------------------------>
29 # end of included text fragment
32 # <<====deeper=nesting====
35 # gpt - a generic preprocessing tool
38 # Copyright (C) 2001 Ian Jackson <ian@davenant.greenend.org.uk>
40 # This program is free software; you can redistribute it and/or modify
41 # it under the terms of the GNU General Public License as published by
42 # the Free Software Foundation; either version 2, or (at your option)
45 # This program is distributed in the hope that it will be useful,
46 # but WITHOUT ANY WARRANTY; without even the implied warranty of
47 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
48 # GNU General Public License for more details.
50 # You should have received a copy of the GNU General Public License
51 # along with this program; if not, write to the Free Software Foundation,
52 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
54 package GenericPrepTemplate;
58 # use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
61 # @EXPORT= qw(&process_input);
71 open DEBUG, ">/dev/null" or die "gpt: /dev/null: $!\n";
73 while ($main::ARGV[0] =~ m/^-/) {
74 $_= shift @main::ARGV;
78 open DEBUG, ">&2" or die "gpt: debug to stderr: $!\n";
80 die "gpt: unknown option \`$_'\n";
85 $fn= '<command line>';
89 $fh->fdopen(fileno(STDIN),'r') or err("fdopen stdin: $!");
90 process_fh($fh,'<standard input>');
91 $fh->close or err("close stdin: $!\n");
93 for ($i=0; $i<@main::ARGV; $i++) {
94 $lno= '<arg#'.($i+1).'>';
95 process_file($main::ARGV[$i]);
98 close STDOUT or die "gpt: close stdout: $!\n";
101 sub process_file ($) {
103 $fh= new IO::File $value,'r' or err("cannot open file \`$value': $!");
104 process_fh($fh,$value);
105 $fh->close or err("gpt: cannot close file \`$value': $!");
108 sub err ($) { die "gpt: $fn:$lno: $_[0]\n"; }
112 if (@oplist>1) { $substr.= $str; }
113 else { $expr.= $str; }
118 if (@oplist) { $substr.=$str; }
119 else { output($str); }
125 print DEBUG "E $fn:$lno:e\`$expr'\n";
128 eval $GenericPrepTemplate::expr;
131 chomp $@; err("error: $@");
133 print DEBUG "E $fn:$lno:v\`$value'\n";
137 sub process_input () {
138 my ($esc,$top,$want,$fh,$value,$wasyes);
140 print DEBUG "L $fn:${lno}_",join('',@oplist),
141 "_`$l' e\`$expr' s\`$substr'\n";
142 if (@oplist & 1) { # scanning perl
143 if ($l =~ m/^()\@\@/ || $l =~ m/([^\000])\@\@/) {
144 ($to,$op,$esc,$l) = ($`,$1,$&,$');
146 if ($op =~ m/[ \t\n0-9a-zA-Z_\;\)\}?]/ || $op eq '') {
149 $op eq '?' or err("expected ?\@\@, got \@\@");
151 $op ne '?' or err("found ?\@\@ not after \@\@?");
155 $expr.= $op unless $op eq '?';
158 process_file($value);
159 } elsif ($top eq '?') {
160 push @oplist, '?',':;'.!!$value;
161 } elsif ($top ne '-') {
168 } elsif ($op =~ m/[\(\{]/) {
169 if (@oplist>1) { $substr.= $esc; }
172 err("bad escape sequence $op\@\@ in perl part");
178 } else { # scanning text
179 if ($l =~ m/\@\@(.|\n)/) {
180 ($to,$op,$esc,$l) = ($`,$1,$&,$');
182 if ($op =~ m/[-< \$?\n]/) {
184 add_perl($op) if $op =~ m/[\$]/;
189 } elsif ($op =~ m/[\)\}\;\:]/) {
190 err("unmatched closing \@\@$op") unless @oplist;
192 if ($want =~ y/({/)}/) {
194 err("found \@\@$op but wanted \@\@$want")
196 } elsif ($want =~ m/^([:;]+)(1?)$/) {
197 ($want,$wasyes)=($1,$2);
198 err("found \@\@$op where not expected (wanted ".
199 join(' or ', map { "\@\@$_" } split //, $want).")")
200 unless $op =~ m/^[$want]$/;
201 '?' eq pop @oplist or die;
203 local ($l) = ($substr);
204 local ($substr,$expr,$to,$op);
210 push @oplist, '?',';'.!$wasyes;
213 die "internal /$want/ /$op/";
216 # Just finished a substr.
218 $substrs[$substri]= $substr;
219 print DEBUG "S $fn:$lno:S$substri\`$substr'\n";
220 $expr.= ' GenericPrepTemplate::output(' if $op eq '}';
221 $expr.= " GenericPrepTemplate::process_i($substri) ";
222 $expr.= " );\n" if $op eq '}';
227 } elsif ($op eq '#') {
228 $l =~ s/^[^\n]*//; $l =~ s/^\n//;
230 err("bad escape sequence \@\@$op in text part");
240 sub close_nesteds () {
243 $op= $oplist[$#oplist];
245 err("unterminated \@\@?") if $op eq '?';
248 if ($op =~ y/({/)}/) {
250 } elsif ($op =~ m/^[;:]+/) {
253 die "intern /@oplist/";
260 sub process_fh ($$) {
261 local ($fh,$fn) = @_;
262 local ($l,$lno, @oplist,$substr,$expr,$to,$op);
264 while (defined ($l= $fh->getline)) {
265 next if $l =~ m,^\#\! ?/\S+/gpt\b, && $.==1;
270 die "gpt: $fn: read error: $!" if $fh->error;
275 if (defined $outbuf) {
276 print DEBUG "O \`$outbuf'+\`$_[0]'\n";
279 print DEBUG "O w\`$_[0]'\n";
280 print STDOUT $_[0] or err("write stdout: $!");
286 local ($l,$fn,$lno) = ($substrs[$i], "$fn<sub#$i>", '');
287 local ($outbuf, @oplist,$substr,$expr,$to,$op);