HTML::GenToc - Generate a Table of Contents for HTML documents.

  use HTML::GenToc;

  # create a new object
  my $toc = new HTML::GenToc();

  my $toc = new HTML::GenToc(title=>"Table of Contents",
			  toc_entry=>{
			    H1=>1,
			    H2=>2
			  },
			  toc_end=>{
			    H1=>'/H1',
			    H2=>'/H2'
			  }
    );

  # generate a ToC from a file
  $toc->generate_toc(input=>$html_file,
		     footer=>$footer_file,
		     header=>$header_file
    );

    $toc = new HTML::GenToc();

    $toc = new HTML::GenToc(toc_entry=>\%my_toc_entry,
	toc_end=>\%my_toc_end,
	bak=>'bak',
    	...
        );

    $toc->generate_toc(outfile=>"index2.html");

    my $result_str = $toc->generate_toc(to_string=>1);

    $toc->make_anchor_name(content=>$content,
	anchors=>\%anchors);

    my $new_html = $toc->make_anchors(input=>$html,
	notoc_match=>$notoc_match,
	use_id=>$use_id,
	toc_entry=>\%toc_entries,
	toc_end=>\%toc_ends,
	);

    my @toc_list = $toc->make_toc_list(input=>$html,
	labels=>\%labels,
	notoc_match=>$notoc_match,
	toc_entry=>\%toc_entry,
	toc_end=>\%toc_end,
	filename=>$filename);

    $self->output_toc(toc=>$toc_str,
	input=>\@input,
	filenames=>\@filenames);

    my $newhtml = $toc->put_toc_inline(toc_str=>$toc_str,
	filename=>$filename, in_string=>$in_string);

    cp($src, $dst);

    $toc->generate_toc(inline=>1,
		       toc_tag => 'BODY',
		       toc_tag_replace => 0,
		       ...
		       );

    $toc->generate_toc(inline=>1,
		       toc_tag => '!--toc--',
		       toc_tag_replace => 1,
		       ...
		       );

    perl Build.PL
    ./Build
    ./Build test
    ./Build install

   perl Build.PL
   perl Build
   perl Build test
   perl Build install

   perl Build.PL --install_base /home/fred/perl

	PATH=/home/fred/perl/script:${PATH}

	PERL5LIB=/home/fred/perl/lib:${PERL5LIB}

package HTML::GenToc;
BEGIN {
  $HTML::GenToc::VERSION = '3.20';
}
use strict;

use Data::Dumper;
use HTML::SimpleParse;
use HTML::Entities;
use HTML::LinkList;

#################################################################

#---------------------------------------------------------------#
# Object interface
#---------------------------------------------------------------#

sub new {
    my $invocant = shift;

    my $class = ref($invocant) || $invocant; # Object or class name
    my $self = {
	debug => 0,
	bak => 'org',
	entrysep => ', ',
	footer => '',
	inline => 0,
	header => '',
	input => '',
	notoc_match => 'class="notoc"',
	ol => 0,
	ol_num_levels => 1,
	overwrite => 0,
	outfile => '-',
	quiet => 0,
	textonly => 0,
	title => 'Table of Contents',
	toclabel => '<h1>Table of Contents</h1>',
	toc_tag => '^BODY',
	toc_tag_replace => 0,
	toc_only => 0,
	# define TOC entry elements
	toc_entry => {
	    'H1'=>1,
	    'H2'=>2,
	},
	# TOC entry element terminators
	toc_end => {
	    'H1'=>'/H1',
	    'H2'=>'/H2',
	},
	useorg => 0,
	@_
    };

    # bless self
    bless($self, $class);

    if ($self->{debug})
    {
    	print STDERR Dumper($self);
    }

    return $self;
} # new

sub generate_toc ($%) {
    my $self = shift;
    my %args = (
	make_anchors=>1,
	make_toc=>1,
	input=>undef,
	filenames=>undef,
	bak=>$self->{bak},
	debug=>$self->{debug},
	useorg=>$self->{useorg},
	use_id=>$self->{use_id},
	notoc_match=>$self->{notoc_match},
	toc_entry=>$self->{toc_entry},
	toc_end=>$self->{toc_end},
	overwrite=>$self->{overwrite},
	ol=>$self->{ol},
	ol_num_levels=>$self->{ol_num_levels},
	entrysep=>$self->{entrysep},
	ignore_only_one=>$self->{ignore_only_one},
	@_
    );

    if ($args{debug})
    {
    	print STDERR Dumper(\%args);
    }
    if (!$args{input}) 
    {
	warn "generate_toc: no input given\n";
	return '';
    }
    #
    # get the input
    #
    my @filenames = ();
    my @input = ();
    if (ref $args{input} eq "ARRAY")
    {
	@filenames = @{$args{input}};
	my $i = 0;
	my $fh_needs_closing = 0;
	foreach my $fn (@filenames)
	{
	    my $infn = $fn;
	    my $bakfile = $fn . "." . $args{bak};
	    if ($args{useorg}
		&& $args{bak}
		&& -e $bakfile)
	    {
		# use the old backup files as source
		$infn = $bakfile;
	    }
	    my $fh = undef;
	    # using '-' means STDIN
	    if ($infn eq '-')
	    {
		$fh = *STDIN;
		$fh_needs_closing = 0;
	    }
	    else
	    {
		open ($fh, $infn) ||
		    die "Error: unable to open ", $infn, ": $!\n";
		$fh_needs_closing = 1;
	    }

	    my $content = '';
	    {
		local $/;   # slurp entire file
		$content = <$fh>;
		close ($fh) if ($fh_needs_closing);
	    }
	    $input[$i] = $content;

	    $i++;
	}
    }
    else
    {
	$filenames[0] = '';
	$input[0] = $args{input};
    }
    # overwrite the filenames array if a replacement
    # was passed in and has the same length
    if (defined $args{filenames}
	&& @{$args{filenames}}
	&& $#{$args{filenames}} == $#{filenames}
	)
    {
	@filenames = @{$args{filenames}};
    }

    #
    # make the anchors
    #
    if ($args{make_anchors})
    {
	my $i = 0;
	foreach my $fn (@filenames)
	{
	    my $html_str = $input[$i];
	    $input[$i] = $self->make_anchors(%args,
		filename=>$fn,
		input=>$html_str);
	    $i++;
	}
    }

    #
    # make the ToC
    #
    my $toc_str = '';
    if ($args{make_toc})
    {
	my %labels = ();
	my @list_of_lists = ();
	my $i = 0;
	for (my $i = 0; $i < @filenames; $i++)
	{
	    my @the_list = $self->make_toc_list(%args,
		first_file=>$filenames[0],
		labels=>\%labels,
		filename=>$filenames[$i],
		input=>$input[$i]);
	    if (!($args{ignore_only_one}
		and @the_list <= 1))
	    {
		push @list_of_lists, @the_list;
	    }
	}
	if (@list_of_lists > 0)
	{
	    #
	    # create the appropriate format
	    #
	    my %formats = ();
	    # check for non-list entries, flagged by negative levels
	    while (my ($key, $val) = each %{$args{toc_entry}})
	    {
		if ($val < 0)
		{
		    $formats{abs($val) - 1} = {};
		    $formats{abs($val) - 1}->{tree_head} = '<ul><li>';
		    $formats{abs($val) - 1}->{tree_foot} = "\n</li></ul>\n";
		    $formats{abs($val) - 1}->{item_sep} = $args{entrysep};
		    $formats{abs($val) - 1}->{pre_item} = '';
		    $formats{abs($val) - 1}->{post_item} = '';
		}
	    }
	    # check for OL
	    if ($args{ol})
	    {
		$formats{0} = {};
		$formats{0}->{tree_head} = '<ol>';
		$formats{0}->{tree_foot} = "\n</ol>";
		if ($args{ol_num_levels} > 0)
		{
		    $formats{$args{ol_num_levels}} = {};
		    $formats{$args{ol_num_levels}}->{tree_head} = '<ul>';
		    $formats{$args{ol_num_levels}}->{tree_foot} = "\n</ul>";
		}
	    }
	    $toc_str = HTML::LinkList::link_tree(
						 %args,
						 link_tree=>\@list_of_lists,
						 labels=>\%labels,
						 formats=>\%formats,
						);
	}
    }

    #
    # put the output
    #
    my $ret = $self->output_toc(
	%args,
	toc=>$toc_str,
	input=>\@input,
	filenames=>\@filenames,
    );

    return $ret;

} # generate_toc

sub make_anchor_name ($%) {
    my $self = shift;
    my %args = (
	content=>'', # will be overwritten by one of @_
	anchors=>undef,
	@_
    );
    my $name = $args{content};  # the anchor name will most often be very close to the token content

    if ($name !~ /^\s*$/) {
        # generate a SEO-friendly anchor right from the token content
	# The allowed character set is limited first by the URI specification
	# for fragments, http://tools.ietf.org/html/rfc3986#section-2:
	# characters then by the limitations of the values of 'id' and 'name'
	# attributes: http://www.w3.org/TR/REC-html40/types.html#type-name
        # Eventually, the only punctuation allowed in id values is [_.:-]

	# we need to replace [#&;] only when they are NOT part of an HTML
	# entity. decode_entities saves us from crafting a nasty regexp
        decode_entities($name);
	# MediaWiki also uses the period, see
	# http://en.wikipedia.org/wiki/Hierarchies#Ethics.2C_behavioral_psychology.2C_philosophies_of_identity
	$name =~ s/([^\s\w_.:-])/'.'.sprintf('%02X', ord($1))/eg;

	$name =~ s/\s+/_/g;
	# "ID and NAME tokens must begin with a letter ([A-Za-z])"
	$name =~ s/^[^a-zA-Z]+//;
    }
    else
    {
	$name = 'id';
    }
    $name = 'id' if $name eq '';

    # check if it already exists; if so, add a number
    my $anch_num = 1;
    my $word_name = $name;
    my $name_key = lc $name;
    # Reference: http://www.w3.org/TR/REC-html40/struct/links.html#h-12.2.1
    # Anchor names must be unique within a document. Anchor names that differ
    # only in case may not appear in the same document.
    while (defined $args{anchors}->{$name_key}
	   && $args{anchors}->{$name_key})
    {
	$name = $word_name . "_$anch_num";
	$name_key = lc $name;
	$anch_num++;
    }

    return $name;
} # make_anchor_name

sub make_anchors ($%) {
    my $self = shift;
    my %args = (
	input=>'',
	notoc_match=>$self->{notoc_match},
	use_id=>$self->{use_id},
	toc_entry=>$self->{toc_entry},
	toc_end=>$self->{toc_end},
	debug=>$self->{debug},
	quiet=>$self->{quiet},
	@_
    );
    my $html_str = $args{input};

    print STDERR "Making anchors for ", $args{filename}, "...\n"
	if (!$args{quiet} && $args{filename});

    my @newhtml = ();
    my %anchors = ();
    # Note that the keys to the anchors hash should be lower-cased
    # since anchor names that differ only in case are not allowed.

    # parse the HTML
    my $hp = new HTML::SimpleParse();
    $hp->text($html_str);
    $hp->parse();

    my $tag;
    my $endtag;
    my $level = 0;
    my $tmp;
    my $adone = 0;
    my $name = '';
    # go through the HTML
    my $tok;
    my $next_tok;
    my $i;
    my $notoc = $args{notoc_match};
    my @tree = $hp->tree();
    while (@tree) {
	$tok = shift @tree;
	$next_tok = $tree[0];
	if ($tok->{type} ne 'starttag')
	{
	    push @newhtml, $hp->execute($tok);
	    next;
	}
	# assert: we have a start tag
	$level = 0;
	
	# check if tag included in TOC (significant element)
	foreach my $key (keys %{$args{toc_entry}}) {
	    if ($tok->{content} =~ /^$key/i
		&& (!$notoc
		    || $tok->{content} !~ /$notoc/)) {
		$tag = $key;
		# level of significant element
		$level = abs($args{toc_entry}->{$key});
		# End tag of significant element
		$endtag = $args{toc_end}->{$key};
		last;
	    }
	}
	# if $level is not set, we didn't find a Significant tag
	if (!$level) {
	    push @newhtml, $hp->execute($tok);
	    next;
	}
	# assert: current tag is a Significant tag

	#
	# Add A element or ID to document
	#
	my $name_in_anchor = 0;
	$adone = 0;
	$name = '';
	my $sig_tok = $tok;
	if ($tag =~ /title/i) {		# TITLE tag is a special case
	    $adone = 1;
	}
	if ($args{use_id})
	{
	    # is there an existing ID?
	    if ($sig_tok->{content} =~ /ID\s*=\s*(['"])/i) {
		my $q = $1;
		($name) = $sig_tok->{content} =~ m/ID\s*=\s*$q([^$q]*)$q/i;
		if ($name)
		{
		    $anchors{lc $name} = $name;
		    push @newhtml, $hp->execute($sig_tok);
		    $adone = 1;
		}
		else # if the ID has no name, remove it!
		{
		    $sig_tok->{content} =~ s/ID\s*=\s*$q$q//i;
		}
	    }
	}
	else # not adding ID, move right along
	{
	    push @newhtml, $hp->execute($tok);
	}
	# Find the "name" of the significant element
	# Don't consume the tree, because ID behaves differently from A
	my $i = 0;
	while (!$name && $i < @tree)
	{
	    $tok = $tree[$i];
	    $next_tok = $tree[$i + 1];
	    if ($tok->{type} eq 'text') {
		$name = $self->make_anchor_name(content=>$tok->{content},
		    anchors=>\%anchors);
	    # Anchor
	    } elsif (!$adone && $tok->{type} eq 'starttag'
		&& $tok->{content} =~ /^A/i)
	    {
		if ($tok->{content} =~ /NAME\s*=\s*(['"])/i) {
		    my $q = $1;
		    ($name) = $tok->{content} =~ m/NAME\s*=\s*$q([^$q]*)$q/i;
		    $name_in_anchor = 1;
		} elsif ($next_tok->{type} eq 'text') {
		    $name = $self->make_anchor_name(content=>$next_tok->{content},
			anchors=>\%anchors);
		}
	    } elsif ($tok->{type} eq 'starttag'
		    || $tok->{type} eq 'endtag')
	    {	# Tag
		last if $tok->{content} =~ m|$endtag|i;
	    }
	    $i++;
	}
	# assert: there is a name, or there is no name to be found
	if (!$name)
	{
	    # make up a name
	    $name = $self->make_anchor_name(content=>"TOC",
		anchors=>\%anchors);
	}
	if (!$adone && $args{use_id})
	{
	    if (!$name_in_anchor)
	    {
		$anchors{lc $name} = $name;
		# add the ID
		$sig_tok->{content} .= " id='$name'";
		push @newhtml, $hp->execute($sig_tok);
		$adone = 1;
	    }
	    else
	    {
		# we have an already-named anchor, so don't add an ID
		push @newhtml, $hp->execute($sig_tok);
	    }
	}
	
	while (@tree) {
	    $tok = shift @tree;
	    $next_tok = $tree[0];
	    # Text
	    if ($tok->{type} eq 'text') {
		if (!$adone && $tok->{content} !~ /^\s*$/) {
		    $anchors{lc $name} = $name;
		    # replace the text with an anchor containing the text
		    push(@newhtml, qq|<a name="$name">$tok->{content}</a>|);
		    $adone = 1;
		} else {
		    push @newhtml, $hp->execute($tok);
		}
	    # Anchor
	    } elsif (!$adone && $tok->{type} eq 'starttag'
		&& $tok->{content} =~ /^A/i)
	    {
		# is there an existing NAME anchor?
		if ($name_in_anchor) {
		    $anchors{lc $name} = $name;
		    push @newhtml, $hp->execute($tok);
		} else {
		    # add the current name anchor
		    $tmp = $hp->execute($tok);
		    $tmp =~ s/^(<A)(.*)$/$1 name="$name" $2/i;
		    push @newhtml, $tmp;
		    $anchors{lc $name} = $name;
		}
		$adone = 1;
	    } elsif ($tok->{type} eq 'starttag'
		    || $tok->{type} eq 'endtag')
	    {	# Tag
		push @newhtml, $hp->execute($tok);
		last if $tok->{content} =~ m|$endtag|i;
	    }
	    else {
		push @newhtml, $hp->execute($tok);
	    }
	}
    }
    my $out = join('', @newhtml);

    return $out;
} # make_anchors

sub make_toc_list ($%) {
    my $self = shift;
    my %args = (
	input=>'',
	filename=>'',
	labels=>undef,
	notoc_match=>$self->{notoc_match},
	toc_entry=>$self->{toc_entry},
	toc_end=>$self->{toc_end},
	inline=>$self->{inline},
	debug=>$self->{debug},
	toc_before=>$self->{toc_before},
	toc_after=>$self->{toc_after},
	textonly=>$self->{textonly},
	ignore_sole_first=>$self->{ignore_sole_first},
	ignore_only_one=>$self->{ignore_only_one},
	@_
    );
    my $html_str = $args{input};
    my $infile = $args{filename};
    my $labels = $args{labels};

    my $toc_str = "";
    my @toc = ();
    my @list_of_paths = ();
    my %level_count = ();

    # parse the HTML
    my $hp = new HTML::SimpleParse();
    $hp->text($html_str);
    $hp->parse();

    my $noli;
    my $prevnoli;
    my $before = "";
    my $after = "";
    my $tag;
    my $endtag;
    my $level = 0;
    my $levelopen;
    my $tmp;
    my $content;
    my $adone = 0;
    my $name = "NOTOC"; # if no anchor is found...
    my $is_title;
    my $found_title = 0;
    my $notoc = $args{notoc_match};
    # go through the HTML
    my $tok;
    my @tree = $hp->tree();
    while (@tree) {
	$tok = shift @tree;
	$level = 0;
	$is_title = 0;
	$tag = '';
	if ($tok->{type} eq 'starttag')
	{
	    # check if tag included in TOC
	    foreach my $key (keys %{$args{toc_entry}}) {
		if ($tok->{content} =~ /^$key/i
		    && (!$notoc
			|| $tok->{content} !~ /$notoc/)) {
		    $tag = $key;
		    if ($args{debug}) {
			print STDERR "============\n";
			print STDERR "key = $key ";
			print STDERR "tok->content = '", $tok->{content}, "' ";
			print STDERR "tag = $tag";
			print STDERR "\n============\n";
		    }
		    # level of significant element
		    $level = abs($args{toc_entry}->{$key});
		    # no <li> used in ToC listing
		    $noli = $args{toc_entry}->{$key} < 0;
		    # End tag of significant element
		    $endtag = $args{toc_end}->{$key};
		    if (defined $args{toc_before}->{$key}) {
			$before = $args{toc_before}->{$key};
		    } else {
			$before = "";
		    }
		    if (defined $args{toc_after}->{$key}) {
			$after = $args{toc_after}->{$key};
		    } else {
			$after = "";
		    }
		}
	    }
	}
	if (!$level) {
	    next;
	}
	if ($args{debug}) {
	    print STDERR "Chosen tag:$tag\n";
	}
	# assert: we are at a Significant tag

	# get A element or ID from document
	# This assumes that there is one there
	$content = '';
	$adone = 0;
	if ($tag =~ /title/i) {		# TITLE tag is a special case
	    if ($found_title) {
		# don't need to find a title again, we found it
		next;
	    } else {
		$is_title = 1;  $adone = 1;
		$found_title = 1;
	    }
	}
	if ($args{debug}) {
	    print STDERR "is_title:$is_title\n";
	}
	# check for an ID before we skip this tag
	if ($tok->{content} =~ /ID\s*=\s*(['"])/i) {
	    my $q = $1;
	    ($name) = $tok->{content} =~ m/ID\s*=\s*$q([^$q]*)$q/i;
	    $adone = 1;
	}
	while (@tree) {
	    $tok = shift @tree;
	    # Text
	    if ($tok->{type} eq 'text') {
		$content .= $tok->{content};
		if ($args{debug}) {
		    print STDERR "tok-content = ", $tok->{content}, "\n";
		    print STDERR "content = $content\n";
		}
	    # Anchor
	    } elsif (!$adone && $tok->{type} eq 'starttag'
		&& $tok->{content} =~ /^A/i)
	    {
		if ($tok->{content} =~ /NAME\s*=\s*(['"])/i) {
		    my $q = $1;
		    ($name) = $tok->{content} =~ m/NAME\s*=\s*$q([^$q]*)$q/i;
		    $adone = 1;
		}
	    } elsif ($tok->{type} eq 'starttag'
		    || $tok->{type} eq 'endtag')
	    {	# Tag
		if ($args{debug}) {
		    print STDERR "file = ", $infile,
			" tag = $tag, endtag = '$endtag",
			"' tok-type = ", $tok->{type},
			" tok-content = '", $tok->{content}, "'\n";
		}
		last if $tok->{content} =~ m#$endtag#i;
		$content .= $hp->execute($tok)
		    unless $args{textonly}
			|| $tok->{content} =~ m#/?(hr|p|a|img)#i;
	    }

	}
	if ($args{debug}) {
	    print STDERR "Chosen content:'$content'\n";
	}

	if ($content =~ /^\s*$/) {	# Check for empty content
	    warn "Warning: A $tag in $infile has no content;  $tag skipped\n";
	    next;
	} else {
	    $content =~ s/^\s+//;	# Strip beginning whitespace
	    $content =~ s/\s+$//;	# Strip end whitespace
	    $content = $before . $content . $after;
	}
	# figure out the anchor link needed
	my $link = '';
	if ($args{inline} and $args{first_file} eq $infile)
	{
	    $link = (!$is_title ? qq|#$name| : '');
	}
	else
	{
	    $link .= join('',
			 qq|$infile|,
			 !$is_title ? qq|#$name| : '');
	}
	# Assert: we know the info about this TOC entry
	push @list_of_paths, {
	    level=>$level,
	    path=>$link,
	    };
	$labels->{$link} = $content;
	$level_count{$level}++;

	$name = 'NOTOC';
	$prevnoli = $noli;
    } # while tree

    # If we want to ignore the first H1 if there's only one of them 
    # if the first item is a level-0 item
    # and there is only one of them
    # then remove it and readjust levels
    if ($args{ignore_sole_first}
	and $level_count{"1"} == 1
	and $list_of_paths[0]->{level} == 1)
    {
	shift @list_of_paths;
	for (my $i = 0; $i < @list_of_paths; $i++)
	{
	    $list_of_paths[$i]->{level}--;
	}
    }
    elsif ($args{ignore_only_one}
	   and @list_of_paths == 1)
    {
	return ();
    }

    my @list_of_lists = ();
    @list_of_lists = $self->build_lol(
	paths=>\@list_of_paths);

    return @list_of_lists;
} # make_toc_list

sub build_lol {
    my $self = shift;
    my %args = (
	paths=>undef,
	depth=>1,
	prepend_list=>undef,
	append_list=>undef,
	@_
    );
    my $paths_ref = $args{paths};
    my $depth = $args{depth};

    my @list_of_lists = ();
    while (@{$paths_ref})
    {
	my $toc_entry = $paths_ref->[0];
	my $path_depth = $toc_entry->{level};
	my $path = $toc_entry->{path};
	if ($path_depth == $depth)
	{
	    shift @{$paths_ref}; # use this path
	    push @list_of_lists, $path;
	}
	elsif ($path_depth > $depth)
	{
	    push @list_of_lists, [$self->build_lol(
		%args,
		prepend_list=>undef,
		append_list=>undef,
		paths=>$paths_ref,
		depth=>$path_depth,
		)];
	}
	elsif ($path_depth < $depth)
	{
	    return @list_of_lists;
	}
    }
    # prepend the given list to the top level
    if (defined $args{prepend_list} and @{$args{prepend_list}})
    {
	# if the list of lists is a single item which is a list
	# then add the extra list to that item
	if ($#list_of_lists == 0
	    and ref($list_of_lists[0]) eq "ARRAY")
	{
	    unshift @{$list_of_lists[0]}, @{$args{prepend_list}};
	}
	else
	{
	    unshift @list_of_lists, @{$args{prepend_list}};
	}
    }
    # append the given list to the top level
    if (defined $args{append_list} and @{$args{append_list}})
    {
	# if the list of lists is a single item which is a list
	# then add the extra list to that item
	if ($#list_of_lists == 0
	    and ref($list_of_lists[0]) eq "ARRAY")
	{
	    push @{$list_of_lists[0]}, @{$args{append_list}};
	}
	else
	{
	    push @list_of_lists, @{$args{append_list}};
	}
    }
    return @list_of_lists;
} # build_lol

sub output_toc ($%) {
    my $self = shift;
    my %args = (
		toc=>'',
		input=>undef,
		filenames=>undef,
		bak=>$self->{bak},
		useorg=>$self->{useorg},
		inline=>$self->{inline},
		overwrite=>$self->{overwrite},
		to_string=>$self->{to_string},
		header=>$self->{header},
		footer=>$self->{footer},
		toc_only=>$self->{toc_only},
		title=>$self->{title},
		toclabel=>$self->{toclabel},
		outfile=>$self->{outfile},
		debug=>$self->{debug},
		quiet=>$self->{quiet},
		@_
	       );

    #
    # Output to the files if we were making anchors
    #
    if ($args{make_anchors}
	&& !$args{to_string}
	&& $args{overwrite})
    {
	my $ofh;
	# start from 1 if we're going to be inlining the toc
	# in the first file and not to an output file
	my $start_from = (($args{make_toc}
			   && $args{inline}
			   && !$args{outfile})
			  ? 1 : 0);
	for (my $i=$start_from; $i < @{$args{filenames}}; $i++)
	{
	    my $filename = $args{filenames}->[$i];
	    my $bakfile = $filename . "." . $args{bak};
	    if ($args{bak}
		&& !($args{useorg} && -e $bakfile))
	    {
		# copy the file to a backup
		print STDERR "Backing up ", $filename, " to ",
		      $bakfile, "\n"
			  unless $args{quiet};
		cp($filename, $bakfile);
	    }
	    open($ofh, "> $filename")
		|| die "Error: unable to open ", $filename, ": $!\n";
	    print STDERR "Overwriting ToC to ", $filename, "\n"
		unless $args{quiet};
	    print $ofh $args{input}->[$i];
	    close($ofh);
	}
    }

    #
    # Construct and output the ToC
    #
    my $output = '';
    if ($args{make_toc})
    {
	if ($args{toc})
	{
	    my @toc = ();
	    # put the header at the start of the ToC if there is one
	    if ($args{header}) {
		if (-f $args{header})
		{
		    open(HEADER, $args{header})
			|| die "Error: unable to open ", $args{header}, ": $!\n";
		    push @toc, <HEADER>;
		    close (HEADER);
		}
		else # not a file
		{
		    push @toc, $args{header};
		}
	    }
	    # if we are outputing a standalone page,
	    # then make sure it can stand
	    elsif (!$args{toc_only}
		   && !$args{inline}) {

		push @toc, qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML//EN">\n|,
		     "<html>\n",
		     "<head>\n";
		push @toc, "<title>", $args{title}, "</title>\n"  if $args{title};
		push @toc, "</head>\n",
		     "<body>\n";
	    }

	    # start the ToC with the ToC label
	    if ($args{toclabel}) {
		push @toc, $args{toclabel};
	    }

	    # and the actual ToC
	    push @toc, "\n", $args{toc}, "\n";

	    # add the footer, if there is one
	    if ($args{footer}) {
		if (-f $args{footer})
		{
		    open(FOOTER, $args{footer})
			|| die "Error: unable to open ", $args{footer}, ": $!\n";
		    push @toc, <FOOTER>;
		    close (FOOTER);
		}
		else
		{
		    push @toc, $args{footer};
		}
	    }
	    # if we are outputing a standalone page,
	    # then make sure it can stand
	    elsif (!$args{toc_only}
		   && !$args{inline}) {

		push @toc, "</body>\n", "</html>\n";
	    }

	    $output = join '', @toc;
	}
	else
	{
	    $output = "\n";
	}
    }
    elsif ($args{make_anchors} && (!$args{overwrite} || $args{to_string}))
    {
	# if we're just making anchors, and we aren't overwriting
	# the original file, we need to output it
	$output = $args{input}->[0];
    }

    if ($output)
    {
	#
	#  Sent the outfile to its final destination
	#
	my $file_needs_closing = 0;
	my $ofh;
	if ($args{to_string})
	{
	    $ofh = undef;
	}
	elsif ($args{outfile} && $args{outfile} ne "-") {
	    open($ofh, "> " . $args{outfile})
		|| die "Error: unable to open ", $args{outfile}, ": $!\n";
	    $file_needs_closing = 1;
	}
	elsif (!$args{overwrite}) {
	    $ofh = *STDOUT;
	    $file_needs_closing = 0;
	}
	if ($args{inline}) {
	    # create the modified version of the first set of input
	    my $first_file = $args{filenames}->[0];
	    my $bakfile = $first_file . "." . $args{bak};
	    $output = $self->put_toc_inline(%args,
					    toc_str=>$output,
					    in_string=>$args{input}->[0],
					    filename=>$args{filenames}->[0],
					   );

	    if ($args{to_string})
	    {
		# just send to string, don't print anything
		if ($args{debug})
		{
		    print STDERR "======== to_string output_toc ========\n";
		    print STDERR $output;
		    print STDERR "========----------------------========\n";
		}
	    }
	    elsif ($args{overwrite}) {
		if ($args{bak}
		    && !($args{useorg} && -e $bakfile))
		{
		    # copy the file to a backup
		    print STDERR "Backing up ", $first_file, " to ",
			  $bakfile, "\n"
			      unless $args{quiet};
		    cp($first_file, $bakfile);
		}
		open($ofh, "> $first_file")
		    || die "Error: unable to open ", $first_file, ": $!\n";
		$file_needs_closing = 1;
		print STDERR "Overwriting ToC to ", $first_file, "\n"
		    unless $args{quiet};
		print $ofh $output;
	    }
	    elsif ($args{outfile}
		   && $args{outfile} ne "-") {
		print STDERR "Writing Inline ToC to ", $args{outfile}, "\n"
		    unless $args{quiet};
		print $ofh $output;
	    }
	    elsif ($args{outfile})
	    {
		print $ofh $output;
	    }
	} else {
	    if ($args{to_string})
	    {
		# just send to string, don't print anything
	    }
	    elsif ($args{outfile} && $args{outfile} ne "-") {
		print STDERR "Writing ToC to ", $args{outfile}, "\n"
		    unless $args{quiet};
		print $ofh $output;
	    }
	    else
	    {
		print $ofh $output;
	    }
	}
	if ($file_needs_closing) {
	    close($ofh);
	}
    }

    if ($args{to_string})
    {
	return $output;
    }
    else
    {
	return 1;
    }
} # output_toc

sub put_toc_inline ($) {
    my $self = shift;
    my %args = (
	toc_str=>'',
	filename=>'',
	in_string=>'',
	toc_tag=>$self->{toc_tag},
	toc_tag_replace=>$self->{toc_tag_replace},
	@_
    );
    my $toc_str = $args{toc_str};
    my $infile = $args{filename};

    my $html_str = "";

    if ($args{in_string}) # use input string, not file
    {
	$html_str = $args{in_string};
    }
    else
    {
	local $/;
	open (FILE, $infile) ||
	    die "Error: unable to open ", $infile, ": $!\n";

	$html_str = <FILE>;
	close (FILE);
    }


    # parse the file
    my $hp = new HTML::SimpleParse();
    $hp->text($html_str);
    $hp->parse();

    my $toc_tag = $args{toc_tag};
    my @newhtml = ();

    my $toc_done = 0;
    # go through the HTML
    my $tok;
    my $i;
    my @tree = $hp->tree();
    while (@tree) {
	$tok = shift @tree;
	# look for the ToC tag in tags or comments
	if ($tok->{type} eq 'starttag'
	    || $tok->{type} eq 'endtag'
	    || $tok->{type} eq 'comment')
	{
	    if (!$toc_done
		&& $tok->{content} =~ m|$toc_tag|i) {
		# some tags need to be preserved, with the ToC put after,
		# while others need to be replaced
		if (!$args{toc_tag_replace}) {
		    push @newhtml, $hp->execute($tok);
		}
		# put the ToC in
		push @newhtml, $toc_str;
		$toc_done = 1;
	    }
	    else {
		push @newhtml, $hp->execute($tok);
	    }
	}
	else
	{
	    push @newhtml, $hp->execute($tok);
	    next;
	}
    }

    return join('', @newhtml);
}

sub cp ($$) {
    my($src, $dst) = @_;
    open (SRC, $src) ||
	die "Error: unable to open ", $src, ": $!\n";
    open (DST, "> $dst") ||
	die "Error: unable to open ", $dst, ": $!\n";
    print DST <SRC>;
    close(SRC);
    close(DST);
}

1;