#!perl

# Copyright (c) 1997-1999 Symbian Ltd.  All rights reserved.

# Version Info:
# Version 002 : added test for illegal (non-numeric) first cell of a List Manual paragraph
# Version 001 : smptm2cs for the aleppo help system (added facilities for extracting context from definition and manual lists)

# Associative array of Styles to Tags
%style_tag = ("list bullet", "<ul>\n", "list bullet 2", "<ul>\n",
				"list", "<ul>\n", "list 2", "<ul>\n", 
				"list number", "<ol>\n", "list number 2", "<ol>\n",
				"list continue", "<ul>\n", "list continue 2", "<ul>\n",
				"list manual", "<ol>\n", "list manual 2", "<ol>\n",
				"definition term", "<dl>\n", "definition definition", "<dl>\n",
				"figure anchor", "<figure>\n", "figure caption", "<figure>\n", "figure description", "<figure>\n",
				"figure picture", "<figure>\n", "figure directive", "<figure>\n", "figure status", "<figure>\n");
# ------------------------------------- Global variables -----------------------------------
# --- for lists
$list_depth = 0;			# the depth of paragraphs in the current list (integer)
$list_tag = "";				# the end tag of the current list (string)
# -------- filenames --------
$without_extender = "";				# input file without extender
$output_name = "";					# filename of pipeline output file
$input_name = "";					# filename of input file
# ---- for error logging ----
$log_name = pwd()."\\samaria.log";	# filename of error file
$log_error_lines = 2;				# number of lookahead lines to report in error message
$error_context = -1;
# -------- arguments --------
$input_extension = "ptml";			# default input file extension
$input_directory = pwd()."\\";		# default input directory is current directory 
$output_extension = "cs-ptml";		# default output file extension (cs-ptml)
$output_directory = pwd()."\\";		# default output directory is current directory
$console_error = 1;					# default is to display errors on the console
$log_error = 0;						# default is not to log errors in a file
$log_rawname = "samaria.log";		# default logfile name
# ------------------------------------------------------------------------------------------

# --------------------------------- Start of Main() ----------------------------------------

&handle_command_line_args();										# calculate filenames

if ($log_error == 1) {
	open(LOGFILE,">>$log_name") || &log_die("Cannot create $log_name");		# open error log for appending
}
open(OUTFILE,">$output_name") || &log_die("Cannot create $output_name");	# open output file (.cs-ptml)
open(INFILE,"$input_name") || &log_die("Cannot find $input_name");			# open input file

$line_number = 0;
while ($_ = <INFILE>)	{								# Iterate over all paragraphs of the ptml file
	$line_number++;										# increment line count (for error logging)
	if ($error_context > -1 && $error_context < $log_error_lines) {	# if this line should be printed as error log lookahead
		if ($log_error == 1) {
			print LOGFILE $_;
		} 
		if ($console_error == 1) {
			print $_;
		}
		$error_context++;
	}
		
	# perform leading and ending spaces substitutions
	s/<([^p\/])([^>]*)> / <$1$2>/g;				# <x>_ => _<x>		(where x is not p or /)
	s/ <\/([^ph])([^>]*)>/<\/$1$2> /g;			# _</x> => </x>_	(where x is not p or h)
	s/ <\/([ph])([^>]*)>/<\/$1$2>/g;			# _</x> => </x>		(where x is p or h)

	$paragraph = $_;
	if (/<trow/) {
		$paragraph =~ s/<trow cwidths="(.*)">(.*)\n/$1/;	# extract the widths string
		&end_list();										# end list (if in list)
		&start_table($paragraph);							# start table
	} elsif (/<\/trow>/) {
		&end_row();											# end row
	} elsif (/<cell>/) {
		&start_cell();										# start cell
	} elsif (/<\/cell>/) {
		&end_list();										# end list (if in list)
		&end_cell();										# end cell
	} else {
		# apply "heading 5,h5" type removal for paragraph and character styles
		s/<p style="([^,]*)([^"]*)">/<p style="$1">/;
		s/<cs style="([^,]*)([^"]*)">/<cs style="$1">/g;

		$para_style = $_;									# Get current paragraph style
		$para_style =~ s/<p style="([^"]*)">(.*)\n/$1/;
		$para_style = lc($para_style);

		if ($in_table == 1 && $in_row == 0) {
			&end_table();	# if in table, but not in row then <p..> = end of table
		}
		if ($style_tag{$para_style}) {					# If paragraph is a list (bulleted, simple or numeric) or figure...
			&handle_list($para_style);
		} else {										# If paragraph isn't a list...
			&end_list();								# If previous paragraph was in list, emit list end tags
			$list_tag = "";								# Set tag to nothing (not in a list any more)

		    s/<p style="Title">(.*)<\/p>/<h0>$1<\/h0>/i;				# If paragraph is a title, process
			s/<p style="Heading (.)">(.*)<\/p>/<h$1>$2<\/h$1>/i;		# If paragraph is a heading, process
		}

		print OUTFILE;				# output the processed paragraph
	}
}

if ($in_table == 1) {			# if still in table context at input EOF print </table> to output
	print OUTFILE "</table>";
}

close(OUTFILE);
close(INFILE);
if ($log_error == 1) {
	close(LOGFILE);
}

# ------------------------------------- End of Main() ----------------------------------------

# ------------------------------------ List functions ----------------------------------------

sub handle_list {
	my($new_style) = @_;						
		
	if (/<p style="list continue/ && $list_depth>0) {	# if this is a list continue within a list, don't change the tag
	} else {	
		$tag_start = $style_tag{$new_style};						# get the tag for this paragraph style
		$tag_end = $style_tag{$new_style};		
		$tag_end =~ s/</<\//;										# calculate its corresponding end tag
	}

	if ($new_style =~ /list/ || $new_style=~ /definition (.*)/) {			# if the tag is a list
		$required_level = $new_style;				# find the listdepth required
		if ($required_level =~ /2/) {
			$req_level = 2;
		} elsif ($required_level =~ /3/) {
			$req_level = 3;
		} else {
			$req_level = 1;
		}

		if ($list_tag ne $tag_end) {			# if the list is not of the same family...
			while ($list_depth > 0) {			# emit end tags for current list
				print OUTFILE "$list_tag";
				$list_depth--;
			}
			while ($list_depth < $req_level) {	# emit start tags for new list
				print OUTFILE "$tag_start";
				$list_depth++;
			}
		} else {							# the list is of the same family
			while ($list_depth < $req_level) {	# if new depth < current emit start tags
				print OUTFILE "$tag_start";
				$list_depth++;
			}
			while ($list_depth > $req_level) {	# if new depth > current emit end tags
				print OUTFILE "$tag_end";
				$list_depth--;
			}
		}

		if (/<p style="list continue/) {
			s/<p style="([^"]*)">(.*)<\/p>/<p>$2<\/p>/;			# process paragraph using subst to give <p>*</p>
		} elsif (/<p style="definition term"/) {
			s/<p style="([^"]*)">(.*)<\/p>/<dt>$2<\/dt>/;		# process paragraph using subst to give <li>*</li>
		} elsif (/<p style="definition definition"/) {
			s/<p style="([^"]*)">(.*)<\/p>/<dd>$2<\/dd>/;		# process paragraph using subst to give <li>*</li>
		} elsif (/<p style="list manual"/ || /<p style="list manual 2"/) {
			/<p style="([^"]*)">(.*?)&tab;(.*)<\/p>/;
			$is_it_numeric = $2;
			$is_it_numeric =~ s/(.*)\./$1/;						# get rid of the dot, if it is there
			if ($is_it_numeric eq "") {
				$numeric = 0;
			} else {
				$numeric = &is_numeric($is_it_numeric);
			}
			if ($numeric == 1) {
				s/<p style="([^"]*)">(.*?)&tab;(.*)<\/p>/<li value=$is_it_numeric>$3<\/li>/;	# it is numeric: process paragraph using subst to give <li>*</li>
			} else {
				&log_error("Non-numeric value ($is_it_numeric) found in List Manual paragraph: $_ [use a Definition list instead]");
				s/<p style="([^"]*)">(.*?)&tab;(.*)<\/p>/<li value=0>$3<\/li>/;		# it isn't numeric: process paragraph using subst to give <li>*</li> with default value
			}
		} else {
			s/<p style="([^"]*)">(.*)<\/p>/<li>$2<\/li>/;		# process paragraph using subst to give <li>*</li>
		}
	} else {								# so the style is a figure style
		if ($list_tag ne $tag_end) {			# if this is the first figure line...
			while ($list_depth > 0) {				# emit end tags for current list
				print OUTFILE "$list_tag";
				$list_depth--;
			}
			print OUTFILE "$tag_start";				# print the start tag if this is the first style in the <figure>
			$list_depth = 1;
		} else {
			# if the line is not the first line, but is a figure picture or figure directive then emit </figure><figure>
			if (/p style="Figure Picture"/i || /p style="Figure Directive"/i) {
				print OUTFILE "$list_tag";
				print OUTFILE "$tag_start";
			}
		}

		# if the paragraph is a figure directive, check the existence of the figure files and process
		if (/<p style="Figure Directive">/i) {
			&process_figure_directive();
		}
	}

	$list_tag = $tag_end;								# set current end tag to the new end tag
}

sub is_numeric {
	my($check_num) = @_;
	
#	print "Checking list manual: $check_num\n";
	if ($check_num =~ /\D/) {
		$ret_val = 0;
	} else {
		$ret_val = 1;
	}

	return $ret_val;
}

sub end_list {						# emit the correct number & type of end-list-tags to end list
	while ($list_depth > 0) {					
		print OUTFILE "$list_tag";
		$list_depth--;
	}
}

sub process_figure_directive {
	/<p style="Figure Directive">Figure (.*?) \[Hi-res (.*?)\]<\/p>/i;
	if ($2 eq "") {
		/<p style="Figure Directive">Figure (.*?)<\/p>/i;
		$figure1 = $1;
		$figure2 = "";
	} else {
		$figure1 = $1;
		$figure2 = $2;
	}

	# check on the existence of the figures
	if ($figure1 ne "") {
		$figure1 = &check_gif_existence($figure1);
	}
	if ($figure2 ne "") {
		$figure2 = &check_gif_existence($figure2);
	}

	if ($figure1 ne "" && $figure2 ne "") {
		s/<p style="Figure Directive">(.*)<\/p>/<p style="figure directive"><picture name="$figure1" hi-res="$figure2"><\/p>/i;
	} elsif ($figure1 ne "" && $figure2 eq "") {
		s/<p style="Figure Directive">(.*)<\/p>/<p style="figure directive"><picture name="$figure1"><\/p>/i;
	} elsif ($figure1 eq "" && $figure2 ne "") {
		s/<p style="Figure Directive">(.*)<\/p>/<p style="figure directive"><picture name="$figure2"><\/p>/i;
	}
}

sub check_gif_existence {
	my($figure) = @_;
	
	$cur_prep_dir = $input_directory;
	$cur_prep_dir =~ s/sdk-aux/sdk-prep/;

	if (substr($figure,0,3) eq "..\\") {
		$last_slash = rindex($cur_prep_dir,"\\");
		$last_slash = rindex($cur_prep_dir,"\\",$last_slash-1);
		$search_figure = substr($cur_prep_dir,0,$last_slash+1).substr($figure,3);
	} else {
		$search_figure = $cur_prep_dir.$figure;
	}

	if ($search_figure =~ /\./) {
	} else {
		$search_figure = $search_figure.".gif";
	}

	if (-e $search_figure) {           
		$output_figure = $figure;
	} else {
		if ($search_figure =~ /:/) {
			$search_figure = "v".substr($search_figure,2);
		} else {
			$search_figure = "v:".$search_figure;
		}
		if (-e $search_figure) {
			$output_figure = $figure;
		} else {
			$search_figure =~ s/v:\\sdk-prep\\/k:\\/;
			if (-e $search_figure) {
				$output_figure = $figure;
			} else {
				$output_figure = "";
				&log_error("Cannot find $figure on current drive, V:\\sdk-prep, or K:","");
			}
		}
	}

	return $output_figure;
}

# ------------------------------------- Table functions ----------------------------------------

sub start_table {
	$new_widths = $_[0];
	if ($in_table == 0) {									# if not in a table
		print OUTFILE "<table cwidths=\"$new_widths\">\n";
		$in_table = 1;
		$table_widths = $new_widths;
	} elsif ($new_widths ne $table_widths) {		# already in a table, check if widths equal
		print OUTFILE "</table>\n";					# if new row's widths are different, make new table
		print OUTFILE "<table cwidths=\"$new_widths\">\n";
		$in_table = 1;
		&log_error("Warning: table width changed from $table_widths to $new_widths","Context");
		$table_widths = $new_widths;
	}
	$in_row = 1;
	print OUTFILE "<trow>\n";
}

sub end_table {
	print OUTFILE "</table>\n";
	$in_table = 0;
}

sub end_row {
	print OUTFILE "</trow>\n";
	$in_row = 0;
}

sub start_cell {
	print OUTFILE "<cell>\n";
	$in_cell = 1;
}

sub end_cell {
	print OUTFILE "</cell>\n";
	$in_cell = 0;
}

# ------------------------------------------- Misc functions ----------------------------------------

sub handle_command_line_args {
	&extract_command_line_args("alptm2cs");
	$input_name = $input_directory.$without_extender.".".$input_extension;
	$output_name = $output_directory.$without_extender.".".$output_extension;
}

sub extract_command_line_args {
	my($program_title) = @_;
	if ($this_arg = pop(@ARGV)) {
		$without_extender = $this_arg;		# filename (without extender) is always the last argument

		while ($this_arg = pop(@ARGV)) {
			if ($this_arg =~ /-ie/) {
				$input_extension = $this_arg;
				$input_extension =~ s/-ie(.*)/$1/;
			} elsif ($this_arg =~ /-oe/) {
				$output_extension = $this_arg;
				$output_extension =~ s/-oe(.*)/$1/;
			} elsif ($this_arg =~ /-id/) {
				$input_directory = $this_arg;
				$input_directory =~ s/-id(.*)/$1/;
			} elsif ($this_arg =~ /-od/) {
				$output_directory = $this_arg;
				$output_directory =~ s/-od(.*)/$1/;
			} elsif ($this_arg =~ /-mc-/) {
				$console_error = 0;
			} elsif ($this_arg =~ /-ml/) {
				$log_error = 1;
				if ($this_arg ne "-ml") {			# if a logfile name is specified...
					$log_name = $this_arg;
					$log_name =~ s/-ml(.*)/$1/;
				}
			} else {
				print "Illegal argument: $this_arg";
				exit;
			}
		}
	} else {								# no arguments - print message and exit
		print "Use of $program_title:\n\t$program_title [options] filename\n\noptions:\n\t-ie(input extension)\n".
				"\t-oe(output extension)\n\t-id(input directory)\n\t-od(output directory)\n".
				"\t-mc-\n\t-ml(logfile)";
		exit;
	}
}

sub log_error {
	my($error_string,$context) = @_;
	
	if ($context eq "Context") {
		$error_context = 0;
	}

	if ($log_error == 1) {
		print LOGFILE "ERROR - $without_extender: $error_string (line $line_number)\n";
	} 
	if ($console_error == 1) {
		print "ERROR - $without_extender: $error_string (line $line_number)\n";
	}
}

sub log_die {
	my($error_string) = @_;
	if ($log_error == 1) {
		print LOGFILE "ERROR - $error_string\n";
	}
	die "ERROR - $error_string";
}

# ---------------------------------------- Directory handling fns -----------------------------------

sub pwd {
	$dir = `cd`;								# find current directory
	chop($dir);									# remove the eoln
	return $dir;								# and return it
}

__END__
