3 package GenericPrepTemplate;
7 # use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
10 # @EXPORT= qw(&process_input);
20 open DEBUG, ">/dev/null" or die "gpt: /dev/null: $!\n";
22 while ($main::ARGV[0] =~ m/^-/) {
23 $_= shift @main::ARGV;
27 open DEBUG, ">&2" or die "gpt: debug to stderr: $!\n";
29 die "gpt: unknown option \`$_'\n";
34 $fn= '<command line>';
38 $fh->fdopen(fileno(STDIN),'r') or err("fdopen stdin: $!");
39 process_fh($fh,'<standard input>');
40 $fh->close or err("close stdin: $!\n");
42 for ($i=0; $i<@main::ARGV; $i++) {
43 $lno= '<arg#'.($i+1).'>';
44 process_file($main::ARGV[$i]);
47 close STDOUT or die "gpt: close stdout: $!\n";
50 sub process_file ($) {
52 $fh= new IO::File $value,'r' or err("cannot open file \`$value': $!");
53 process_fh($fh,$value);
54 $fh->close or err("gpt: cannot close file \`$value': $!");
57 sub err ($) { die "gpt: $fn:$lno: $_[0]\n"; }
61 if (@oplist>1) { $substr.= $str; }
62 else { $expr.= $str; }
67 if (@oplist) { $substr.=$str; }
68 else { output($str); }
74 print DEBUG "E $fn:$lno:e\`$expr'\n";
77 eval $GenericPrepTemplate::expr;
80 chomp $@; err("error: $@");
82 print DEBUG "E $fn:$lno:v\`$value'\n";
86 sub process_input () {
87 my ($esc,$top,$want,$fh,$value,$wasyes);
89 print DEBUG "L $fn:$lno:",join('',@oplist),
90 ":`$l' e\`$expr' s\`$substr'\n";
91 if (@oplist & 1) { # scanning perl
92 if ($l =~ m/^()\@\@/ || $l =~ m/([^\000])\@\@/) {
93 ($to,$op,$esc,$l) = ($`,$1,$&,$');
95 if ($op =~ m/[ \t\n0-9a-zA-Z_\;\)\}?]/ || $op eq '') {
99 $expr.= $op unless $op =~ m/[?]/;
102 process_file($value);
103 } elsif ($top eq '?') {
104 push @oplist, '?',':;'.!!$value;
105 } elsif ($top ne '-') {
112 } elsif ($op =~ m/[\(\{]/) {
113 if (@oplist>1) { $substr.= $esc; }
116 err("bad escape sequence $op\@\@ in perl part");
122 } else { # scanning text
123 if ($l =~ m/\@\@(.|\n)/) {
124 ($to,$op,$esc,$l) = ($`,$1,$&,$');
126 if ($op =~ m/[-< \$?]/) {
127 $substr.= $esc if @oplist;
129 add_perl($op) if $op =~ m/[\$]/;
130 } elsif ($op =~ m/[\)\}\;\:]/) {
131 err("unmatched closing \@\@$op") unless @oplist;
133 if ($want =~ y/({/)}/) {
135 err("found \@\@$op but wanted \@\@$want")
137 } elsif ($want =~ m/^([:;]+)(1?)$/) {
138 ($want,$wasyes)=($1,$2);
139 err("found \@\@$op where not expected (wanted ".
140 join(' or ', map { "\@\@$_" } split //, $want).")")
141 unless $op =~ m/^[$want]$/;
142 '?' eq pop @oplist or die;
144 local ($l) = ($substr);
145 local ($substr,$expr,$to,$op);
151 push @oplist, '?',';'.!$wasyes;
154 die "internal /$want/ /$op/";
157 # Just finished a substr.
159 $substrs[$substri]= $substr;
160 print DEBUG "S $fn:$lno:S$substri\`$substr'\n";
161 $expr.= ' GenericPrepTemplate::output(' if $op eq '}';
162 $expr.= " GenericPrepTemplate::process_i($substri) ";
163 $expr.= " );\n" if $op eq '}';
168 } elsif ($op eq '#') {
169 $l =~ s/^[^\n]*//; $l =~ s/^\n//;
171 err("bad escape sequence \@\@$op in text part");
181 sub close_nesteds () {
184 $op= $oplist[$#oplist];
186 err("unterminated \@\@?") if $op eq '?';
189 if ($op =~ y/({/)}/) {
191 } elsif ($op =~ m/^[;:]+/) {
194 die "intern /@oplist/";
201 sub process_fh ($$) {
202 local ($fh,$fn) = @_;
203 local ($l,$lno, @oplist,$substr,$expr,$to,$op);
205 while (defined ($l= $fh->getline)) {
206 next if $l =~ m,^\#\! ?/\S+/gpt\b, && $.==1;
211 die "gpt: $fn: read error: $!" if $fh->error;
216 if (defined $outbuf) {
217 print DEBUG "O \`$outbuf'+\`$_[0]'\n";
220 print DEBUG "O w\`$_[0]'\n";
221 print STDOUT $_[0] or err("write stdout: $!");
227 local ($l,$fn,$lno) = ($substrs[$i], "$fn<sub#$i>", '');
228 local ($outbuf, @oplist,$substr,$expr,$to,$op);