#!/bin/sh -- # A comment mentioning perl, to prevent perl from looping. Indented to work with bash.
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;

$Perl = '#!/usr/bin/perl';

chop($program = `basename $0`);	# get program name, usually "fixer"

&initialize_global_variables();

# Make Usage statement:

$version_num = '1.1';
$Version = "$program:              Version $version_num Copyright (c) 1994,1996 Karl J. Runge";

$Usage = <<"EOQ";

$Version
    A script to:
	1) Grab word/variable values from files to insert into Formats.
	2) Print out lines matching a given Pattern.
	3) Remove and/or Substitute given strings from output. 
	4) Print out lines occurring in the Section between given strings.
	5) Print out the N-line Section occurring after a given string.
	6) Do items 1-3 inside a Section specified by 4 & 5.

Usage: $program [<options>] file1 file2 ... fileN

    or if files match a shell wildcard, e.g.,:
	$program [<options>] file*

Options:
	-t <file>	Use "file" as template for searches.

	-o <file>	Write output to "file" instead of standard output.
	-overwrite	Overwrite each input file with its associated output.
			Input file is backed up to "file.bak".
	-noback		Do not backup if overwriting.
	-ext<.xxx>	Place output of file1 in "file1.xxx", etc.

	-help		Print out this info.
	-info -syntax	Print out info on template file syntax.
	-d		Debug mode on.
	-q		Be quiet, don''t print information messages to STDERR.

	-b<n>		Print <n> blank lines after each file. -b => one blank.
	-m <msg>	Print "msg" after each file processed.

	-f <filter %s>	Pass each file thru program <filter> before processing.
			The string "%s" will be expanded to the filename.

	-c		"Compile" the template into an "inline" perl script,
			then exit w/o doing any runs.

Use of standard input:
	The filename "-" means the data file is coming from stdin:
        cat file1 | $program -t template -

	(no filenames is equivalent to the above)

Compressed data:
	Files ending in ".gz" or ".Z" are automatically decompressed
	during reading. (see also -f above)

$Compression_Usage

--------------------------------------------------------------------
Example template:

$Example

--------------------------------------------------------------------
Do "$program -info" for more information on the format of the template.

EOQ

$TODO = <<'EOQ';	# this is the TODO comment

ItemOrder = 'file' not implemented.
better protection defaults?
catf stuff. (__NEW_FILE <filename> leader)
AFTER-N-LINES
If no match to %x=% use Section Zero??
Allow \]''s inside %Eval[`echo [abc\]`] 
Should still double check if last char is newline in `cmd` chopping.
What else in %Eval[] needs newline trimming?


EOQ


$Syntax = <<"EOQ";	# make string for "$program -info" or -syntax

============== Syntax for the -t <file> Template file: =====================

# A comment, "#" must be first non-white character in a line.

Keywords:
---------

%Format, %EndFormat

%Search

%Section, %EndSection

%Grep, %Delete, %Sub

%Eval

Keywords are also case insensitive. e.g. %Format == %format, etc.

Except for %Eval, a Keyword must be the first non-white characters of a line.

-----------------------------------------------------------------------------
The template file is a schematic model or picture of how the output will
appear.  The main components are Sections and Formats.

The idea of $program is to break up the input file into "Sections", defined
by line pattern matches.  These Sections are printed to the output.  Any
number may be defined in the template.  Section matches to the actual input
may happen 0, 1, or more times.  Further selection and transformation of
the data inside a given Section may be prescribed (using %Grep, %Delete, %Sub)

To aid in documenting the output, text regions called "Formats" may be
placed all around the Section outputs.  The simplest Format would be a
header.  Strings surrounded by %''s in Format are expanded to data words
found in the input file. Output of commands may be substituted with %Eval.

-----------------------------------------------------------------------------
Here is a real example:
$Example
-----------------------------------------------------------------------------
Here is a rundown of each Keyword:
----------------------------------
%Format
<text>
%EndFormat

  The <text> in format will be printed to the output after the input file
  has been processed. Any number of %Format's may be spread over the template
  file. Their order of occurence and placement is preserved.
  
  If <text> has an occurrence like %time=% (the "=" is not needed) in it,
  then while the input file is being processed if a line 
  matching "time= <someword>" is found the "<someword>" is stored
  and *replaces* %time=% in the output. As many %...% variables may
  be defined as one likes.
  
  The special case %_file_% is expanded to be the current file being processed.

  If you need a real % inside the Format text use \\%
  
  %Eval[...] is expanded (at end of the run, and after %...% variables are
  expanded) to the results of running the command inside the [...]. To
  access UNIX utilities use %Eval[`cmd`]. Any perl command may be inside [...]
  Mathematical expressions may be computed via %Eval[...] 

  E.g. %Eval[%time=% * 60] 
       %Eval[`whoami`]
       %Eval[\$ENV{'PWD'}]

----------------------------------
%Section: /regexp1/
<%commands>
%EndSection: /regexp2/

  A Section of the input file is defined here to start with a line matching
  /regexp1/ and to end with the next line matching /regexp2/
  
  The additional <%commands> are optional. They may be %Formats or others
  (specifically, %Grep, %Delete, %Sub)
  
  To exclude the line matching /regexp1/ from the outputted Section, use:
  
  %Section(exclude): /regexp1/
  etc...
  
  "exclude" is case insensitive, and may be abbreviated to "x" or "e".
  
  %EndSection(exclude): /regexp2/  does the similar thing for the last line.
  
  To protect meta characters in the regular expressions (e.g. '(' or '+') use:
  
  %Section(protect): /regexp1/
  
  "protect" is case insensitive, and may be abbreviated to "p". Protect 
  them yourself with '\\'s if you prefer.
  
  Any number of %Formats may be placed inside a %Section template.  The
  "%...%" variables in these Formats are looked for only *inside* the
  found Section text. (to be generalized later)
  
----------------------------------
%Search  %<string1>%  %<string2>%   ...

  The %Search keyword says to search for words as in %Format using the %
  delimiters (e.g.  %foo%). The found words can be used then for expansion
  inside ANY %Section.  Thus variables found outside a Section and be used
  in the Section''s Formats.   One is allowed to place a %Search inside a
  %Section, but it doesn''t make much sense at present.

----------------------------------
%Grep: /regexp/
  Print lines matching /regexp/. If outside a %Section then it is for the
  whole file. If inside a %Section only matching Section lines make it out.
  /regexp/ may be protected via %Grep(protect): /regexp/ as for %Section.

----------------------------------
%Delete: /regexp/
  Do Not Print lines matching /regexp/. If outside a %Section then it is
  for the whole file.  If inside a %Section then those lines are excluded
  from the Section text.. /regexp/ may be protected via %Delete(protect):
  as above.

----------------------------------
%Sub: /from/to/
  Transform outputted text via regexp /from/to/. If outside a %Section
  then it is for the whole file (but only for that which is outputted). If
  inside a %Section then only those lines inside the Section are
  transformed.
  
  /from/to/ may be NOT protected via %Sub(protect):. You must protect it
  explicitly with '\\'s.



----------------------------------
Miscellaneous:

 %Eval:

  If you need a real ] inside the %Eval's []''s in the cmd use \\]

  A perl subroutine &sub() is provided so one may do easy regsubs, e.g.:

	%Eval[&sub('%foo%','/A/a/g')];

  that is, the word-search value found for "%foo%" will be have all the
  A's replaced by a's.

 %Format:

  Any line in a format beginning with "_EXCLUDE_" (no leading white-space)
  will not be printed in the output. This is how %Search is implemented (see
  above). This is not very useful, but some tricks can be concocted from it.

EOQ

LOOP:			# process command line arguments...
while (@ARGV) {
    $_ = shift;
    CASE: {
	/^-h.*/ && ( (&help()), exit 0, last CASE);
	/^-info.*|^-syn.*/ && ( (&info), exit 0, last CASE);
	/^-d$/ && ( $Debug = 'True', last CASE);
	/^-over.*/ && ( $Overwrite = 'True', last CASE);
	/^-noback.*/ && ( $Backup = '', last CASE);
	/^-t$/ && ( $Template = shift, last CASE);
	/^-f$/ && ( $Filter = shift, last CASE);
	/^-q$/ && ( $Quiet = 'True', last CASE);
	/^-c$/ && ( $Compile_Only = 'True', last CASE);
	/^-$/ && ( $DataStdin = 'True', last CASE);
	/^-o$/ && ( $OutFile = shift, last CASE);
	/^-ext(\S*)$/ && ( $Extension = "X$1", last CASE);
	/^-b(\d*)$/ && ( $Blank = "X$1", last CASE);
	/^-m$/ && ( $Message = shift, last CASE);
	/^-todo$/ && ( (print STDERR "\n$TODO"), exit 1, last CASE);
	/^--$/ && (last LOOP);	# -- means end of switches
	/^-(-.*)$/ && (unshift(ARGV, $1), last CASE);
	if ( /^-(..+)$/ ) {	# split bundled switches:
		local($y, $x) = ($1, '');
		foreach $x (reverse(split(//, $y))) { unshift(ARGV,"-$x") };
		last CASE;
	}
	/^-.+/ && ( (print STDERR "\n$program: $_ not an option! try: $program -help and $program -info\n\n"), exit 1, last CASE);
	unshift(@ARGV,$_);
	last LOOP;
    }
}

# Check if output file(s) situation:
if ( $Extension =~ /^X(\S*)$/ )  {
	if ( "$1" eq "" ) {
		$Extension = ".out";
	} else {
		$Extension = "$1";
	}
	if ( $OutFile ne "STDOUT" ) {
		print STDERR "$program: \"-ext\" option overriding \"-o <file>\"\n" unless $Quiet;
		$OutFile = "STDOUT";
	}
	if ( $Overwrite ) {
		print STDERR "$program: \"-ext\" option overriding \"-overwrite\"\n" unless $Quiet;
		$Overwrite = '';
	}
}
if ( $Blank =~ /^X(\S*)$/ )  {
	if ( "$1" eq "" ) {
		$Blank = "\n";
	} else {
		$num = "$1";
		$Blank = "\n" x $num;
	}
}

if ( $Message ne '' ) {
	$Blank = $Message."\n".$Blank;
}

if ( $Overwrite && $OutFile ne "STDOUT" )  {
	print STDERR "$program: \"-o <file>\" option overriding \"-overwrite\"\n" unless $Quiet;
	$Overwrite = '';
}

# Check if too much coming from stdin:
if ( $Template eq "-" ) {
	print STDERR "\n$program: template file cannot be STDIN. Use -t <file>\n\n";
	exit 1;
}

if ( ! $Template ) {
	print STDERR "\n$program: Sorry, you must use input search template external to script\n\n";
	exit 1;
}

&parse_template($Template);


&make_fixer_engine();
select STDOUT; $| = 1;

@File_List = @ARGV;
&loop_over_input_files();

exit 0;

sub loop_over_input_files {

    foreach $file (@File_List) {		# for each file...

	$ThisFile = $file;
	$File_To_Read = $ThisFile;
	$process_then_move_to = '';

	if ( $ThisFile eq '-' ) {
		$ENV{'FIXER_CURRENT_FILE'} = "STDIN";
	} else {
		$ENV{'FIXER_CURRENT_FILE'} = $ThisFile;
	}

	$Compress_Suffix = '';
	foreach $suffix (sort(keys(%Decompress))) {
		local($regex) = $suffix.'$';
		if ( $ThisFile =~ /$regex/ ) {
			$Compress_Suffix = $suffix;
			last;
		}
	}

	if ( $OutFile eq $ThisFile ) {
		$process_then_move_to = $ThisFile;
		$OutFile = $TmpFile;

	} elsif ( $Overwrite && $ThisFile ne "-" ) {	# setup for overwriting.
		&msg("Doing $ThisFile ") unless $Quiet;
		if ( $Backup ) {
			$fileback = "$ThisFile"."$Backup";
			system "cp $ThisFile $fileback";	# cp -p would be better
			$File_To_Read = $fileback;
			$OutFile = $ThisFile;
			&msg("  (backed up to $fileback)\n") unless $Quiet;
		} else {
			$process_then_move_to = $ThisFile;
			$OutFile = $TmpFile;
		}
	} elsif ( $Extension && $ThisFile ne "-" ) {	# setup for writing to file.ext
		$OutFile = $ThisFile;
		if ( $Compress_Suffix ) {
			local($regex) = $Compress_Suffix.'$';
			$OutFile =~ s/$regex//;
		}
		$OutFile .= "$Extension";
		&msg("$ThisFile -> $OutFile\n") unless $Quiet;
	}

	$cmd = '';
	if ( $Filter ) {
		$cmd = $Filter;
		$cmd =~ s/%s/$File_To_Read/g;
		&msg("(Filtering input via: $cmd)\n") unless $Quiet;
	} else {
		$decompress = '';
		foreach $suffix (sort(keys(%Decompress))) {
			local($regex) = $suffix.'$';
			if ( $ThisFile =~ /$regex/ ) {
				$decompress = $Decompress{$suffix};
				$decompress =~ s/%s/$File_To_Read/g;
				last;
			}
		}
		if ( $decompress ne '' ) {
			&msg("(Decompressing via: $decompress)\n") unless $Quiet;
			$cmd = $decompress;
		} else {
			$cmd = "cat $File_To_Read";
		}
	}

	if ( $OutFile eq '-' || $OutFile =~ /stdout/i ) {
		system("$cmd | $Engine");
	} else {
		system("$cmd | $Engine > $OutFile");
	}

	if ( $process_then_move_to ) {
		system("mv $OutFile $process_then_move_to");
	}

	if ( $Blank ne '' ) {
		print STDOUT $Blank;
	}
    }

    # Done, remove "engine"
    unlink("$Engine");
	
}

sub help {
	local($data) = @_;
	$data = $Usage if $data eq '';

	if ( $ENV{'PAGER'} ne '' && open(PAGER, "|$ENV{'PAGER'}") ) {		
		# open pipeline to user's pager
		print PAGER "$data";
		close(PAGER);
	} elsif ( open(MORE, "|more") ) {	# open pipeline to "more"
		print MORE "$data";
		close(MORE);
	} else {
		print STDERR "$data";
	}
}

sub info {
	&help($Syntax);
}

sub initialize_global_variables {
	
	$Overwrite = '';
	$Backup = '.bak';
	$Extension = '';
	$Template = '';
	$OutFile = "STDOUT";
	$DataStdin = '';
	$Blank = ''; 
	$Message = ''; 

	$Compile_Only = '';
	$Debug = '';

	$Engine = "/tmp/${program}_engine$$";
#	$Engine = "./engine";
	$TmpFile = "/tmp/${program}_tmp$$";

	$Decompress{'\.Z'} = 'zcat %s';
	$Decompress{'\.gz'} = 'gzip -dc %s';
	$Compress_Suffix = '';

	$Compression_Usage = "\t\tSuffix:\t   \tDecompression cmd:\n";

	local($key, $suff);
	foreach $key (sort(keys(%Decompress))) {
		$suff = $key; 
		$suff =~ s/\\//g;
		$Compression_Usage .= "\t\t$suff\t=>\t$Decompress{$key} \| ...\n";
	}

	$ItemOrder = 'template';

	foreach $key ('_file_') {
		$FormatSkip{$key} = '1';
	}

$Example = <<"EOQ";
# This first Format is the header:
%Format
File: %_file_%  Uf=%u2=% N= %n=%x%n=%  L= %l=% beta= %Eval[%l=%*%dtau=%]
(This work was performed on %Eval[`date`])

%EndFormat

# Here is the first section we want:
%Section(X):    /sh 1 xx Spin correlation function:/
%EndSection:    BLANK

# Here is the 2nd section we want:
%Section(P,X):  /G(nx,ny,ti) SHEET 2:/
  %Format
    (Hi Mom!)
    tau      G(tau)          St dev
  %EndFormat
%Sub:           /\\+\\-//
%EndSection(X): /nx =            0 ny =            1/
EOQ

}

sub parse_template {
	
    local($template) = @_;

    local($print_items) = '';

    open(TEMPLATE, "$template") || die "$program: can't open $template";
    
    $Sections = '0';
    $Items = '0';
    $Curr_Section = '0';
    
    while (<TEMPLATE>) {

	next if /^\s*#/;
	&handle_a_line($_, 'TEMPLATE');

    }

    if ( $print_items ) {
	&msg("------------------------------------------------\n");
	for ($i = 0; $i < $Items; $i++) {
		&msg("Items($i): $Item[$i]\n");
	}
	&msg("------------------------------------------------\n");
    }


}

sub handle_a_line {

	local($_, $FH) = @_; 
	local($result) = 'none';

	local($print_result) = '';

	local($data,$last);
	
	if ( /^\s*%ItemOrder[:]*\s*(.*)/ ) {

		$item = $1;
		if ( $item =~ /file/i ) {
			$ItemOrder = 'file';
		} elsif ( $item !~ /^\s*$/ ) {
			$ItemOrder = 'template';
		}

	} elsif ( /^\s*%Format/io ) {

		($data,$last) = &read_until('^\s*%EndFormat',$FH);
		$i = ++$FormatCount{$Curr_Section};
		$Formats{$Curr_Section,$i} = $data;

		$Item[$Items++] = "Format:$Curr_Section:$i"; 
		$result = "Format($Curr_Section,$i)";

	} elsif ( /^\s*%Search[:]*(.*)$/io ) {

		$data = "_EXCLUDE_".$1."\n";
		$i = ++$FormatCount{$Curr_Section};
		$Formats{$Curr_Section,$i} = $data;

		$Item[$Items++] = "Format:$Curr_Section:$i"; 
		$result = "Format($Curr_Section,$i)";

	} elsif ( /^\s*%Grep([^:]*):\s*(.*)/io ) {
		$extra = $1;
		$grep = $2;
		if ( $extra =~ /\bp/i ) {	# /protect/
			$grep =~ s/(\W)/\\$1/g;
			$grep =~ s/^\\//;
			$grep =~ s/\\(.)$/$1/;
		}
		$i = ++$GrepCount{$Curr_Section};
		$Greps{$Curr_Section,$i} = $grep;

		$Item[$Items++] = "Grep:$Curr_Section:$i"; 
		$result = "Grep($Curr_Section,$i)";

	} elsif ( /^\s*%Delete([^:]*):\s*(.*)/io ) {

		$extra = $1;
		$delete = $2;
		if ( $extra =~ /\bp/i ) {	# /protect/
			$delete =~ s/(\W)/\\$1/g;
			$delete =~ s/^\\//;
			$delete =~ s/\\(.)$/$1/;
		}
		$i = ++$DeleteCount{$Curr_Section};
		$Deletes{$Curr_Section,$i} = $delete;

		$Item[$Items++] = "Delete:$Curr_Section:$i"; 
		$result = "Delete($Curr_Section,$i)";

	} elsif ( /^\s*%Sub[:]*\s*(.*)/io ) {

		$sub = $1;
		$i = ++$SubCount{$Curr_Section};
		$Subs{$Curr_Section,$i} = $sub;

		$Item[$Items++] = "Sub:$Curr_Section:$i"; 
		$result = "Sub($Curr_Section,$i)";

	} elsif ( /^\s*%Section([^:]*):\s*(.*)/io ) {

		if ( $FH eq 'TMP' ) {
			die "Fatal Error: too many levels of Section's\n";
		}

		$begin_extras = $1;
		$begin_match  = $2;
		$end_extras   = '';
		$end_match    = '';

		$Sections++;
		$old_section = $Curr_Section;
		$Curr_Section = $Sections;

		($data,$last) = &read_until('^\s*%EndSection',$FH);

		if ( $last =~ /^\s*%EndSection([^:]*)[:]*\s*(.*)/ ) {
			$end_extras = $1;
			$end_match  = $2;
		}

		if ( $begin_extras =~ /\bp/i ) {	# /protect/
			$begin_match =~ s/(\W)/\\$1/g;
			$begin_match =~ s/^\\//;
			$begin_match =~ s/\\(.)$/$1/;
		}
		if ( $begin_match =~ /^\s*BLANK$/ ) {
			$begin_match = '/^\s*$/';
		}
		if ( $end_extras =~ /\bp/i ) {	#	 /protect/
			$end_match =~ s/(\W)/\\$1/g;
			$end_match =~ s/^\\//;
			$end_match =~ s/\\(.)$/$1/;
		}
		if ( $end_match =~ /^\s*BLANK$/ ) {
			$end_match = '/^\s*$/';
		}

		$Sections{$Curr_Section,'begin_extras'} = $begin_extras;
		$Sections{$Curr_Section,'begin_match'}  = $begin_match;
		$Sections{$Curr_Section,'end_extras'}   = $end_extras;
		$Sections{$Curr_Section,'end_match'}    = $end_match;


		open(TMP, ">$TmpFile"); print TMP $data; close(TMP);
		open(TMP, "$TmpFile");
		while (<TMP>) {
			next if /^\s*#/;
			&handle_a_line($_, 'TMP');
		}

		$Item[$Items++] = "Section:$Curr_Section:$i"; 

		unlink($TmpFile);

		$result = "Section($Sections)";

		$Curr_Section = $old_section;	# should be '0'
	}

	&msg("Result: $result\n") if $print_result;
	return $result;

}

sub read_until {
	
	local($regex, $FH) = @_; 

	local($stuff) = '';
	local($last) = '';
	local($line);
	while (<$FH>)  {
		next if /^\s*#/;
		$line = $_;
		if ( $line =~ /$regex/ ) {
			$last = $line;
			last;
		} else {
			$stuff .= $line;
		}
	}
	return ($stuff, $last);
}

sub msg {
	print STDERR @_;
}

sub make_fixer_engine {

	open(CODE, ">$Engine") || die "cannot open $Engine"; 

	select CODE;

	chop($date = `date`);

print <<"E";
$Perl
#--------------------- Top Section -----------------------

# Generated by $program on $date.
# $Version
# See at End the source template this file was created from.

\$debug = '';		# set to non null string for more info printing
#\$debug = 'True';

if ( \$ENV{'FIXER_DEBUG'} ne '' ) {
	\$debug = 'True';
}

\$delim = "";			# Nothing between formats.
#\$delim = "\\n";		# use this for newlines between Sections & Formats
\$delim = "---\\n" if \$debug;	# debugging, print a little --- between them.
\$current = '0';

\$Current_File = \$ENV\{'FIXER_CURRENT_FILE'\};
if ( \$Current_File eq '' ) {
	\$Current_File = \$ARGV[0];
}

select STDOUT; \$| = 1;

#--------------------- While Loop -----------------------
while (<>) {
E

print <<"E";

#--------------------- Begin Sections -----------------------

E

	$count = '0';
	$ELSEIF = &else_start;
	for ($i=1; $i <= $Sections; $i++) {

		$count++;

		$bm = $Sections{$i,'begin_match'};

print <<"E";
	$ELSEIF ( \$current == 0 && ${bm}o ) {
		\$current = \'$i\';
E
	#'
	$ELSEIF = &else_next;
	} # end of i <= Sections Loop

	if ( $count ) {
print <<"E";
	}	# end of section match beginnings
E
	}


print <<"E";

#--------------------- Message -----------------------

#	&msg("Current Section is \$current\\n") if \$debug;
E

print <<"E";

#--------------------- Format Gathering -----------------------

E
	for ($j=1; $j <= $FormatCount{'0'}; $j++) {
		$format_code = &format_code($Formats{'0',$j}, "SectionFormatMatch_0");
print <<"E";
$format_code
E
	} # end FormatCount Loop

	$ELSEIF = &else_start;
	$count = '0';
	for ($i=1; $i <= $Sections; $i++) {
		$count++;

print <<"E";
	$ELSEIF ( \$current == $i ) {
E
	$ELSEIF = &else_next;
		$format_code = '';
		for ($j=1; $j <= $FormatCount{$i}; $j++) {
		$format_code = &format_code($Formats{$i,$j}, "SectionFormatMatch_$i");
print <<"E";
$format_code
E

		} # end FormatCount $j Loop

		if ( $format_code eq '' ) {
print <<"E";
		;
E
		} # end of if format_code

	} # end i <= Sections Loop

	if ($count) {
print <<"E";
	}
E
	}

print <<"E";
#--------------------- Collection Sections -----------------------


#------------------------------- grep code -----------------------

E

	$grep_code = &grep_code('0');

print <<"E";
		\$line = \$_;
$grep_code
E

	$sub_code = &sub_code('0');

print <<"E";
$sub_code
E

	$count = '0';
	$ELSEIF = &else_start;
	for ($i=1; $i <= $Sections; $i++) {
		$count++;

print <<"E";
	$ELSEIF ( \$current == $i ) {
		\$line = \$_;
E
	$ELSEIF = &else_next;
	$grep_code = &grep_code($i);

print <<"E";
$grep_code
E

#		if ( $grep_code eq '' ) {
#print <<"E";
#		;
#E
#		} # end of if grepcode

	$sub_code = &sub_code($i);

print <<"E";
$sub_code
E

		if ( $sub_code eq '' ) {
print <<"E";
			\$Section_Collect_$i .= $line; 
E
		} # end of if sub_code


	} # end of  i < Sections Loop

	if ($count) {
print <<"E";
	}	# end of Collection sections 
E
	}

print <<"E";

#--------------------- End Sections -----------------------

E

	$ELSEIF = &else_start;
	$count = '0';
	for ($i=1; $i <= $Sections; $i++) {

		$count++;
		$em = $Sections{$i,'end_match'};

print <<"E";
	$ELSEIF ( \$current == $i && ${em}o ) {
		\$current = '0';
E
	$ELSEIF = &else_next;

	} # end of i <= Sections Loop

	if ($count) {
print <<"E";
	}	# end of section match endings
E
	}


print <<"E";

}	# end of while loop

#--------------------- End While Loop -----------------------
E

print <<"E";

#--------------------- Set File Format for all Sections -----------------------

E

	for ($i=0; $i <= $Sections; $i++) {

print <<"E";
\$SectionFormatMatch_$i\{'_file_'\} = \$Current_File;
E

	} # end of i <= Sections Loop

print <<"E";

#--------------------- Work Out Collected Sections -----------------------

E
	for ($i=0; $i <= $Sections; $i++) {

	if ( $Sections{$i,'begin_extras'} =~ /\bex|\bx/i ) {	# /exclude/
print <<"E";
\$Section_Collect_$i =~ s/^.*\\n//;		# begin exclude	
E
	}
	if ( $Sections{$i,'end_extras'} =~ /\bex|\bx/i ) {	# /exclude/
print <<"E";
\$Section_Collect_$i =~ s/[^\\n].*\\n\$//;	# end exclude	
E
	}
print <<"E";
#	&msg("Section_Collect_$i\\n") if \$debug;
E

	} # end of i <= Sections Loop


print <<"E";

#--------------------- Work Out Formatted Sections -----------------------

E
	for ($i=0; $i <= $Sections; $i++) {
	    for ($j=1; $j <= $FormatCount{$i}; $j++) {
		$format_output_code = &format_output_code($Formats{$i,$j}, "SectionFormatMatch_$i", "Formatted_Output_${i}_${j}");
print <<"E";
$format_output_code
E
	    } # end FormatCount Loop
	} # end of i <= Sections Loop

	$output_code = &output_code;
print <<"E";

#--------------------- Print Output -----------------------

$output_code

E
print <<'E';

#--------------------- Bottom Subroutines -----------------------

sub msg {	# sub to print a message to standard error
	print STDERR $_[0];
}

sub sub {	# used to sub in %Eval[]'s
		# Usage:  %Eval[&sub('%foo%','/A/a/g')];
	
	local($string, $regex) = @_;

	eval "\$string =~ s$regex";

	return $string;
}

sub do_evals {	# sub to evaluate all %Eval[<cmd>]'s
	local($str) = @_;
	local($whole, $cmd, $result);

	local($debug) = '';

	local($escape) = '__ESCAPED_RIGHT_BRACKET__';

	$str =~ s/\\\]/$escape/g;

	while ( $str =~ /(%Eval\[([^\]]+)\])/io ) {
		$whole = $1;
		$cmd = $2;
		$cmd =~ s/$escape/]/g;
		print STDERR "cmd $cmd\n" if $debug;
		eval "\$result = $cmd";
		if ( $cmd =~ /\`\s*$/ ) {	# What other case should we chop newline??
			chop($result);
		}
		$whole =~ s/(\W)/\\$1/g;
		$str =~ s/$whole/$result/;
	}

	$str =~ s/$escape/]/g;
	return $str;
}


#--------------------- End of Program -----------------------
E

$Template_source = &get_template_source;

print <<"E";

__END__

$program template used to create the current program file:

$Template_source

# (end of template source)

E


	close(CODE);
	system("chmod 755 $Engine");

	&msg("(Created \"compiled\" script: \"$Engine\")\n") unless $Quiet;

	if ( $Compile_Only ) {
		&msg("Done.\n");
		exit 0;
	}
}


sub format_code {
	local($escape_percent) = '__A_REAL_PERCENT__';
	local($escape_eval)    = '__A_REAL_EVAL__';
	local($string, $string2);
	local(%matches);
	local($format, $varname) = @_;
	local($print_format) = '';

	$format =~ s/\\%/$escape_percent/og;
	$format =~ s/%Eval/$escape_eval/oig;

	while ($format =~ /\%([^\%]+)\%/ ) {
		$string = $1;
		$string2 = $string;
		$string =~ s/(\W)/\\$1/g;
		$matches{$string} = $string2 if ! $FormatSkip{$string};
		$format =~ s/\%$string\%//;
		&msg("Format: $string2\n") if $print_format;
	}

	local($code) = '';
	local($count) = '0';

	foreach $string (keys(%matches)) {
		$string2 = $matches{$string};
		$count++;

#old		$ELSEIF ( /${string}\\s*(\\S+)\\s*/o ) {
$code .= <<"E";
		if ( /\\b${string}\\s*(\\S+)\\s*/o ) {
			\$${varname}\{\'$string2\'\} = \$1;
		}
E
	#'
		
	}

	return $code;
}

sub format_output_code {
	local($escape_percent) = '__A_REAL_PERCENT__';
	local($escape_eval)    = '__A_REAL_EVAL__';
	local($string, $string2);
	local(%matches);
	local($format, $hash_var, $output_var) = @_;
	local($hash_var_0) = $hash_var;

	$hash_var_0 =~ s/_[^_]$/_0/;

	$format_orig = $format;
	$format =~ s/\\%/%/og;
#	$format =~ s/%Eval/$escape_eval/oig;

	if ( $format =~ /\n$/ ) {
		chop($format);
	}

	local($code) = '';

$code .= <<"EX";
#--------------- $output_var ------------------------------
\$$output_var = <<'EndFormat';
$format
EndFormat

EX

	$format_orig =~ s/\\%/$escape_percent/og;
	$format_orig =~ s/%Eval/$escape_eval/oig;
	while ($format_orig =~ /\%([^\%]+)\%/ ) {
		$string = $1;
		$string2 = $string;
		$string =~ s/(\W)/\\$1/g;
		$matches{$string} = $string2;
		$format_orig =~ s/\%$string\%//;
	}

	foreach $string (keys(%matches)) {
		$string2 = $matches{$string};

$code .= <<"EX";
\$tmp = \$${hash_var}\{\'$string2\'\};
EX
		if ( $hash_var_0 ne $hash_var ) {
$code .= <<"EX";
\$tmp = \$${hash_var_0}\{\'$string2\'\} if \$tmp eq '';
EX
		}
$code .= <<"EX";
\$$output_var =~ s/\\%${string}\\%/\$tmp/g;
EX
		
	}

$code .= <<"EX";
if ( \$$output_var =~ /%Eval/io ) {
	\$$output_var = &do_evals(\$$output_var);
}
\$$output_var =~ s/\\n_EXCLUDE_.*//;
\$$output_var =~ s/^_EXCLUDE_.*\\n//;
EX

#$code .= <<"EX";
#&msg("------- $output_var:\\n") if \$debug;
#&msg("\$$output_var") if \$debug;
#&msg("--------------------\\n") if \$debug;
#EX
		
	return $code;
	
}

sub grep_code {
	local($sec) = @_;

	local($code) = '';
	local($regex);
	local($i, $j);

	if ( $sec eq '0' ) {
		return &grep_code_zero($sec);
	}

	if ( ! $GrepCount{$sec} && ! $DeleteCount{$sec} ) {
$code .= <<"E";
		\$grep_ok = '1';
E
		return $code;
	}

$code .= <<"E";
		\$grep_ok = '0';
					# greps code
E
	$ELSEIF = &else_start;
	for ($i=1; $i <= $GrepCount{$sec}; $i++) {
		$regex = $Greps{$sec,$i};
		

$code .= <<"E";
		$ELSEIF ( ${regex}o ) {
			\$grep_ok = '1';
E
	$ELSEIF = &else_next;
	}

$code .= <<"E";
		}
E

$code .= <<"E";

		if (\$grep_ok eq '0') { # deletes code
			;
E
	for ($i=1; $i <= $DeleteCount{$sec}; $i++) {
		$regex = $Deletes{$sec,$i};
		
$code .= <<"E";
		} elsif ( ${regex}o ) {
			\$grep_ok = '0';
E
		
	}

$code .= <<"E";
		}
E

	return $code;
}


sub grep_code_zero {
	local($sec) = @_;

	local($code) = '';
	local($regex);
	local($i, $j);

	if ( $sec ne '0' ) {
		&msg("grep_code_zero: section not zero\n");
		return '';
	}

	if ( ! $GrepCount{$sec} && ! $DeleteCount{$sec} ) {
$code .= <<"E";
		\$grep_ok = '0';	# different from sections
E
		return $code;
	}

$code .= <<"E";
		\$grep_ok = '0';
					# greps code
E
	$ELSEIF = &else_start;
	for ($i=1; $i <= $GrepCount{$sec}; $i++) {
		$regex = $Greps{$sec,$i};
		

$code .= <<"E";
		$ELSEIF ( ${regex}o ) {
			\$grep_ok = '1';
E
	$ELSEIF = &else_next;
	}

$code .= <<"E";
		}
E

$code .= <<"E";

		if (\$grep_ok eq '0') { # deletes code
			;
E
	for ($i=1; $i <= $DeleteCount{$sec}; $i++) {
		$regex = $Deletes{$sec,$i};
		
$code .= <<"E";
		} elsif ( ${regex}o ) {
			\$grep_ok = '0';
E
		
	}

$code .= <<"E";
		}
E

	return $code;
}


sub sub_code {
	local($sec) = @_;

	local($code) = '';
	local($regex);
	local($i, $j);

#	if ( $sec eq '0' ) {
#		return &sub_doc_zero($sec);
#	}

$code .= <<"E";
		if (\$grep_ok eq '0') {		# subs code
			;		
		} else {
E
	for ($i=1; $i <= $SubCount{$sec}; $i++) {
		$regex = $Subs{$sec,$i};
		
$code .= <<"E";
			\$line =~ s${regex}o;
E
		
	}

$code .= <<"E";

			\$Section_Collect_$sec .= \$line;	# collect it
		}
E
	return $code;
	
}

sub get_template_source {

	local($src) = '';
	open(TMPL, "$Template") || die "could not open $Template";

	while (<TMPL>) {
		$src .= $_;
	}
	close(TMPL);

	return $src;
}

sub output_code {
    local($code) = '';

    local($i, $j, $item, $num, $sec, $cnt);
    local(%SectionHit);
#    local(%FormatHit);

    if ( $ItemOrder eq 'template' ) {	# ItemOrder eq 'file' not implemented

	for ($i=0; $i < $Items; $i++) {
	    $item = $Item[$i];

	    if ( $item =~ /^Format:(.*)$/ ) {
		$num = $1;
		($sec, $cnt) = split(/:/, $num); 
$code .= <<"E";
	print STDOUT \$Formatted_Output_${sec}_$cnt;
	print STDOUT \$delim;
E
	    } elsif ( $item =~ /^Grep|^Delete|^Sub/ ) {
		$num = '';
	    	if ( $item =~ /:(.*)$/ ) {
	    		$num = $1;
			($sec, $cnt) = split(/:/, $num); 
			if ( ! $SectionHit{$sec} ) {
				$SectionHit{$sec}++;
$code .= <<"E";
	print STDOUT \$Section_Collect_$sec;
	print STDOUT \$delim;
E
				
			}
	    	}
	    } elsif ( $item =~ /^Section:(.*)$/ ) {
		$num = $1;
		($sec, $cnt) = split(/:/, $num); 
		if ( ! $SectionHit{$sec} ) {
			$SectionHit{$sec}++;
$code .= <<"E";
	print STDOUT \$Section_Collect_$sec;
	print STDOUT \$delim;
E
				
	    	}
	    } # end Section
	} # $i < $Items 
    }

    return $code;
}

sub else_start {
#	return "     if";
#	return "if";
	return "if     ";
}

sub else_next {
	return "} elsif";
}


__END__