#!/usr/bin/perl ##---------------------------------------------------------------------------## ## File: ## htmltoc ## Author: ## Earl Hood ehood@medusa.acs.uci.edu ## Description: ## htmltoc is a Perl program to generate a table of contents for ## HTML documents. ##---------------------------------------------------------------------------## ## Copyright (C) 1994-1997 Earl Hood, ehood@medusa.acs.uci.edu ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2 of the License, or ## (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ##---------------------------------------------------------------------------## package main; unshift(@INC, '.'); require "newgetopt.pl" || die "Error: Unable to require newgetopt.pl\n"; ##---------------------------------------------------------------------------## ## Store name of program ## ($PROG = $0) =~ s/.*\///; $VERSION = "1.2.1"; %TOC = ( # Default ToC entry elements 'H1', 1, 'H2', 2, ); %TOCend = ( # Default ToC entry element terminators 'H1', '/H1', 'H2', '/H2', ); %TOCbefore = (); # Before text for ToC entries %TOCafter = (); # After text for ToC entries $file = ''; # Current file being processed $_id = 0; # Link counter $prevlevel = 0; # Previous ToC entry level @Comments = (); $ComMark = "$;$;$;"; ##---------------------------------------------------------------------------## ##------------## ## Begin MAIN ## ##------------## { &get_cli_opts(); &read_tocmap() if $TOCMAP; local(@html,@newhtml,@toc,$i); ## Remove filename arguments in @ARGV that are part of the options @ARGV = grep(!/^($HEADER|$FOOTER|$TOCFILE|$TOCMAP)$/, @ARGV); die "Error: -inline valid for only a single file\n" if ($INLINE && $#ARGV > 0); if (!$QUIET) { if ($USEORG) { print STDERR qq|Using ".org" file(s) as source.\n|; } elsif (!$NOORG) { print STDERR qq|Original file(s) will be renamed with a ".org" |, qq|extension.\n|; } } ## Read files and create ToC print STDERR qq|Processing file(s) ...\n| unless $QUIET; $i = 0; foreach $file (@ARGV) { &cp($file, "$file.org") # Backup original unless $USEORG && -e "$file.org"; open(FILE, "$file.org") || # Use backup as source die "Error: Unable to open $file\n"; open(FILEOUT, "> $file") || # Overwrite original to filename die "Error: Unable to open $file\n"; @html = (); @newhtml = (); &read_sgml(FILE, *html); # Read HTML into @html &generate_toc(*html, *toc, *newhtml); # Add to ToC &put_back_comments(*newhtml); close(FILE); if (!$INLINE) { # Close FILEOUT only if no in-lining print FILEOUT @newhtml; close(FILEOUT); } $i++; } print STDERR "$i files processed.\n" unless $QUIET || $INLINE; ## Close up open elements in ToC for ($i=$prevlevel; $i > 0; $i--) { if ($OL && $i == 1) { push(@toc, "\n"); } else { push(@toc, "\n"); } } ## Write ToC print STDERR "Writing Toc ...\n" unless $QUIET; if ($INLINE) { if ($HEADER) { if (open(HEADER, $HEADER)) { print FILEOUT
; close(HEADER); } else { warn "Warning: Unable to open $HEADER\n"; } } else { while ((($i = shift @newhtml) !~ //i) && ($#newhtml >= 0)) { print FILEOUT $i; } if ($#newhtml < 0) { warn "Warning: No open BODY tag found\n"; } print FILEOUT $i, "\n"; print FILEOUT "$TOCHEADER\n" if $TOCHEADER; } print FILEOUT @toc, "\n"; print FILEOUT @newhtml; close(FILEOUT); } else { if ($HEADER) { if (open(HEADER, $HEADER)) { print $TOCHANDLE
; close(HEADER); } else { warn "Warning: Unable to open $HEADER\n"; } } else { print $TOCHANDLE qq|\n|, "\n", "\n"; print $TOCHANDLE "$TITLE\n" if $TITLE; print $TOCHANDLE "\n", "\n"; print $TOCHANDLE "$TOCHEADER\n" if $TOCHEADER; } print $TOCHANDLE @toc; if ($FOOTER) { if (open(FOOTER, $FOOTER)) { print $TOCHANDLE