#!/usr/bin/perl -w
use strict;

###############################################################################
#
# $Author: Jan Schaumann <jschauma@netmeister.org> $
# $Id: makeman.pl, v 0.3 2001/09/04 22:02:50 Jan Schaumann Exp $
#
# Copyright (c) 2001, Jan Schaumann <jschauma@netmeister.org>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
#
# * Redistributions of source code must retain the above copyright notice,
#   this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright notice,
#   this list of conditions and the following disclaimer in the documentation
#   and/or other materials provided with the distribution.
# * The names of its contributors may not be used to endorse or promote
#   products derived from this software without specific prior written
#   permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
# ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
# DAMAGE.
#
###############################################################################

use Getopt::Std;
use IPC::Open2;
use SGMLS;

my ($INFILE, $OUTFILE, $DESPARATE);

my $NAME = "makeman.pl";
my $VERSION = "0.3";

my ($listtype, $itemizer, $enumerator, $iterator, $continue, $OUTPUT);

init();
main();

#we're done - bye, bye
exit 0;


#########             #########
#########  Functions  #########
#########             #########

###
# parses command-line options etc.
###
sub init
{
		my %Options;
		my $ok = getopts('dhi:o:v', \%Options);
		if (!$ok)
		{
				my $i;
				my @values = keys(%Options);
				foreach $i (@values)
				{
						if (!$Options{$i})
						{
								print STDERR "Option '$i' requires an argument.\n";
								exit(1);
						}
				}
		}

		if ($Options{'d'})
		{
				$DESPARATE = 1;
		}
		if ($Options{'h'})
		{
				usage();
				exit 0;
		}
		if ($Options{'v'})
		{
				print "$NAME Version $VERSION\n";
				exit 0;
		}
		if ($Options{'i'})
		{
				$INFILE = $Options{'i'};
		}
		if ($Options{'o'})
		{
				$OUTFILE = $Options{'o'};
		}

		if ($#ARGV > -1)
		{
				usage();
				exit(1);
		}

		$iterator = 0;
		$OUTPUT = "";
}

###
# does all the work
###
sub main
{
		my ($parse, $valid);

		# SMGLS works on barewords
		#
		  no strict 'subs';
		  if ($INFILE)
		  {
				  my $pid = open2(\*READ, \*WRITE, "nsgmls $INFILE") || 
						  die "Can't open pipe to \"nsgmls\"!\n";
				  $parse = new SGMLS(READ);
		  }
		  else
		  {
				  $parse = new SGMLS(STDIN);
		  }
		  use strict;
		#
		# back to normal - phew!

		$valid = doParse($parse);

		if (!$valid)
		{
				print STDERR "$NAME: ERROR: \"$INFILE\" does not ";
				print STDERR "appear to be a valid <RefEntry> SGML document!\n";
				if ($DESPARATE)
				{
						print STDERR "Being desparate, I try to write what I got anyway...\n";
						$valid = 1;
				}
		}

		if ($valid)
		{
				if ($OUTFILE)
				{
						open(WRITE, ">$OUTFILE") || 
								die "Can't open \"$OUTFILE\" for writing!\n";
				}
				else
				{
						open (WRITE, ">&STDOUT") ||
								die "Can't write to STDOUT -- WTF??\n";
				}

				$OUTPUT =~ s/^\n//mg;
				$OUTPUT =~ s/\s{2,}\]/ \]/mg;
				$OUTPUT =~ s/(\.S[HS])/\n$1/mg;
				print WRITE $OUTPUT;
		}
	
		close READ;
		close WRITE;
}

###
# begins parsing the document, handing off tasks to other functions
###
sub doParse
{
		my $parse = $_[0];
		my ($event, $valid, $start);

		$valid = 0;

		while ($event = $parse->next_event)
		{
				my $foo;
				if ($event->type eq 'start_element')
				{
						if ($event->data->name eq 'REFENTRY')
						{
								$start = 1;
								printHeaderComments();
						}

						if (!$start)
						{
								return 0;
						}

						if ($event->data->name eq 'REFMETA')
						{
								$event = parseMeta($parse, $event);
						}
						elsif ($event->data->name eq 'REFNAMEDIV')
						{
								$event = parseNameDiv($parse, $event);
						}
						elsif ($event->data->name eq 'REFSYNOPSISDIV')
						{
								$event = parseSynopsis($parse, $event);
						}
						elsif ($event->data->name eq 'REFSECT1')
						{
								$OUTPUT .= "\n.SH ";
								$event = parseSection($parse, $parse->next_event);
						}
				}

				if ($event->type eq 'conforming') 
				{
						$valid = 1;
				}
		}

		return $valid;
}

###
# parses header information: name, section, date, source, title
###
sub parseMeta
{
		my ($parse, $event) = @_;

		my ($title, $volnum, @misc);
		my $i = 0;

		do
		{
				my $type = $event->type;
				my $data = $event->data;

				if ($type eq 'start_element')
				{
						if ($data->name eq 'REFENTRYTITLE')
						{
								$event = $parse->next_event;
								$title = $event->data;
						}
						elsif ($data->name eq 'MANVOLNUM')
						{
								$event = $parse->next_event;
								$volnum = $event->data;
						}
						elsif ($data->name eq 'REFMISCINFO')
						{
								$event = $parse->next_event;
								if ($event->type eq 'cdata')
								{
										$misc[$i++] = $event->data;
								}
								else 
								{
										$misc[$i++] = "";
								}
						}
				}
				elsif ($type eq 'end_element')
				{
						if ($data->name eq 'REFMETA')
						{
								my $tmpt = makeText($title);
								my $tmpv = makeText($volnum);
								$OUTPUT .= ".TH $tmpt $tmpv ";
								
								my $j=0;
								while ($j < $i)
								{
										my $tmp = makeText($misc[$j++]);
										$OUTPUT .= "\"$tmp\" ";
								}
								$OUTPUT .= "\n";
								return $event;
						}
				}

		} while ($event = $parse->next_event);

		return $event;
}

###
# parses name information: name - one line description 
###
sub parseNameDiv
{
		my ($parse, $event) = @_;
		my $namec = 0;

		do
		{
				my $type = $event->type;
				my $data = $event->data;
				
				if ($type eq 'start_element')
				{
						if ($data->name eq 'REFNAME')
						{
								$namec++;
								if ($namec > 1)
								{
										$OUTPUT .= ", ";
								}
								else
								{
										$OUTPUT .= "\n.SH NAME\n";
								}

								$event = $parse->next_event;
								my $tmp = makeText($event->data);
								$OUTPUT .= $tmp;
						}
						elsif ($data->name eq 'REFPURPOSE')
						{
								$event = $parse->next_event;
								my $tmp = makeText($event->data);
								$OUTPUT .= " \\- $tmp\n";
						}
				}
				elsif (($type eq 'end_element') && 
								($data->name eq 'REFNAMEDIV'))
				{
						return $event;
				}

		} while ($event = $parse->next_event);

		return $event;
}

###
# parses synopsis: name [args] [args]
###
sub parseSynopsis
{
		my ($parse, $event) = @_;

		do
		{
				my $type = $event->type;
				my $data = $event->data;

				if ($type eq 'start_element')
				{
						if ($data->name eq 'CMDSYNOPSIS')
						{
								$OUTPUT .= "\n.SH SYNOPSIS\n";
						}
						elsif ($data->name eq 'COMMAND')
						{
								$event = $parse->next_event;
								my $tmp = makeText($event->data);
								$OUTPUT .= "\\fB$tmp\\fR\n";
						}
						elsif ($data->name eq 'ARG')
						{
								if ($data->attribute('CHOICE')->value eq 'OPT')
								{
										$OUTPUT .= "[ ";
								}
								
								do
								{
										$event = $parse->next_event;
								} while ($event->type eq 'start_element');

								my $tmp = makeText($event->data);
								$OUTPUT .= "\\fI$tmp\\fR";
								
								if ($data->attribute('REP')->value eq 'REPEAT')
								{
										$OUTPUT .= "...";
								}
						}
				}
				elsif ($type eq 'end_element')
				{

						if ($data->name eq 'ARG')
						{
								$OUTPUT .= " ";

								if ($data->attribute('CHOICE')->value eq 'OPT')
								{
										$OUTPUT .= "] ";
								}
						}
						elsif ($data->name eq 'CMDSYNOPSIS')
						{
								$OUTPUT .= "\n";
								return $event;
						}
				}
		} while ($event = $parse->next_event);

		return $event;
}

###
# recursively parses sections
###
sub parseSection
{
		my ($parse, $event) = @_;

		my $target = "";

		do
		{
				my $type = $event->type;
				my $data = $event->data;

				if ($type eq 'start_element')
				{
						if ($data->name eq 'TITLE')
						{
								$OUTPUT .= "\"";
						}
						elsif ($data->name eq 'PARA')
						{
								$OUTPUT .= ".PP\n";
						}
						elsif ($data->name eq 'COMMAND')
						{
								$OUTPUT .= "\\fB";
						}
						elsif (($data->name eq 'EMPHASIS') ||
								($data->name eq 'REPLACEABLE') ||
								($data->name eq 'FILENAME') )

						{
								$OUTPUT .= "\\fI";
						}
						elsif ($data->name eq 'VARIABLELIST')
						{
								$OUTPUT .= ".\\\" Begin List\n";
						}
						elsif ($data->name eq 'VARLISTENTRY')
						{
								$OUTPUT .= ".TP\n";
						}
						elsif ($data->name eq 'OPTIONAL')
						{
								$OUTPUT .= "[ ";
						}
						elsif ($data->name eq 'TERM')
						{
								return parseSection($parse,$parse->next_event);
						}
						elsif ($data->name eq 'ORDEREDLIST')
						{
								$itemizer = ".IP";
								$enumerator = $data->attribute('NUMERATION')->value;
								$continue = $data->attribute('CONTINUATION')->value;

								if ($continue eq 'RESTARTS')
								{
										$iterator = 0;
										if ($enumerator)
										{
												if ($enumerator =~ m/loweralpha/i)
												{
														$iterator = "\141";
												}
												elsif ($enumerator =~ m/upperalpha/i)
												{
														$iterator = "\101";
												}

										}
								}

								my $spacing = $data->attribute('SPACING')->value;
								if ($spacing)
								{
										if ($spacing=~ m/compact/i)
										{
												$itemizer .= " 3";
										}
								}
								else
								{
										$itemizer .= " 9";
								}

								$itemizer .= "\n";
						}
						elsif ($data->name eq 'ITEMIZEDLIST')
						{
								$OUTPUT .= ".RS 0\n";
								$itemizer = ".IP";
								my $item = $data->attribute('MARK')->value;
								if ($item)
								{
										if ($item =~ m/bullet/i)
										{
												$itemizer .= " \\(bu";
										}
										elsif ($item =~ m/emdash/i)
										{
												$itemizer .= " \\(em";
										}
								}
								
								my $spacing = $data->attribute('SPACING')->value;
								if ($spacing)
								{
										if ($spacing=~ m/compact/i)
										{
												$itemizer .= " 3";
										}
								}

								$itemizer .= "\n";
						}
						elsif ($data->name eq 'LISTITEM')
						{
								# only gobble next element if it's "<para>"
								my $tmp = $event;
								$event = $parse->next_event;
								if ( ($event->type eq 'start_element') &&
											($event->data ne 'PARA') )
								{
										$event = $tmp;
								}
								
								my $override = $data->attribute('OVERRIDE')->value;
								if ($override)
								{
										my $spacing = "";
										if ($itemizer =~ m/\.IP.*(\d)/)
										{
												$spacing = $1;
										}
										if ($override =~ m/bullet/i)
										{
												$itemizer = ".IP \\(bu $spacing\n";
										}
										elsif ($override =~ m/emdash/i)
										{
												$itemizer = ".IP \\(em $spacing\n";
										}
								}


								if ($parse->element->parent->parent->name eq 'ITEMIZEDLIST')
								{
										$OUTPUT .= $itemizer;
								}

								if ($parse->element->parent->parent->name eq 'ORDEREDLIST')
								{
										my $spacing = "";
										if ($itemizer =~ m/\.IP.*(\d)/)
										{
												$spacing = $1;
										}
										$itemizer = ".IP $iterator $spacing\n";
										$iterator++;

										$OUTPUT .= $itemizer;
								}
								
						}
						elsif ($data->name eq 'ULINK')
						{
								$target = $data->attribute('URL')->value;
						}
						elsif ($data->name eq 'SIMPLELIST')
						{
								$listtype = $data->attribute('TYPE')->value;
						}
						elsif ($data->name eq 'MEMBER')
						{
								if ($listtype eq 'VERT')
								{
										$OUTPUT .= "\n.br\n";
								}
						}
						elsif ($data->name eq 'EMAIL')
						{
								$OUTPUT .= "<";
						}
						elsif ($data->name eq 'REFSECT2')
						{
								$OUTPUT .= "\n.SS ";
								$event=parseSection($parse,$parse->next_event);
						}
				}
				elsif ( ($type eq 'cdata') || ($type eq 'sdata') )
				{
						if ($parse->element->name eq 'TERM')
						{
								if ($data =~ m/(-.*)+(,\s*-.*)/g)
								{
										$data =~ s/(-.*)+(,\s*-.*)/\\fB$1$2\\fR/g;
								}
								else
								{
										$data =~ s/(-.*)+/\\fB$1\\fR/g;
								}
						}

						my $text = makeText($data);
						$OUTPUT .= "$text";
				}
				elsif ($type eq 'end_element')
				{
						if ( ($data->name eq 'REFSECT1') ||
										($data->name eq 'REFSECT2') ||
										($data->name eq 'REFSECT3') )
						{
								return $event;
						}
						elsif ($data->name eq 'TITLE')
						{
								$OUTPUT .= "\"\n";
						}
						elsif ($data->name eq 'EMAIL')
						{
								$OUTPUT .= ">";
						}
						elsif ($data->name eq 'TERM')
						{
								$OUTPUT .= "\n";
						}
						elsif ($data->name eq 'OPTIONAL')
						{
								$OUTPUT .= " ]";
						}
						elsif ($data->name eq 'SIMPLELIST')
						{
								$listtype = "";
						}
						elsif ( ($data->name eq 'ITEMIZEDLIST') ||
									($data->name eq 'ORDEREDLIST') )
						{
								$itemizer = "";
								$OUTPUT .= ".RE\n";
						}
						elsif ($data->name eq 'MEMBER')
						{
								if ( ($listtype eq 'INLINE') &&
										($parse->next_event->data->name eq 'MEMBER') )
								{
										$OUTPUT .= ", ";
								}
						}
						elsif ($data->name eq 'ULINK')
						{
								if (!$target)
								{
										return $event;
								}
								$OUTPUT .= " (Link to \\fI$target\\fR)";
						}
						elsif ( ($data->name eq 'COMMAND') || 
										($data->name eq 'EMPHASIS') ||
										($data->name eq 'FILENAME') ||
										($data->name eq 'REPLACEABLE') )
						{
								$OUTPUT .= "\\fR";
						}
						elsif ($data->name eq 'PARA')
						{
								$OUTPUT .= "\n";
						}
						elsif ($data->name eq 'VARIABLELIST')
						{
								$OUTPUT .= ".\\\" End List\n";
						}
				}
				elsif ($type eq 'conforming')
				{
						return $event;
				}

		} while ($event = $parse->next_event);

		return $event;
}

###
# prints some information into the header
###
sub printHeaderComments
{
		my ($Second, $Minute, $Hour, $Day, $Month, $Year) = localtime(time);
		$Year += 1900;
		$Month += 1;
		if ($Month < 10)
		{
				$Month = "0" . $Month;
		}
		if ($Day < 10)
		{
				$Day = "0" . $Day;
		}
		if ($Minute < 10)
		{
				$Minute = "0" . $Minute;
		}
		if ($Second< 10)
		{
				$Second= "0" . $Second;
		}
		$OUTPUT .= ".\\\"\n";
		$OUTPUT .= ".\\\" This page was created on $Year-$Month-$Day ";
		$OUTPUT .= "$Hour:$Minute:$Second by $NAME\n";
		$OUTPUT .= ".\\\" ``$NAME'' is part of the ``MakeMan'' project.\n";
		$OUTPUT .= ".\\\" For more information, please see ";
		$OUTPUT .= "http://mama.sourceforge.net\n";
		$OUTPUT .= ".\\\"\n";
}

###
# strips the SGML input of special characters etc.
###
sub makeText
{
		my $text = $_[0];
		$text =~ s/\[gt    \]/>/g;
		$text =~ s/\[lt    \]/</g;
		$text =~ s/\[amp    \]/\&/g;
		$text =~ s/-/\\-/g;
		$text =~ s/\s{2,}/\n/g;
		return $text;
}

###
# prints out helpful information
###
sub usage
{
		print "$NAME: parse an SGML man page into valid roff source\n";
		print "Usage: $NAME [OPTION...]\n";
		print "Options:\n";
		print "  -d\t\tdesperate: write output even if input was not valid\n";
		print "  -h\t\tprint this message and exit\n";
		print "  -i FILE\tread input from FILE\n";
		print "  -o FILE\twrite output to FILE\n";
		print "  -v\t\tprint version number and exit\n";
}
