#!/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 <ian@davenant.greenend.org.uk>
+#
+# 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 {
open DEBUG, ">/dev/null" or die "gpt: /dev/null: $!\n";
-while (@main::ARGV =~ m/^-/) {
+while ($main::ARGV[0] =~ m/^-/) {
$_= shift @main::ARGV;
next if m/^--$/;
while (m/^-./) {
} 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 ($) {
sub process_input () {
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 unless $op =~ m/[?]/;
+ $expr.= $op unless $op eq '?';
$value= eval_expr();
if ($top eq '<') {
process_file($value);
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/[\)\}\;\:]/) {
err("unmatched closing \@\@$op") unless @oplist;
} else {
$substr.= $esc;
}
+ } elsif ($op eq '#') {
+ $l =~ s/^[^\n]*//; $l =~ s/^\n//;
} else {
err("bad escape sequence \@\@$op in text part");
}
}
}
+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);
$lno= $.;
process_input();
}
+
die "gpt: $fn: read error: $!" if $fh->error;
+ close_nesteds();
}
sub output ($) {
local ($outbuf, @oplist,$substr,$expr,$to,$op);
$outbuf='';
process_input();
+ close_nesteds();
return $outbuf;
}