#!/usr/bin/perl
require 5;
##===================================================================##
##  Program name:   ebind                                            ##
##  Version:        1.0 (MS Windows 3.1 version)                     ##
##  Author:         Alvin Pollock (apollock@library.berkeley.edu)    ##
##  Date completed: 1/17/97                                          ##
##                                                                   ##
##  Description:    Ebind generates a complete ebind sgml file and   ##
##                  an associated file of entity declarations when   ##
##                  given an ebind worksheet as input.               ##
##                                                                   ##
##  Note:           Perl version 5 is required to run ebind.         ##
##===================================================================##


$DefaultFileExt = ".tif";
$DefaultNotation = "tiff";

$datfile = $ARGV[0];
$outfile = $datfile;
$entfile = $datfile;
if ($outfile =~ /\./) {
	substr ($outfile, rindex($outfile, '.')) = '.sgm';
} else {
	$outfile = "$outfile\.sgm";
}
if ($entfile =~ /\./) {
	substr ($entfile, rindex($entfile, '.')) = '.ent';
} else {
	$entfile = "$entfile\.ent";
}
$datfile =~ /([-a-z0-9]+)(\.[-a-z0-9]*)?$/i && ($rootname = $1);
$rootname =~ tr/A-Z/a-z/;
&romanstart;

open (DATFILE, $datfile) || die "Couldn't open $datfile: $!\nAaaaaaaaaaaaaaaaaaah!\n[Crash and burn]\n";
&Types;
$valid = 1;
while ($line = <DATFILE>) {
	$linenum++;
	next if $line =~ /^\s*$/;			# Skip blank lines
	next if $line =~ /^\s*[#\/]/;		# Skip comments
	unless ($structflag || $seqflag) {
		$line =~ /^\s*ID Num:\s*/i && (chomp($IDNum = $'), next);
		$line =~ /^\s*Author:\s*/i && (chomp($Author = $'), next);
		$line =~ /^\s*Title:\s*/i && (chomp($Title = $'), next);
		$line =~ /^\s*Subtitle:\s*/i && (chomp($Subtitle = $'), next);
		$line =~ /^\s*Edition:\s*/i && (chomp($Edition = $'), next);
		$line =~ /^\s*Pubplace:\s*/i && (chomp($Pubplace = $'), next);
		$line =~ /^\s*Publisher:\s*/i && (chomp($Publisher = $'), next);
		$line =~ /^\s*Pubyear:\s*/i && (chomp($Pubyear = $'), next);
		$line =~ /^\s*Series:\s*/i && (chomp($Series = $'), next);
	}
	if ($line =~ /--\s*structure/i) {
		$structflag = 1;
		$structexist = 1;
		$seqflag = 0;
		next;
	}
	if ($line =~ /--\s*sequence/i) {
		$seqflag = 1;
		$structflag = 0;
		next;
	}
	if ($line =~ /^\s*front\s*$/i) {
		$docpart = "front";
		$frontexists = 1;
		next;
	}
	if ($line =~ /^\s*body\s*$/i) {
		$docpart = "body";
		next;
	}
	if ($line =~ /^\s*back\s*$/i) {
		$docpart = "back";
		next;
	}
	if ($structflag) {
		&BuildStruct($line);
		next;
	}
	if ($seqflag) {
		&BuildSeq($line);
		next;
	}
}

close DATFILE;
&UpdateStruct;
&ValidateSeq;
&ValidateStruct;
&GenerateSGML if $valid;
&PrintOutput if $valid;

## End Program




##=================================================================##
## Subroutines.                                                    ##
##=================================================================##


sub BuildStruct {
	my($line) = @_;
	my($nestlevel, $type, $seq, $head, $explicit);
	if ($line =~ /^\s*\d\s/) {
		$explicit = 1;
		($nestlevel, $type, $seqrange, $head) = $line =~ /^\s*(\d)\s+([^\s]+)\s+([^\s]+)\s*(.*)$/;
	} else {
		$nestlevel = 0;
		$explicit = 0;
		($type, $seqrange, $head) = $line =~ /^\s*([^\s]+)\s+([^\s]+)\s*(.*)$/;
	}
	
	my($record) = {};		# Initialize a reference to an anonymous hash;
	$record->{docpart} = $docpart if $docpart;
	$record->{seqrange} = $seqrange;
	$record->{nestlevel} = $nestlevel;
	$record->{type} = $type;
	$record->{explicit} = $explicit;
	if ($seqrange =~ /([^-]+)-(.*)/) {
		$record->{seq1} = $1;
		$record->{seq2} = $2;
	} else {
		$record->{seq1} = $seqrange;
		$record->{seq2} = $seqrange;
	}
	$record->{head} = $head;
	$record->{linenum} = $linenum;
	push @struct, $record;		# Add the record to a global array;
}

sub BuildSeq {
	my($line) = @_;
	my($seqrange, $filerange, $pagerange) = $line =~ /^\s*([^\s]+)\s+([^\s]+)\s*([^\s]+)?\s*$/;
	my($record) = {};
	$record->{seqrange} = $seqrange;
	$record->{filerange} = $filerange;
	$record->{pagerange} = $pagerange;
	if ($seqrange =~ /([^-]+)-(.*)/) {
		$record->{seq1} = $1;
		$record->{seq2} = $2;
	} else {
		$record->{seq1} = $seqrange;
		$record->{seq2} = $seqrange;
	}
	if ($filerange =~ /([^-]+)-(.*)/) {
		my $filename1 = $1;
		my $filename2 = $2;
		if ($filename1 =~ /(\..*)$/) {
			$record->{file1} = $`;
			$FileExt = $1;
		} else {
			$record->{file1} = $filename1;
		}
		if ($filename2 =~ /(\..*)$/) {
			$record->{file2} = $`;
		} else {
			$record->{file2} = $filename2;
		}
	} else {
		if ($filerange =~ /(\..*)$/) {
			$record->{file1} = $`;
			$record->{file2} = $`;
			$FileExt = $1;
		} else {
			$record->{file1} = $filerange;
			$record->{file2} = $filerange;
		}
	}
	if ($pagerange =~ /([^-]+)-(.*)/) {
		$record->{page1} = $1;
		$record->{page2} = $2;
	} else {
		$record->{page1} = $pagerange;
		$record->{page2} = $pagerange;
	}
	$record->{linenum} = $linenum;
	push @seq, $record;
	
}


##-------------------------------------------------------------------##
##                     Update Structure                              ##
##-------------------------------------------------------------------##
## This subroutine studies the sequence of div types in the @struct  ## 
## array in an attempt to decide where the front, body, and back of  ##
## the document begin and end. It will also intelligently order some ##
## elements hierarchically, e.g., a chapter following a part is      ##
## assumed to fall *within* the part.                                ##
##-------------------------------------------------------------------##
sub UpdateStruct {
	my($front, $body, $back, $lasttype, $type, $lastdocpart, $docpart);
	my($implied0, $implied1, $implied2);
	foreach $rec (@struct) {
		$lasttype = $type;
		$type = $rec->{type};
		unless ($rec->{docpart}) {
			if (grep /$rec->{type}/i, @bodytrigger) {
				$body = 1;
				$rec->{docpart} = "body";
			} elsif (grep /$rec->{type}/i, @backtrigger) {
				$body = 0;
				$back = 1;
				$rec->{docpart} = "back";
			} elsif ($rec->{type} =~ /^intro/i && !$body) {
				foreach $seq (@seq) {
					if ($seq->{seq1} <= $rec->{seq1} && $rec->{seq1} <= $seq->{seq2}) {
						if ($seq->{pagerange} =~ /^[-ivxlcdm]+$/i) {
							$rec->{docpart} = "front";
							$frontexists = 1;
						} elsif ($seq->{pagerange} =~ /^[-0-9]+$/) {
							$body = 1;
							$rec->{docpart} = "body";
						} else {
							$rec->{docpart} = "front";
							$frontexists = 1;
						}
					}
				}
			} elsif (!$body && !$back) {
				$rec->{docpart} = "front";
				$frontexists = 1;
			} elsif ($back) {
				$rec->{docpart} = "back";
			} else {
				$rec->{docpart} = "body";
			}
		}

		$lastdocpart = $docpart;
		$docpart = $rec->{docpart};
		unless ($rec->{explicit}) {
			if (grep /$type/i, @implied0) {
				$implied0 = 1;
				$implied1 = 0;
				$implied2 = 0;
			} elsif (grep /$type/i, @implied1) {
				$implied1 = 1;
				$implied2 = 0;
				if ($implied0) {
					$rec->{nestlevel} = 1;
				}
			} elsif (grep /$type/i, @implied2) {
				$implied2 = 1;
				if ($implied1) {
					if ($implied0) {
						$rec->{nestlevel} = 2;
					} else {
						$rec->{nestlevel} = 1;
					}
				}
			} else {
				$implied0 = 0;
				$implied1 = 0;
				$implied2 = 0;
			}
		}
	}
}


##-------------------------------------------------------------------##
##                     Validate Sequence                             ##
##-------------------------------------------------------------------##
## This subroutine loops through the @seq array checking each record ##
## to see if is valid. It checks the following:                      ##
##    1. Sequence numbers are purely numeric and never decrease.     ##
##       If a range is given, the second sequence number of the      ##
##       range is never smaller than the first. There are no gaps,   ##
##       i.e., every sequence number is accounted for.               ##
##    2. Filenames may "decrease", but if a range is given, the      ##
##       second filename may not be "smaller" than the first. Also,  ##
##       if a range is given, there must be a recognizable numeric   ##
##       component to the filename that increases by one.            ##
##    3. Page numbers may decrease, but if a range is given, the     ##
##       second page number may not be smaller than the first.       ##
##       Page numbers must be either purely numeric or roman numerals##
##       when part of a range.                                       ##
##    4. Each of the three ranges in a record must be equal.         ##
##-------------------------------------------------------------------##
sub ValidateSeq {
#	print "Validating Sequence ...";
	my($lastseq, $seq2, $lastrange, $seqrange, $linenum, $filenum1, $filenum2, $page1, $page2);
	foreach $rec (@seq) {
		$lastrange = $seqrange;
		$seqrange = $rec->{seqrange};
		$lastseq = $seq2;
		$seq2 = $rec->{seq2};
		$linenum = $rec->{linenum};
		unless ($rec->{seq1} =~ /^\d+$/ && $rec->{seq2} =~ /^\d+$/) {
			print "Error line $linenum: \"$seqrange\" -- Sequence numbers must be numeric.\n";
			$seqerror = 1;
			$nonseqnumerror = 1;
			$valid = 0;
		}
		if ($rec->{seq2} < $rec->{seq1}) {
			print "Error line $linenum: \"$seqrange\" -- Sequence range must be positive.\n" unless $nonseqnumerror;
			$seqerror = 1;
			$valid = 0;
		}
		if ($rec->{seq1} <= $lastseq) {
			print "Error lines ", $linenum-1, " & $linenum: \"$lastrange\n";
			print "                      $seqrange\" -- Sequence ranges may not overlap.\n" unless $nonseqnumerror;
			$seqerror = 1;
			$valid = 0;
		}
		if ($rec->{seq1} > $lastseq + 1) {
			my($missing) = $rec->{seq1} - $lastseq;
			print "Error lines ", $linenum-1, " & $linenum: \"$lastrange\n" unless $nonseqnumerror;
			print "                      $seqrange\" -- " unless $nonseqnumerror;
			if ($missing == 2) {
				print "Sequence number ", $lastseq + 1, " missing.\n" unless $nonseqnumerror;
			} else {
				print "Sequence numbers ", $lastseq + 1, "-", $rec->{seq1} - 1, " missing.\n" unless $nonseqnumerror;
			}
			$seqerror = 1;
			$valid = 0;
		}

		if ($rec->{file1} =~ /(\d+)[a-zA-Z]$/) {
			$rec->{file1} =~ /(\d+)[a-zA-Z]$/ && ($filenum1 = $1);
			$rec->{file2} =~ /(\d+)[a-zA-Z]$/ && ($filenum2 = $1);
		} elsif ($rec->{file1} =~ /(\d+)$/) {
			$rec->{file1} =~ /(\d+)$/ && ($filenum1 = $1);
			$rec->{file2} =~ /(\d+)$/ && ($filenum2 = $1);
		}
		unless ($filenum2 - $filenum1 == $rec->{seq2} - $rec->{seq1}) {
			print "Error line $linenum: \"$rec->{filerange}\" -- File range does not equal sequence range.\n";
			$seqerror = 1;
			$valid = 0;
		}
		
		if ($rec->{pagerange} =~ /^[-0-9]+$/) {
			$page1 = $rec->{page1};
			$page2 = $rec->{page1};
		} elsif ($rec->{pagerange} =~ /^[-ivxlcdm]+/i) {
		
		} elsif ($rec->{pagerange}) {
			print "Error line $linenum: \"$rec->{pagerange}\" -- Unrecognized paging scheme.\n";
			$seqerror = 1;
			$valid = 0;
		}
		unless ($page2 - $page1 == $rec->{seq1} - $rec->{seq1}) {
			print "Error line $linenum: \"$rec->{pagerange}\" -- Page range does not equal sequence range.\n";
			$seqerror = 1;
			$valid = 0;
			print "\$page1 = \"$page1\"\n";
			print "\$page2 = \"$page2\"\n";
			print "\$rec->{seq1} = \"$rec->{seq1}\"\n";
			print "\$rec->{seq2} = \"$rec->{seq2}\"\n";
		}
	}
}


##-------------------------------------------------------------------##
##                     Validate Structure                            ##
##-------------------------------------------------------------------##
## This subroutine loops through the @struct array checking a        ##
## few different things to make sure each record is valid, e.g.,     ##
##    1. Nest levels, if given, increment by no more than 1.         ##
##       Some types cannot have a nestlevel of anything other than   ##
##       0, e.g., a titlepage or cover.                              ##
##    2. The struct type is valid according to the &Types            ##
##       subroutine provided at the end of this program.             ##
##    3. Sequence numbers are purely numeric and never decrease.     ##
##       If a range is given, the second sequence number of the      ##
##       range is never smaller than the first. No sequence          ##
##       numbers are larger than the largest sequence number         ##
##       specified in the @seq array.                                ##
##-------------------------------------------------------------------##
sub ValidateStruct {
#	print "Validating Structure ...";
	my($lastnest, $nestlevel, $linenum);
	foreach $rec (@struct) {
		$lastnest = $nestlevel;
		$nestlevel = $rec->{nestlevel};
		$linenum = $rec->{linenum};
		if ($nestlevel - $lastnest > 1) {
			print "Error line $linenum: \"$rec->{nestlevel}\" -- Nesting level may not increase by more than 1.\n";
			$valid = 0;
		}
		if ($nestlevel > 0 && $rec->{type} =~ /($nest0)/i) {
			print "Error line $linenum: \"$rec->{nestlevel} $rec->{type}\" -- \u$rec->{type} may not have a nesting level other than 0.\n";
			$valid = 0;
		}
		if ($rec->{docpart} eq "front" && !grep /^$rec->{type}$/i, @front) {
			print "Error line $linenum: \"$rec->{type}\" -- \u$rec->{type} not allowed in front matter.\n";
			$valid = 0;
		}
		if ($rec->{docpart} eq "body" && !grep /^$rec->{type}$/i, @body) {
			print "Error line $linenum: \"$rec->{type}\" -- \u$rec->{type} not allowed in document body.\n";
			$valid = 0;
		}
		if ($rec->{docpart} eq "back" && !grep /^$rec->{type}$/i, @back) {
			print "Error line $linenum: \"$rec->{type}\" -- \u$rec->{type} not allowed in back matter.\n";
			$valid = 0;
		}
		unless ($rec->{seq1} =~ /^\d+$/ && $rec->{seq2} =~ /^\d+$/) {
			print "Error line $linenum: \"$rec->{seqrange}\" -- Sequence numbers must be numeric.\n";
			$valid = 0;
		}
		if ($rec->{seq2} < $rec->{seq1}) {
			print "Error line $linenum: \"$rec->{seqrange}\" -- Sequence range must be positive.\n" unless $nonseqnumerror;
			$valid = 0;
		}
		if ($rec->{seq2} > $seq[$#seq]{seq2} && !$seqerror) {
			print "Error line $linenum: \"$rec->{seqrange}\" -- Sequence number $rec->{seq2} too high. Max. value is $seq[$#seq]{seq2}.\n";
			$valid = 0;
		}
	}
}


sub GenerateSGML {
	open (OUTFILE, ">$outfile") || die "Couldn't write to $outfile: $!\nAaaaaaaaaaaaaaaaaaah!\n[Crash and burn]\n";
	open (ENTFILE, ">$entfile") || die "Couldn't write to $entfile: $!\nAaaaaaaaaaaaaaaaaaah!\n[Crash and burn]\n";
	&PrintEntfileHeader;
	&PrintDeclaration;
	&PrintHeader;
	&PrintDocuments;
}

sub PrintEntfileHeader {
	print ENTFILE "<!-- External graphic file entities for:\n\n";

    print ENTFILE "System:  GLADIS\n" if $IDNum;
    print ENTFILE "Bibid:   $IDNum\n" if $IDNum;
    print ENTFILE "Author:  $Author\n" if $Author;
    print ENTFILE "Title:   $Title\n" if $Title;
    print ENTFILE "Edition: $Edition\n" if $Edition;
	if ($Pubplace || $Publisher || $Pubyear) {
		print ENTFILE "Imprint: ";
		print ENTFILE "$Pubplace" if $Pubplace;
		if ($Pubplace && $Publisher) {
			print ENTFILE " : $Publisher";
		} elsif ($Publisher) {
			print ENTFILE "$Publisher";
		}
		if (($Pubplace || $Publisher) && $Pubyear) {
			print ENTFILE ", ";
		}
		
		print ENTFILE "$Pubyear\n" if $Pubyear;
	}    
     
	print ENTFILE "\n-->\n\n";
}

sub PrintDeclaration {
print OUTFILE<<EndDeclaration;
<!DOCTYPE EBIND PUBLIC \"-//UC Berkeley//DTD ebind.dtd (Electronic 
Binding (Ebind))//EN\" [
<!ENTITY % $rootname PUBLIC \"-//UC Berkeley//ENTITIES
$Title (Page Images)//EN\">
\%$rootname;
]>
EndDeclaration
}

sub PrintHeader {
	print OUTFILE "<ebind type=\"book\">\n<ebindheader>\n";
	print OUTFILE "<bibid systemid=\"GLADIS\">$IDNum</bibid>\n" if $IDNum;
	print OUTFILE "<filedesc>\n<titlestmt>\n<titleproper>$Title</titleproper>\n";
	print OUTFILE "<subtitle>$Subtitle</subtitle>\n" if $Subtitle;
	print OUTFILE "<author>$Author</author>\n" if $Author;
	print OUTFILE "</titlestmt>\n";
	print OUTFILE "<editionstmt><edition>$Edition</edition></editionstmt>\n" if $Edition;
	if ($Pubplace || $Publisher || $Pubyear) {
		print OUTFILE "<publicationstmt>\n";
		print OUTFILE "<pubplace>$Pubplace</pubplace>\n" if $Pubplace;
		print OUTFILE "<publisher>$Publisher</publisher>\n" if $Publisher;
		print OUTFILE "<date>$Pubyear</date>\n" if $Pubyear;
		print OUTFILE "</publicationstmt>\n";
	}
	print OUTFILE "<seriesstmt>\n<titleproper>$Series</titleproper>\n</seriesstmt>\n" if $Series;
	print OUTFILE "</filedesc>\n</ebindheader>\n";
}

sub PrintDocuments {
	my($docpart, $lastdocpart, $nestlevel, $lastnestlevel, $divflag, $entityref, $nativeno);
	my($digit, $letter, $pad, $prefix, $suffix, $romanlowercase, $romanuppercase, $arabic, $roman);
	my $structcounter = 0;
	print OUTFILE "<$struct[0]->{docpart}>\n";
	foreach $seq (@seq) {
		if ($seq->{page1} =~ /^[0-9]+$/) {
			$romanuppercase = 0;
			$romanlowercase = 0;
		} elsif ($seq->{page1} =~ /^[IVXLCDM]+/) {
			$romanuppercase = 1;
			$romanlowercase = 0;
		} elsif ($seq->{page1} =~ /^[ivxlcdm]+/i) {
			$romanlowercase = 1;
			$romanuppercase = 0;
		}
		$nativeno = $seq->{page1};
		if ($seq->{file1} =~ /(\d+)([a-zA-Z])$/ && ($digit = $1, $letter = $2, $prefix = $`)) {
			
		} elsif ($seq->{file1} =~ /(\d+)$/ && ($digit = $1, $prefix = $`)) {
			if ($digit =~ /^0\d+$/ && ($pad = length($digit))) {
				$suffix = sprintf("%0${pad}d", $digit);
			} else {
				$suffix = $digit;
			}
		}
		for ($i = $seq->{seq1}; $i <= $seq->{seq2}; $i++) {
			while ($i == $struct[$structcounter]->{seq1}) {
				$lastnestlevel = $nestlevel;
				$nestlevel = $struct[$structcounter]->{nestlevel};
				$lastdocpart = $docpart;
				$docpart = $struct[$structcounter]->{docpart};
				if ($struct[$structcounter]->{type} =~ /^cover/i) {
					print OUTFILE "<cover>\n";
				} else {
					if ($nestlevel == 0 && $divflag) {
						if ($lastnestlevel == 5) {
							print OUTFILE "</div5></div4></div3></div2></div1></div0>\n";
						} elsif ($lastnestlevel == 4) {
							print OUTFILE "</div4></div3></div2></div1></div0>\n";
						} elsif ($lastnestlevel == 3) {
							print OUTFILE "</div3></div2></div1></div0>\n";
						} elsif ($lastnestlevel == 2) {
							print OUTFILE "</div2></div1></div0>\n";
						} elsif ($lastnestlevel == 1) {
							print OUTFILE "</div1></div0>\n";
						} elsif ($lastnestlevel == 0) {
							print OUTFILE "</div0>\n";
						} else {
						
						}
					} elsif ($nestlevel == 1) {
						if ($lastnestlevel == 5) {
							print OUTFILE "</div5></div4></div3></div2></div1>\n";
						} elsif ($lastnestlevel == 4) {
							print OUTFILE "</div4></div3></div2></div1>\n";
						} elsif ($lastnestlevel == 3) {
							print OUTFILE "</div3></div2></div1>\n";
						} elsif ($lastnestlevel == 2) {
							print OUTFILE "</div2></div1>\n";
						} elsif ($lastnestlevel == 1) {
							print OUTFILE "</div1>\n";
						} else {
						
						}
					} elsif ($nestlevel == 2) {
						if ($lastnestlevel == 5) {
							print OUTFILE "</div5></div4></div3></div2>\n";
						} elsif ($lastnestlevel == 4) {
							print OUTFILE "</div4></div3></div2>\n";
						} elsif ($lastnestlevel == 3) {
							print OUTFILE "</div3></div2>\n";
						} elsif ($lastnestlevel == 2) {
							print OUTFILE "</div2>\n";
						} else {
						
						}
					} elsif ($nestlevel == 3) {
						if ($lastnestlevel == 5) {
							print OUTFILE "</div5></div4></div3>\n";
						} elsif ($lastnestlevel == 4) {
							print OUTFILE "</div4></div3>\n";
						} elsif ($lastnestlevel == 3) {
							print OUTFILE "</div3>\n";
						} else {
						
						}
					} elsif ($nestlevel == 4) {
						if ($lastnestlevel == 5) {
							print OUTFILE "</div5></div4>\n";
						} elsif ($lastnestlevel == 4) {
							print OUTFILE "</div4>\n";
						} else {
						
						}
					} elsif ($nestlevel == 5) {
						if ($lastnestlevel == 5) {
							print OUTFILE "</div5>\n";
						} else {
						
						}
					}
					$divflag = 1;
					if ($lastdocpart ne $docpart && $docpart ne "front") {
						print OUTFILE "</$lastdocpart>\n<$docpart>\n";
					}
					print OUTFILE "<div$struct[$structcounter]->{nestlevel} type=\"$types{$struct[$structcounter]->{type}}\">\n";
					print OUTFILE "<head>$struct[$structcounter]->{head}</head>\n" if $struct[$structcounter]->{head};
				}
				$structcounter++;
			} #  end while
			$entityref = $prefix.$suffix;
			&PrintEntities($entityref);
			print OUTFILE "<page><image entityref=\"$entityref\" seqno=\"$i\"";
			print OUTFILE " nativeno=\"$nativeno\"" if $nativeno;
			print OUTFILE "></page>\n";
			$suffix++;
			if ($seq->{page1}) {
				if ($romanlowercase) {
					$arabic = &arabic($nativeno);
					$nativeno = &roman(++$arabic);
				} elsif ($romanuppercase) {
					$arabic = &arabic($nativeno);
					$nativeno = uc(&roman(++$arabic));
				} else {
					$nativeno++;
				}
			}
		} # end for $seq1..$seq2

	} # end foreach @seq

	if ($nestlevel == 5) {
		print OUTFILE "</div5></div4></div3></div2></div1></div0>\n";
	} elsif ($nestlevel == 4) {
		print OUTFILE "</div4></div3></div2></div1></div0>\n";
	} elsif ($nestlevel == 3) {
		print OUTFILE "</div3></div2></div1></div0>\n";
	} elsif ($nestlevel == 2) {
		print OUTFILE "</div2></div1></div0>\n";
	} elsif ($nestlevel == 1) {
		print OUTFILE "</div1></div0>\n";
	} elsif ($nestlevel == 0) {
		print OUTFILE "</div0>\n";
	}
	print OUTFILE "</$docpart>\n</ebind>\n";
}

sub PrintEntities {
	my($entityref) = @_;
	my($notation);
	print ENTFILE "<!ENTITY $entityref SYSTEM \"$entityref$FileExt\" NDATA ";
	if ($FileExt =~ /\.tif/i) {
		$notation = "tiff";
	} elsif ($FileExt =~ /\.jp/i) {
		$notation = "jpeg";
	} elsif ($FileExt =~ /\.gif/i) {
		$notation = "gif";
	} else {
		$notation = $DefaultNotation;
	}
	print ENTFILE "$notation>\n";
}

sub PrintOutput {
	my($docpart, $lastdocpart);
	foreach $struct (@struct) {
		$lastdocpart = $docpart;
		$docpart = $struct->{docpart};
		if ($docpart ne $lastdocpart) {
			print "FRONT\n" if $docpart eq "front";
			print "\nBODY\n" if $docpart eq "body";
			print "\nBACK\n" if $docpart eq "back";
		}
		print "  " x ($struct->{nestlevel} + 1);
		print "$struct->{type}\n";
		
	}
}

sub Types {
	%types = ('cover'            => 'cover',
	          'titlepage'        => 'titlepage',
	          'tp'               => 'titlepage',
	          'toc'              => 'contents',
	          'contents'         => 'contents',
	          'acknowledgements' => 'acknowledgements',
	          'ack'              => 'acknowledgements',
	          'advertisements'   => 'advertisements',
	          'advertisement'    => 'advertisements',
	          'ads'              => 'advertisements',
	          'dedication'       => 'dedication',
	          'errata'           => 'errata',
	          'portrait'         => 'portrait',
	          'introduction'     => 'introduction',
	          'intro'            => 'introduction',
	          'section'          => 'section',
	          'subsection'       => 'subsection',
	          'plates'           => 'plates',
	          'foreword'         => 'foreword',
	          'notes'            => 'notes',
	          'volume'           => 'volume',
	          'part'             => 'part',
	          'chapter'          => 'chapter',
	          'article'          => 'article',
	          'index'            => 'index',
	          'entry'            => 'entry',
	          'bibliography'     => 'bibliography',
	          'bib'              => 'bibliography',
	          'bibl'             => 'bibliography');

	@front = ('cover',
	          'titlepage',
	          'tp',
	          'toc',
	          'contents',
	          'acknowledgements',
	          'ack',
	          'advertisements',
	          'advertisement',
	          'ads',
	          'dedication',
	          'errata',
	          'portrait',
	          'introduction',
	          'intro',
	          'section',
	          'subsection',
	          'plates',
	          'foreword',
	          'notes');
	          
	@body =  ('book',
	          'volume',
	          'part',
	          'chapter',
	          'entry',
	          'errata',
	          'introduction',
	          'intro',
	          'section',
	          'subsection',
	          'bibliography',
	          'plates',
	          'index',
	          'advertisements',
	          'advertisement',
	          'ads',
	          'article',
	          'notes');
	
	@back =  ('bibliography',
	          'index',
	          'advertisements',
	          'advertisement',
	          'ads',
	          'toc',
	          'contents',
	          'acknowledgements',
	          'ack',
	          'dedication',
	          'errata',
	          'notes',
	          'plates',
	          'portrait');
	
	$nest0 = "tp|titlepage|cover";
	
	@fronttrigger = ('tp',
	                 'titlepage',
	                 'cover',
	                 'foreword',
	                 'toc',
	                 'acknowledgements',
	                 'ack',
	                 'dedication',
	                 'contents');
	
	@bodytrigger = ('book',
	                'volume',
	                'part',
	                'chapter',
	                'article',
	                'entry');
	                
	@backtrigger =  ('bibliography',
	                 'index',
                     'advertisements',
	                 'advertisement',
	                 'ads',
	                 'toc',
	                 'contents',
	                 'acknowledgements',
	                 'ack',
	                 'dedication',
	                 'notes');

	@implied0 = ('book',
	             'volume',
	             'part');
	
	@implied1 = ('chapter',
	             'intro',
	             'introduction',
	             'foreword',
	             'acknowledgements',
	             'ack',
	             'dedication',
	             'notes',
	             'bibliography',
	             'index',
	             'article');
	
	@implied2 = ('section',
	             'entry',
	             'article');
	
	@implied3 = ('subsection');
	                	
}




##===========================================================##
## I can't get my win16 version of perl to import the roman  ##
## numeral manipulation module roman.pm so I am including    ##
## the functions here inside the program instead.            ##
##===========================================================##

##======================================================================##
## DESCRIPTION:                                                         ##
##		This package provides some functions which help conversion of   ##
##		numeric notation between Roman and Arabic.                      ##
## AUTHOR:                                                              ##
##		OZAWA Sakuro <ozawa@prince.pe.u-tokyo.ac.jp>                    ##
## COPYRIGHT:                                                           ##
##		Copyright (c) 1995 OZAWA Sakuro.  All rights reserved.  This    ##
##		program is free software; you can redistribute it and/or modify ##
##		it under the same terms as Perl itself.                         ##
##======================================================================##



sub isroman {
    my($arg) = shift;
    $arg ne '' and
      $arg =~ /^(?: M{0,3})
                (?: D?C{0,3} | C[DM])
                (?: L?X{0,3} | X[LC])
                (?: V?I{0,3} | I[VX])$/ix;
}

sub arabic {
	my(%roman2arabic) = qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);
    my($arg) = shift;
    isroman $arg or return undef;
    my($last_digit) = 1000;
    my($arabic);
    foreach (split(//, uc $arg)) {
        my($digit) = $roman2arabic{$_};
        $arabic -= 2 * $last_digit if $last_digit < $digit;
        $arabic += ($last_digit = $digit);
    }
    $arabic;
}

sub romanstart {
    %roman_digit = qw(1 IV 10 XL 100 CD 1000 MMMMMM);
    @figure = reverse sort keys %roman_digit;
    grep($roman_digit{$_} = [split(//, $roman_digit{$_}, 2)], @figure);
}

sub Roman {
    my($arg) = shift;
    0 < $arg and $arg < 4000 or return undef;
    my($x, $roman);
    foreach (@figure) {
        my($digit, $i, $v) = (int($arg / $_), @{$roman_digit{$_}});
        if (1 <= $digit and $digit <= 3) {
            $roman .= $i x $digit;
        } elsif ($digit == 4) {
            $roman .= "$i$v";
        } elsif ($digit == 5) {
            $roman .= $v;
        } elsif (6 <= $digit and $digit <= 8) {
            $roman .= $v . $i x ($digit - 5);
        } elsif ($digit == 9) {
            $roman .= "$i$x";
        }
        $arg -= $digit * $_;
        $x = $i;
    }
    $roman;
}

sub roman {
    lc Roman shift;
}