#! /usr/local/bin/perl

#generic script to build an HTML page from SGML using a template

#author: Paul Bristow
#date  : 23/1/95

#developed for Charles Sturt University
#Copyright 1995 Charles Sturt University
#All rights reserved

#list_option allows grouping on fields where each record may have multiple values
#-------------------------------------------------------------------------------
#INITIALISATION

$filenames = "";
$where_sgml = "/publish/info/nfram/nframcgi-bin/sgml/"; #location of sgml files
$where_temp = "templates/";	#location of template files
@select_list = ();
@validate_list = ();
@groupby_list = ();
$list_field = "";
@list_keys = ();
@list_fields = ();
%foreach = ();
$header = "";
$body = "";
$footer = "";
@records = ();
$record = "";
$sort_field = "";
$default_sort = "message_id"; #sort by message_id if no sort in template
@sort_list = ($default_sort);
$list_option = 0;		#default to no list option

#-------------------------------------------------------------------------------
#BEGIN
	#get parameters (SGML file, Template, select field - optional)	
	($filenames) = @ARGV;
	($sgmlname, $templatename, $select) = split(/,/, $filenames);

	#build filenames
	$sgmlname = $where_sgml . $sgmlname . ".sgml";
	$templatename = $where_temp . $templatename . ".template";

	#open files
	open(TEMPLATE, "<$templatename") || die "can't open $templatename" ;
	open(SGML, "<$sgmlname") || die "can't open $sgmlname";

	#get template information
	&get_template;

	if (!$select) {$select = @select_list[0];}
	#get sgml records
	$num_recs = &get_matching_records;

	&sort_records;

	&get_foreach;

	#build lists on multi-value fields if required
	&build_list if ($list_field ne "");

	&print_output;

#END

#-------------------------------------------------------------------------------

sub get_foreach

{
	local($temp_body) = $body;
	local($key);
	$* = 1;
	while ($temp_body =~ /<foreach ([^>]*)>/)
	{
		$key = $1;
		$temp_body =~ s/<foreach $key>//;
		$foreach{$key} = " ";
		if (($temp_body =~ s/<\/foreach $key>//) != 1)
		{
			die "unclosed foreach $key";
		}
	}
	if ($temp_body =~ /<\/foreach ([^>]*)/)
	{
		die "unopened foreach $1";
	}
	$* = 0;
}

#-------------------------------------------------------------------------------

sub print_output

{
	local(@temp_records) = @records;
	print $header;
	#different print mechanism if multi-value list
	if ($list_option == 1)
	{
		&print_lists;
	}
	else
	{
		while ($record = shift(@temp_records))
		{
			&print_block($body, $record);
		}
	}
	print $footer;
}

#-------------------------------------------------------------------------------

sub build_list
{
	local(@keys, $val, $id, $field_count, $field, $count, $found);
	local($count) = 0;
	local($temp_list) = $list_field;
	if ($temp_list ne "")
	{
		while ($count <= $#records)
		{
			if ($records[$count] =~ /<$temp_list>(.*)<\/$temp_list>/)
			{
				$list_option = 1;
				@keys = split (/, /,$1);
				$records[$count] =~ /<message_id>(.*)<\/message_id>/;
				$id = $1;
				
				foreach $field (@keys)
				{
					$field_count = 0;
					$found = 0;
					while (($field_count <= $#list_fields) && (! $found))
					{
						if ($list_fields[$field_count] eq $field)
							{
							$list_values[$field_count] .= ("," . $id);
							$found = 1;
							}
						$field_count++
					}
					if (! $found)
					{
						$list_fields[$field_count] = ($field);
						$list_values[$field_count] =  $id;
					}
				}
			}
		$count++;
		}
	}

}

#-------------------------------------------------------------------------------

sub print_lists

{
	local($field, $field_count, $found, @rec_list, $record_no, $print_field);
	local(@order_list) = @list_fields;
	@order_list = sort @order_list;
	foreach $field (@order_list)
	{
		#print stderr "printing $field\n";
		$field_count = 0;
		$found = 0;
		while (($field_count < $#list_fields) && (! $found))
		{
			if ($list_fields[$field_count] eq $field)
			{
				@rec_list = split(/,/, $list_values[$field_count]);
				$current_recs = "";
				$print_field = $field;
				$print_field =~ tr/a-z/A-Z/;
				print "\n</DL><H2>$print_field</H2><DL>\n";
				foreach $record_no (@rec_list)
				{
					print "\n";
					print &build_body($body, &find_record_from_id($record_no));
				}

			}
			$field_count++;
		}
	}
}

#-------------------------------------------------------------------------------

sub find_record_from_id

{
	local ($id) = @_;
	foreach $record (@records)
	{
		return $record if ($record =~ /<message_id>$id<\/message_id>/);
	}
	return "";		#return empty string if not found
}

#-------------------------------------------------------------------------------

sub print_block

{
	local($loc_body, $temp_rec) = @_;
	local($remdr, $key);
	$loc_body =~ s/\n/<>/g;
	$* = 1;
	while ($loc_body =~ /^<foreach ([^>]*)>(.*)/)
	{
		$key = $1;
		$remdr = $2;
		$temp_rec =~ /<$key>(.*)<\/$key>/;
		$this_val = $1;
		if ($this_val =~ /^$foreach{$key}$/i)
		{
			$loc_body = &remove_to_foreach($remdr);
			$loc_body = &remove_tail($loc_body);
		}
		else
		{
			foreach $key (keys %foreach)
			{
			
				$temp_rec =~ /<$key>(.*)<\/$key>/;
				$foreach{$key} = $1;
			}
			$loc_body =~ s/<>/\n/g;
			$loc_body =~ s/<foreach [^>]*>//gi;
			$loc_body =~ s/<\/foreach [^>]*>//gi;
			print &build_body($loc_body, $temp_rec);
			$* = 0;
			return;
		}
	}
	$* = 0;
	$loc_body =~ s/<>/\n/g;
	$loc_body =~ s/<foreach [^>]*>//gi;
	$loc_body =~ s/<\/foreach [^>]*>//gi;
	print &build_body($loc_body, $temp_rec);
}

#-------------------------------------------------------------------------------

sub remove_tail

{
	local($in) = @_;
	$in =~ s/(.*<\/foreach [^>]*>).*<\/foreach .*/$1/;
	return $in;
}

#-------------------------------------------------------------------------------

sub remove_to_foreach

{
	local($in) = @_;
	local($store) = $in;
	local($temp,$rest, $newcount);
	while (($in =~ /[^<]*(<.*)/) && ($newcount++ < 10))
	{
		#print "remove foreach $in\n";
		#$temp = $1;
		$rest = $1;
		
		if ($rest =~ /^<foreach/) 
		{
			return $rest;
		}
		else
		{
			#print "rest $rest\n";
			$rest =~ /^<[^>]*>(.*)/;
			$in = $1;
		}
	}
	return $store;
}

#-------------------------------------------------------------------------------
sub print_block2

{
	local($loc_body, $temp_rec) = @_;
	local($remdr, $each, $endeach);
	if (!($loc_body =~ /.*<foreach.*/))
	{
		if ($loc_body =~ /(.*)(<\/foreach[^>]*)(.*)/)
		{
			$endeach = $2;
			$remdr = $3;
			print &build_body($1, $temp_rec);
		}
		else
		{
			print &build_body($loc_body, $temp_rec);
		}
	}   
	else
	{
		$loc_body =~ /(.*)<foreach ([^>]*)(.*)/;
		$each = $2;
		$donow = $1;
		$dolater = $2;
		$loc_body =~ /<$each>(.*)<\/$each>/;
		if ($groupby_list{$each} ne $1)
		{
			print &build_body($donow, $temp_rec);
			&print_block($dolater, $temp_rec)
		}
	}

}

#-------------------------------------------------------------------------------

sub build_body

#replaces $field with value in <field></field> for each occurrence 
#ignores \$
#uses $record, $body
{
	local($local_body, $local_rec) = @_;
	local($match_tag, $match_value);
	local($pcount) = 0;
	loop: while ($local_body =~ /[^\\]+\$([\w]*)/)
	{
		last loop if (++$pcount > 50);	##safety catch if endless loop
		$match_tag = $1;
		$local_rec =~ /<$match_tag>(.*)<\/$match_tag>/;
		$match_value = $1;
		$local_body =~ s/\$$match_tag/$match_value/g;
	}
$local_body;					#return result
}

#-------------------------------------------------------------------------------

sub sort_records

#this sub uses a control break methodology to sort array slices for each
#additional sort as perl will not support a recursive comparison function
#in its sort function

#exports $sort_field, @records
#uses @sort_list, @records
#calls order_records

{
	local($last_key, $rec_count, $last_val, $this_val); 
	local($start_slice, $end_slice, @myslice);
	$last_key = ($sort_field = shift(@sort_list));
	#perform first sort
	@records = sort order_records @records;
	while ($#sort_list > -1)
	{
		#get value of last sort for first record
		$records[0] =~ /<$last_key>(.*)<\/$last_key>/;
		$this_val = ($last_val = $1);
		$start_slice = 0;
		$rec_count = 0;
		#get next sort field
		$sort_field = shift(@sort_list);
		while (($rec_count) <= $#records)  	#for each record
		{
			while ((($rec_count) <= $#records) && ($this_val eq $last_val))
			{
				#build array slice
				$end_slice = $rec_count;
				$records[++$rec_count] =~ /<$last_key>(.*)<\/$last_key>/;
				$this_val = $1;
			}
			@myslice = @records[$start_slice .. $end_slice];
			@myslice = sort order_records @myslice;
			@records[$start_slice .. $end_slice] = @myslice;
			#set start_slice to index of first rec in new group
			$start_slice = $rec_count;
			$last_val = $this_val;
		}
		#store this sort_field for grouping by on next sort_field
		$last_key = $sort_field;
	} 
}

#-------------------------------------------------------------------------------

sub order_records

#uses $sort_field
#returns 1, 0 or -1 according to sort order of parameters
{
	local ($a_val, $b_val);
	#get a value and convert to uppercase
	$a =~ /<$sort_field>(.*)<\/$sort_field>/;
	$a_val = $1;
	$a_val =~ tr/a-z/A-Z/;
	#get b value and convert to uppercase
	$b =~ /<$sort_field>(.*)<\/$sort_field>/;
	$b_val = $1;
	$b_val =~ tr/a-z/A-Z/;
	return 1 if ($a_val gt $b_val);
	return -1 if ($a_val lt $b_val);
	return 0;
}

#-------------------------------------------------------------------------------

sub valid

{
	local($test_rec) = @_;
	local($id, $key);
	#print "$test_rec \n";
	local(%val_list) = %validate_list;
	foreach $key  (keys %val_list)
	{
		#print "$val_list{$key}\n"; 
		if (!($test_rec =~ /<$key>$val_list{$key}<\/$key/i))
		{
			#get id of invalid record if reporting to stderr
			#$test_rec =~ /<message_id>(.*)<\/message_id/;
			#$id = $1;
			#print  stderr "Record $id rejected for $key\n";
			return 0;	#return 0 if invalid
		}
	}
	return 1;			#return 1 if valid
}

#-------------------------------------------------------------------------------

sub get_matching_records

#exports @records
#uses $select
#calls get_a_record
#returns number of matching records
{
	local($in_record, @out_records, $rec_count, $field_name, $field_value);
	$rec_count = 0;
	if ($select)
	{
		($field_name, $field_value) = split(/=/, $select);
		#if no equal in $select defaults to message_id - 1st field is id
		if (!$field_value)
		{
			$field_value = $field_name;
			$field_name = "message_id";
		}
		while ($in_record = &get_a_record)
		{
			if ($in_record =~ /<$field_name>.*$field_value.*<\/$field_name>/)
			{
				($out_records[$rec_count++] = $in_record) if &valid($in_record);
			}   
		}
	}
	else
	#no selection criterion
	{
		while ($in_record = &get_a_record)
		{
			($out_records[$rec_count++] = $in_record) if &valid($in_record);
		}
	}
	@records = @out_records;
	$rec_count;			#return number of records
}    #end sub

#-------------------------------------------------------------------------------

sub get_a_record

#uses SGML (opened file)
#returns a record
{
	local($line_in, $line_out);
	$line_out = "";				#initialise record out
	($line_in = <SGML>) || return "";
	while (! ($line_in =~ /<record>(.*)/))      #get start tag
	{
		($line_in = <SGML>) || return "";   #return empty string if read fails
	}
	$line_in = $1;                  #get rest of start line
	while (! ($line_in =~ /(.*)<\/record>/))    #get until end tag
	{
		$line_out .= $line_in;
		($line_in = <SGML>) || return "";
	}
	$line_out .= $1;
	$line_out =~ s/\n//g;               	#eliminate newlines
	$line_out;                  		#return record
}

#-------------------------------------------------------------------------------

sub get_template

#uses TEMPLATE (opened file)
#exports @select_list, @sort_list, $header, $footer, $body, 
#        %validate_list, $list_field
{ 
	local($line_in, $select, $sort, $validate, @validate_tmp, $temp_valid);
	local($key, $val, $list_in); 
	while ($line_in = <TEMPLATE>) 
	{
		if ($line_in =~ /<select>/i) 
		{
			($line_in = <TEMPLATE>) || die "unexpected end of select"; 
			while (! ($line_in =~ /<\/select>/i)) 
			{
				chop($line_in);
				$select .= $line_in; 
				($line_in = <TEMPLATE>) || die "unexpected end of select"; 
			}
			@select_list = split(/,/, $select); 
		} 
		elsif ($line_in =~ /<sort>/i) 
		{
			($line_in = <TEMPLATE>) || die "unexpected end of sort"; 
			while (! ($line_in =~ /<\/sort>/i)) 
			{
				chop($line_in);
				$sort .= $line_in; 
				($line_in = <TEMPLATE>) || die "unexpected end of sort"; 
			}
			@sort_list = split(/,/, $sort); 
		} 
		elsif ($line_in =~ /<header>/i) 
		{
			($line_in = <TEMPLATE>) || die "unexpected end of header"; 
			while (! ($line_in =~ /<\/header>/i)) 
			{
				$header .= $line_in; 
				($line_in = <TEMPLATE>) || die "unexpected end of header"; 
			} 
		} 
		elsif ($line_in =~ /<footer>/i) 
		{
			($line_in = <TEMPLATE>) || die "unexpected end of footer"; 
			while (! ($line_in =~ /<\/footer>/i)) 
			{
				$footer .= $line_in; 
				($line_in = <TEMPLATE>) || die "unexpected end of footer"; 
			} 
		} 
		elsif ($line_in =~  /<body>/i) 
		{
			($line_in = <TEMPLATE>) || die "unexpected end of body"; 
			while (! ($line_in =~ /<\/body>/i)) 
			{
				$body .= $line_in; 
				($line_in = <TEMPLATE>) || die "unexpected end of body"; 
			} 
		} 
		elsif ($line_in =~  /<validate>/i) 
		{
			($line_in = <TEMPLATE>) || die "unexpected end of validate"; 
			while (! ($line_in =~ /<\/validate>/i)) 
			{
				$validate .= $line_in; 
				($line_in = <TEMPLATE>) || die "unexpected end of validate"; 
			}
			$validate =~ s/\n//g; 
			@validate_tmp = split(/,/, $validate);
			while ($#validate_tmp > -1)
			{
				$temp_valid = shift(@validate_tmp);
				($key, $val) = split(/=/, $temp_valid);
				$validate_list{$key} = $val;
			}
		} 
		elsif ($line_in =~  /<list>/i) 
		{
			($line_in = <TEMPLATE>) || die "unexpected end of list"; 
			while (! ($line_in =~ /<\/list>/i)) 
			{
				$list_in .= $line_in; 
				($line_in = <TEMPLATE>) || die "unexpected end of list"; 
			} 
			$list_in =~ s/\n//g;
			if ($list_in =~ /.*,.*/)
			{
				($list_field) = split(/,/, $list_in);
			}
			else 
			{
				$list_field = $list_in;}
			} 
}
close (TEMPLATE);
}

#-------------------------------------------------------------------------------