path: root/plugins/checksum/checksum.c

> = 0;          # set to true after a par in an =item
	$Ignore     = 1;          # whether or not to format text.  we don't
	                          #   format text until we hit our first pod
	                          #   directive.

	@Items_Seen  = ();        # for multiples of the same item in perlfunc
	%Items_Named = ();
	$Header      = 0;         # produce block header/footer
	$Title       = '';        # title to give the pod(s)
	$Top         = 1;         # true if we are at the top of the doc.  used
	                          #   to prevent the first <hr /> directive.
	$Paragraph   = '';        # which paragraph we're processing (used
	                          #   for error messages)
	%Sections    = ();        # sections within this page

	%Local_Items = ();
	$Is83 = $^O eq 'dos';    # Is it an 8.3 filesystem?
}

#
# clean_data: global clean-up of pod data
#
sub clean_data($) {
	my ($dataref) = @_;
	for my $i ( 0 .. $#{$dataref} ) {
		${$dataref}[$i] =~ s/\s+\Z//;

		# have a look for all-space lines
		if ( ${$dataref}[$i] =~ /^\s+$/m and $dataref->[$i] !~ /^\s/ ) {
			my @chunks = split( /^\s+$/m, ${$dataref}[$i] );
			splice( @$dataref, $i, 1, @chunks );
		}
	}
}

sub pod2html {
	local (@ARGV) = @_;
	local ($/);
	local $_;

	init_globals();

	$Is83 = 0 if ( defined(&Dos::UseLFN) && Dos::UseLFN() );

	# cache of %Pages and %Items from last time we ran pod2html

	#undef $opt_help if defined $opt_help;

	# parse the command-line parameters
	parse_command_line();

	# escape the backlink argument (same goes for title but is done later...)
	$Backlink = html_escape($Backlink) if defined $Backlink;

	# set some variables to their default values if necessary
	local *POD;
	unless ( @ARGV && $ARGV[0] ) {
		$Podfile = "-" unless $Podfile;    # stdin
		open( POD, "<$Podfile" )
			|| die "$0: cannot open $Podfile file for input: $!\n";
	} else {
		$Podfile = $ARGV[0];               # XXX: might be more filenames
		*POD     = *ARGV;
	}
	$Htmlfile = "-" unless $Htmlfile;      # stdout
	$Htmlroot = "" if $Htmlroot eq "/";    # so we don't get a //
	$Htmldir =~ s#/\z##;                   # so we don't get a //
	if (   $Htmlroot eq ''
		&& defined($Htmldir)
		&& $Htmldir ne ''
		&& substr( $Htmlfile, 0, length($Htmldir) ) eq $Htmldir )
	{

		# Set the 'base' url for this file, so that we can use it
		# as the location from which to calculate relative links
		# to other files. If this is '', then absolute links will
		# be used throughout.
		$Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length($Htmldir) + 1 );
	}

	# read the pod a paragraph at a time
	warn "Scanning for sections in input file(s)\n" if $Verbose;
	$/ = "";
	my @poddata = <POD>;
	close(POD);

	# be eol agnostic
	for (@poddata) {
		if (/\r/) {
			if (/\r\n/) {
				@poddata = map {
					s/\r\n/\n/g;
					/\n\n/
						? map { "$_\n\n" } split /\n\n/
						: $_
				} @poddata;
			} else {
				@poddata = map {
					s/\r/\n/g;
					/\n\n/
						? map { "$_\n\n" } split /\n\n/
						: $_
				} @poddata;
			}
			last;
		}
	}

	clean_data( \@poddata );

	# scan the pod for =head[1-6] directives and build an index
	my $index = scan_headings( \%Sections, @poddata );

	unless ($index) {
		warn "No headings in $Podfile\n" if $Verbose;
	}

	# open the output file
	open( HTML, ">$Htmlfile" )
		|| die "$0: cannot open $Htmlfile file for output: $!\n";

	# put a title in the HTML file if one wasn't specified
	if ( $Title eq '' ) {
	TITLE_SEARCH: {
			for ( my $i = 0 ; $i < @poddata ; $i++ ) {
				if ( $poddata[$i] =~ /^=head1\s*NAME\b/m ) {
					for my $para ( @poddata[ $i, $i + 1 ] ) {
						last TITLE_SEARCH
							if ($Title) = $para =~ /(\S+\s+-+.*\S)/s;
					}
				}

			}
		}
	}
	if ( !$Title and $Podfile =~ /\.pod\z/ ) {

		# probably a split pod so take first =head[12] as title
		for ( my $i = 0 ; $i < @poddata ; $i++ ) {
			last if ($Title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
		}
		warn "adopted '$Title' as title for $Podfile\n"
			if $Verbose and $Title;
	}
	if ($Title) {
		$Title =~ s/\s*\(.*\)//;
	} else {
		warn "$0: no title for $Podfile.\n" unless $Quiet;
		$Podfile =~ /^(.*)(\.[^.\/]+)?\z/s;
		$Title = ( $Podfile eq "-" ? 'No Title' : $1 );
		warn "using $Title" if $Verbose;
	}
	$Title = html_escape($Title);

	my $csslink   = '';
	my $bodystyle = ' style="background-color: white"';
	my $tdstyle   = ' style="background-color: #cccccc"';

	if ($Css) {
		$csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />);
		$csslink =~ s,\\,/,g;
		$csslink =~ s,(/.):,$1|,;
		$bodystyle = '';
		$tdstyle   = '';
	}

	my $block = $Header ? <<END_OF_BLOCK : '';
<table border="0" width="100%" cellspacing="0" cellpadding="3">
<tr><td class="block"$tdstyle valign="middle">
<big><strong><span class="block">&nbsp;$Title</span></strong></big>
</td></tr>
</table>
END_OF_BLOCK

	print HTML <<END_OF_HEAD;
<?xml version="1.0" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>$Title</title>$csslink
<meta http-equiv="content-type" content="text/html; charset=utf-8" />
<link rev="made" href="mailto:$Config{perladmin}" />
<style type="text/css">
	.branch {
		list-style: none;
	}

	li code {
		padding-right: 0.5em;
	}

	.example {
		width: 98%;
		padding: 0.5em;
		float: left;
		font-family: monospace;
	}

	.example .line_number {
		float: left;
		text-align: right;
		margin-right: 10px;
		padding-right: 5px;
		border-right: 1px solid white;
	}

	.example .content {
		float: left;
	}

	.example .content pre {
		margin: 0;
	}

	td > table {
		margin: 0.5em;
		border-collapse: collapse;
	}

	td > table td {
		border: 1px solid black;
	}

	.synComment {
		color: rgb(135,206,235);
	}
	.synPreProc {
		color: rgb(205,92,92);
	}
	.synError {
	}
	.synConstant {
		color: #ffa0a0;
	}
	.synSpecial {
		color: rgb(255,222,173);
	}
	.synIgnore {
		color: rgb(102,102,102);
	}
	.synNormal {
		color: rgb(255,255,255);
		background-color: rgb(51,51,51);
	}
	.synType {
		color: rgb(189,183,107);
	}
	.synIdentifier {
		color: rgb(152,251,152);
	}
	.synTodo {
		color: rgb(255,69,0);
		background-color: rgb(238,238,0);
	}
	.synStatement {
		color: rgb(240,230,140);
	}

</style>
</head>

<body$bodystyle>
$block
END_OF_HEAD

	# load/reload/validate/cache %Pages and %Items
	get_cache( $Dircache, $Itemcache, \@Podpath, $Podroot, $Recurse );

	# scan the pod for =item directives
	scan_items( \%Local_Items, "", @poddata );

	# put an index at the top of the file.  note, if $Doindex is 0 we
	# still generate an index, but surround it with an html comment.
	# that way some other program can extract it if desired.
	$index =~ s/--+/-/g;

	my $hr = ( $Doindex and $index ) ? qq(<hr />) : "";

	unless ($Doindex) {
		$index = qq(<!--\n$index\n-->\n);
	}

	print HTML << "END_OF_INDEX";

<!-- INDEX BEGIN -->
<div>
<p><a name=\"__index__\"></a></p>
$index
$hr
</div>
<!-- INDEX END -->

END_OF_INDEX

	# now convert this file
	my $after_item;    # set to true after an =item
	my $need_dd = 0;
	warn "Converting input file $Podfile\n" if $Verbose;
	foreach my $i ( 0 .. $#poddata ) {
		$_         = $poddata[$i];
		$Paragraph = $i + 1;
		if (/^(=.*)/s) {    # is it a pod directive?
			$Ignore     = 0;
			$after_item = 0;
			$need_dd    = 0;
			$_          = $1;
			if (/^=begin\s+(\S+)\s*(.*)/si) {    # =begin
				process_begin( $1, $2 );
			} elsif (/^=end\s+(\S+)\s*(.*)/si) {    # =end
				process_end( $1, $2 );
			} elsif (/^=cut/) {                     # =cut
				process_cut();
			} elsif (/^=pod/) {                     # =pod
				process_pod();
			} else {
				next if @Begin_Stack && $Begin_Stack[-1] ne 'html';

				if (/^=(head[1-6])\s+(.*\S)/s) {    # =head[1-6] heading
					process_head( $1, $2, $Doindex && $index );
				} elsif (/^=item\s*(.*\S)?/sm) {    # =item text
					$need_dd    = process_item($1);
					$after_item = 1;
				} elsif (/^=over\s*(.*)/) {         # =over N
					process_over();
				} elsif (/^=back/) {                # =back
					process_back($need_dd);
				} elsif (/^=for\s+(\S+)\s*(.*)/si) {    # =for
					process_for( $1, $2 );
				} else {
					/^=(\S*)\s*/;
					warn "$0: $Podfile: unknown pod directive '$1' in "
						. "paragraph $Paragraph.  ignoring.\n"
						unless $Quiet;
				}
			}
			$Top = 0;
		} else {
			next if $Ignore;
			next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
			print HTML and next if @Begin_Stack && $Begin_Stack[-1] eq 'html';
			print HTML "<dd>\n" if $need_dd;
			my $text = $_;
			if ( $text =~ /\A\s+/ ) {
				process_pre( \$text );
				print HTML "<pre>\n$text</pre>\n";

			} else {
				process_text( \$text );

				# experimental: check for a paragraph where all lines
				# have some ...\t...\t...\n pattern
				if ( $text =~ /\t/ ) {
					my @lines = split( "\n", $text );
					if ( @lines > 1 ) {
						my $all = 2;
						foreach my $line (@lines) {
							if ( $line =~ /\S/ && $line !~ /\t/ ) {
								$all--;
								last if $all == 0;
							}
						}
						if ( $all > 0 ) {
							$text =~ s/\t+/<td>/g;
							$text =~ s/^/<tr><td>/gm;
							$text =
								  '<table cellspacing="0" cellpadding="0">'
								. $text
								. '</table>';
						}
					}
				}
				## end of experimental

				if ($after_item) {
					$After_Lpar = 1;
				}
				print HTML "<p>$text</p>\n";
			}
			print HTML "</dd>\n" if $need_dd;
			$after_item = 0;
		}
	}

	# finish off any pending directives
	finish_list();

	# link to page index
	print HTML "<p><a href=\"#__index__\"><small>$Backlink</small></a></p>\n"
		if $Doindex
			and $index
			and $Backlink;

	print HTML <<END_OF_TAIL;
$block
</body>

</html>
END_OF_TAIL

	# close the html file
	close(HTML);

	warn "Finished\n" if $Verbose;
}

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

sub usage {
	my $podfile = shift;
	warn "$0: $podfile: @_\n" if @_;
	die <<END_OF_USAGE;
Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
           --podpath=<name>:...:<name> --podroot=<name>
           --libpods=<name>:...:<name> --recurse --verbose --index
           --netscape --norecurse --noindex --cachedir=<name>

  --backlink     - set text for "back to top" links (default: none).
  --cachedir     - directory for the item and directory cache files.
  --css          - stylesheet URL
  --flush        - flushes the item and directory caches.
  --[no]header   - produce block header/footer (default is no headers).
  --help         - prints this message.
  --hiddendirs   - search hidden directories in podpath
  --htmldir      - directory for resulting HTML files.
  --htmlroot     - http-server base directory from which all relative paths
                   in podpath stem (default is /).
  --[no]index    - generate an index at the top of the resulting html
                   (default behaviour).
  --infile       - filename for the pod to convert (input taken from stdin
                   by default).
  --libpods      - colon-separated list of pages to search for =item pod
                   directives in as targets of C<> and implicit links (empty
                   by default).  note, these are not filenames, but rather
                   page names like those that appear in L<> links.
  --outfile      - filename for the resulting html file (output sent to
                   stdout by default).
  --podpath      - colon-separated list of directories containing library
                   pods (empty by default).
  --podroot      - filesystem base directory from which all relative paths
                   in podpath stem (default is .).
  --[no]quiet    - suppress some benign warning messages (default is off).
  --[no]recurse  - recurse on those subdirectories listed in podpath
                   (default behaviour).
  --title        - title that will appear in resulting html file.
  --[no]verbose  - self-explanatory (off by default).
  --[no]netscape - deprecated, has no effect. for backwards compatibility only.

END_OF_USAGE

}

sub parse_command_line {
	my (
		$opt_backlink, $opt_cachedir, $opt_css,     $opt_flush,
		$opt_header,   $opt_help,     $opt_htmldir, $opt_htmlroot,
		$opt_index,    $opt_infile,   $opt_libpods, $opt_netscape,
		$opt_outfile,  $opt_podpath,  $opt_podroot, $opt_quiet,
		$opt_recurse,  $opt_title,    $opt_verbose, $opt_hiddendirs
	);

	unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
	my $result = GetOptions(
		'backlink=s'  => \$opt_backlink,
		'cachedir=s'  => \$opt_cachedir,
		'css=s'       => \$opt_css,
		'flush'       => \$opt_flush,
		'header!'     => \$opt_header,
		'help'        => \$opt_help,
		'hiddendirs!' => \$opt_hiddendirs,
		'htmldir=s'   => \$opt_htmldir,
		'htmlroot=s'  => \$opt_htmlroot,
		'index!'      => \$opt_index,
		'infile=s'    => \$opt_infile,
		'libpods=s'   => \$opt_libpods,
		'netscape!'   => \$opt_netscape,
		'outfile=s'   => \$opt_outfile,
		'podpath=s'   => \$opt_podpath,
		'podroot=s'   => \$opt_podroot,
		'quiet!'      => \$opt_quiet,
		'recurse!'    => \$opt_recurse,
		'title=s'     => \$opt_title,
		'verbose!'    => \$opt_verbose,
	);
	usage( "-", "invalid parameters" ) if not $result;

	usage("-") if defined $opt_help;    # see if the user asked for help
	$opt_help = "";                     # just to make -w shut-up.

	@Podpath = split( ":", $opt_podpath ) if defined $opt_podpath;
	@Libpods = split( ":", $opt_libpods ) if defined $opt_libpods;

	$Backlink   = $opt_backlink   if defined $opt_backlink;
	$Cachedir   = $opt_cachedir   if defined $opt_cachedir;
	$Css        = $opt_css        if defined $opt_css;
	$Header     = $opt_header     if defined $opt_header;
	$Htmldir    = $opt_htmldir    if defined $opt_htmldir;
	$Htmlroot   = $opt_htmlroot   if defined $opt_htmlroot;
	$Doindex    = $opt_index      if defined $opt_index;
	$Podfile    = $opt_infile     if defined $opt_infile;
	$HiddenDirs = $opt_hiddendirs if defined $opt_hiddendirs;
	$Htmlfile   = $opt_outfile    if defined $opt_outfile;
	$Podroot    = $opt_podroot    if defined $opt_podroot;
	$Quiet      = $opt_quiet      if defined $opt_quiet;
	$Recurse    = $opt_recurse    if defined $opt_recurse;
	$Title      = $opt_title      if defined $opt_title;
	$Verbose    = $opt_verbose    if defined $opt_verbose;

	warn "Flushing item and directory caches\n"
		if $opt_verbose && defined $opt_flush;
	$Dircache  = "$Cachedir/pod2htmd.tmp";
	$Itemcache = "$Cachedir/pod2htmi.tmp";
	if ( defined $opt_flush ) {
		1 while unlink( $Dircache, $Itemcache );
	}
}

my $Saved_Cache_Key;

sub get_cache {
	my ( $dircache, $itemcache, $podpath, $podroot, $recurse ) = @_;
	my @cache_key_args = @_;

	# A first-level cache:
	# Don't bother reading the cache files if they still apply
	# and haven't changed since we last read them.

	my $this_cache_key = cache_key(@cache_key_args);

	return if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key;

	# load the cache of %Pages and %Items if possible.  $tests will be
	# non-zero if successful.
	my $tests = 0;
	if ( -f $dircache && -f $itemcache ) {
		warn "scanning for item cache\n" if $Verbose;
		$tests = load_cache( $dircache, $itemcache, $podpath, $podroot );
	}

	# if we didn't succeed in loading the cache then we must (re)build
	#  %Pages and %Items.
	if ( !$tests ) {
		warn "scanning directories in pod-path\n" if $Verbose;
		scan_podpath( $podroot, $recurse, 0 );
	}
	$Saved_Cache_Key = cache_key(@cache_key_args);
}

sub cache_key {
	my ( $dircache, $itemcache, $podpath, $podroot, $recurse ) = @_;
	return join( '!',
		$dircache, $itemcache, $recurse, @$podpath, $podroot, stat($dircache),
		stat($itemcache) );
}

#
# load_cache - tries to find if the caches stored in $dircache and $itemcache
#  are valid caches of %Pages and %Items.  if they are valid then it loads
#  them and returns a non-zero value.
#
sub load_cache {
	my ( $dircache, $itemcache, $podpath, $podroot ) = @_;
	my ($tests);
	local $_;

	$tests = 0;

	open( CACHE, "<$itemcache" )
		|| die "$0: error opening $itemcache for reading: $!\n";
	$/ = "\n";

	# is it the same podpath?
	$_ = <CACHE>;
	chomp($_);
	$tests++ if ( join( ":", @$podpath ) eq $_ );

	# is it the same podroot?
	$_ = <CACHE>;
	chomp($_);
	$tests++ if ( $podroot eq $_ );

	# load the cache if its good
	if ( $tests != 2 ) {
		close(CACHE);
		return 0;
	}

	warn "loading item cache\n" if $Verbose;
	while (<CACHE>) {
		/(.*?) (.*)$/;
		$Items{$1} = $2;
	}
	close(CACHE);

	warn "scanning for directory cache\n" if $Verbose;
	open( CACHE, "<$dircache" )
		|| die "$0: error opening $dircache for reading: $!\n";
	$/     = "\n";
	$tests = 0;

	# is it the same podpath?
	$_ = <CACHE>;
	chomp($_);
	$tests++ if ( join( ":", @$podpath ) eq $_ );

	# is it the same podroot?
	$_ = <CACHE>;
	chomp($_);
	$tests++ if ( $podroot eq $_ );

	# load the cache if its good
	if ( $tests != 2 ) {
		close(CACHE);
		return 0;
	}

	warn "loading directory cache\n" if $Verbose;
	while (<CACHE>) {
		/(.*?) (.*)$/;
		$Pages{$1} = $2;
	}

	close(CACHE);

	return 1;
}

#
# scan_podpath - scans the directories specified in @podpath for directories,
#  .pod files, and .pm files.  it also scans the pod files specified in
#  @Libpods for =item directives.
#
sub scan_podpath {
	my ( $podroot, $recurse, $append ) = @_;
	my ( $pwd, $dir );
	my ( $libpod, $dirname, $pod, @files, @poddata );

	unless ($append) {
		%Items = ();
		%Pages = ();
	}

	# scan each directory listed in @Podpath
	$pwd = getcwd();
	chdir($podroot)
		|| die "$0: error changing to directory $podroot: $!\n";
	foreach $dir (@Podpath) {
		scan_dir( $dir, $recurse );
	}

	# scan the pods listed in @Libpods for =item directives
	foreach $libpod (@Libpods) {

		# if the page isn't defined then we won't know where to find it
		# on the system.
		next unless defined $Pages{$libpod} && $Pages{$libpod};

		# if there is a directory then use the .pod and .pm files within it.
		# NOTE: Only finds the first so-named directory in the tree.
		#	if ($Pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
		if ( $Pages{$libpod} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/ ) {

			#  find all the .pod and .pm files within the directory
			$dirname = $1;
			opendir( DIR, $dirname )
				|| die "$0: error opening directory $dirname: $!\n";
			@files = grep( /(\.pod|\.pm)\z/ && !-d $_, readdir(DIR) );
			closedir(DIR);

			# scan each .pod and .pm file for =item directives
			foreach $pod (@files) {
				open( POD, "<$dirname/$pod" )
					|| die "$0: error opening $dirname/$pod for input: $!\n";
				@poddata = <POD>;
				close(POD);
				clean_data( \@poddata );

				scan_items( \%Items, "$dirname/$pod", @poddata );
			}

			# use the names of files as =item directives too.
### Don't think this should be done this way - confuses issues.(WL)
###	    foreach $pod (@files) {
###		$pod =~ /^(.*)(\.pod|\.pm)$/;
###		$Items{$1} = "$dirname/$1.html" if $1;
###	    }
		} elsif ( $Pages{$libpod} =~ /([^:]*\.pod):/
			|| $Pages{$libpod} =~ /([^:]*\.pm):/ )
		{

			# scan the .pod or .pm file for =item directives
			$pod = $1;
			open( POD, "<$pod" )
				|| die "$0: error opening $pod for input: $!\n";
			@poddata = <POD>;
			close(POD);
			clean_data( \@poddata );

			scan_items( \%Items, "$pod", @poddata );
		} else {
			warn "$0: shouldn't be here (line " . __LINE__ . "\n" unless $Quiet;
		}
	}
	@poddata = ();    # clean-up a bit

	chdir($pwd)
		|| die "$0: error changing to directory $pwd: $!\n";

	# cache the item list for later use
	warn "caching items for later use\n" if $Verbose;
	open( CACHE, ">$Itemcache" )
		|| die "$0: error open $Itemcache for writing: $!\n";

	print CACHE join( ":", @Podpath ) . "\n$podroot\n";
	foreach my $key ( keys %Items ) {
		print CACHE "$key $Items{$key}\n";
	}

	close(CACHE);

	# cache the directory list for later use
	warn "caching directories for later use\n" if $Verbose;
	open( CACHE, ">$Dircache" )
		|| die "$0: error open $Dircache for writing: $!\n";

	print CACHE join( ":", @Podpath ) . "\n$podroot\n";
	foreach my $key ( keys %Pages ) {
		print CACHE "$key $Pages{$key}\n";
	}

	close(CACHE);
}

#
# scan_dir - scans the directory specified in $dir for subdirectories, .pod
#  files, and .pm files.  notes those that it finds.  this information will
#  be used later in order to figure out where the pages specified in L<>
#  links are on the filesystem.
#
sub scan_dir {
	my ( $dir, $recurse ) = @_;
	my ( $t, @subdirs, @pods, $pod, $dirname, @dirs );
	local $_;

	@subdirs = ();
	@pods    = ();

	opendir( DIR, $dir )
		|| die "$0: error opening directory $dir: $!\n";
	while ( defined( $_ = readdir(DIR) ) ) {
		if (   -d "$dir/$_"
			&& $_ ne "."
			&& $_ ne ".."
			&& ( $HiddenDirs || !/^\./ ) )
		{    # directory
			$Pages{$_} = "" unless defined $Pages{$_};
			$Pages{$_} .= "$dir/$_:";
			push( @subdirs, $_ );
		} elsif (/\.pod\z/) {    # .pod
			s/\.pod\z//;
			$Pages{$_} = "" unless defined $Pages{$_};
			$Pages{$_} .= "$dir/$_.pod:";
			push( @pods, "$dir/$_.pod" );
		} elsif (/\.html\z/) {    # .html
			s/\.html\z//;
			$Pages{$_} = "" unless defined $Pages{$_};
			$Pages{$_} .= "$dir/$_.pod:";
		} elsif (/\.pm\z/) {      # .pm
			s/\.pm\z//;
			$Pages{$_} = "" unless defined $Pages{$_};
			$Pages{$_} .= "$dir/$_.pm:";
			push( @pods, "$dir/$_.pm" );
		} elsif ( -T "$dir/$_" ) {    # script(?)
			local *F;
			if ( open( F, "$dir/$_" ) ) {
				my $line;
				while ( defined( $line = <F> ) ) {
					if ( $line =~ /^=(?:pod|head1)/ ) {
						$Pages{$_} = "" unless defined $Pages{$_};
						$Pages{$_} .= "$dir/$_.pod:";
						last;
					}
				}
				close(F);
			}
		}
	}
	closedir(DIR);

	# recurse on the subdirectories if necessary
	if ($recurse) {
		foreach my $subdir (@subdirs) {
			scan_dir( "$dir/$subdir", $recurse );
		}
	}
}

#
# scan_headings - scan a pod file for head[1-6] tags, note the tags, and
#  build an index.
#
sub scan_headings {
	my ( $sections, @data ) = @_;
	my ( $tag, $which_head, $otitle, $listdepth, $index );

	local $Ignore = 0;

	$listdepth = 0;
	$index     = "";

	# scan for =head directives, note their name, and build an index
	#  pointing to each of them.
	foreach my $line (@data) {
		if ( $line =~ /^=(head)([1-6])\s+(.*)/ ) {
			( $tag, $which_head, $otitle ) = ( $1, $2, $3 );

			my $title = depod($otitle);
			my $name  = anchorify($title);
			$$sections{$name} = 1;
			$title = process_text( \$otitle );

			while ( $which_head != $listdepth ) {
				if ( $which_head > $listdepth ) {
					$index .= "\n"
						. ( "\t" x ($listdepth) )
						. ( $listdepth > 0 ? qq{<li class="branch">\n}
							. "\t"x($listdepth + 1): "" )
						. "<ul>";
					$listdepth++;
				} elsif ( $which_head < $listdepth ) {
					$listdepth--;
					$index .= "\n"
						. ( "\t" x $listdepth ) 
						. ( $listdepth > 0 ? "\t" : "" )
						. "</ul>"
						. ( $listdepth >= 0 ? "\n" . ("\t"x$listdepth)
							. "</li>" : "" )
						. "\n";
				}
			}

			$index .= "\n"
				. ( "\t" x $listdepth ) . "<li>"
				. "<a href=\"#"
				. $name . "\">"
				. $title
				. "</a></li>";
		}
	}

	# finish off the lists
	while ( $listdepth-- ) {
		$index .= "\n" . ( "\t" x $listdepth )
			. ($listdepth > 0 ? "\t" : "")
			."</ul>\n"
			. ($listdepth > 0 ? ("\t" x $listdepth) . "</li>" : "" );
	}

	# get rid of bogus lists
	$index =~ s,\t*<ul>\s*</ul>\n,,g;

	return $index;
}

#
# scan_items - scans the pod specified by $pod for =item directives.  we
#  will use this information later on in resolving C<> links.
#
sub scan_items {
	my ( $itemref, $pod, @poddata ) = @_;
	my ( $i, $item );
	local $_;

	$pod =~ s/\.pod\z//;
	$pod .= ".html" if $pod;

	foreach $i ( 0 .. $#poddata ) {
		my $txt = depod( $poddata[$i] );

		# figure out what kind of item it is.
		# Build string for referencing this item.
		if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) {    # bullet
			next unless $1;
			$item = $1;
		} elsif ( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) {   # numbered list
			$item = $1;
		} elsif ( $txt =~ /\A=item\s+(.*)\Z/s ) {                # plain item
			$item = $1;
		} else {
			next;
		}
		my $fid = fragment_id($item);
		$$itemref{$fid} = "$pod" if $fid;
	}
}

#
# process_head - convert a pod head[1-6] tag and convert it to HTML format.
#
sub process_head {
	my ( $tag, $heading, $hasindex ) = @_;

	# figure out the level of the =head
	$tag =~ /head([1-6])/;
	my $level = $1;

	if ($Listlevel) {
		warn
"$0: $Podfile: unterminated list at =head in paragraph $Paragraph.  ignoring.\n"
			unless $Quiet;
		while ($Listlevel) {
			process_back();
		}
	}

	print HTML "<p>\n";
	if ( $level == 1 && !$Top ) {
		print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n"
			if $hasindex and $Backlink;
		print HTML "</p>\n<hr />\n";
	} else {
		print HTML "</p>\n";
	}

	my $name    = anchorify( depod($heading) );
	my $convert = process_text( \$heading );
	$convert =~ s{</?a[^>]+>}{}g;
	print HTML "<h$level><a name=\"$name\" />$convert</h$level>\n";
}

#
# emit_item_tag - print an =item's text
# Note: The global $EmittedItem is used for inhibiting self-references.
#
my $EmittedItem;

sub emit_item_tag($$$) {
	my ( $otext, $text, $compact ) = @_;
	my $item = fragment_id( depod($text), -generate );
	Carp::confess( "Undefined fragment '$text' ("
			. depod($text)
			. ") from fragment_id() in emit_item_tag() in $Podfile" )
		if !defined $item;
	$EmittedItem = $item;
	### print STDERR "emit_item_tag=$item ($text)\n";

	print HTML '<strong>';
	if ( $Items_Named{$item}++ ) {
		print HTML process_text( \$otext );
	} else {
		my $name = $item;
		$name = anchorify($name);
		print HTML 
#qq{<a name="$name" class="item">},
		process_text( \$otext ),
		#	'</a>'
		;
	}
	print HTML "</strong>\n";
	undef($EmittedItem);
}

sub emit_li {
	my ($tag) = @_;
	if ( $Items_Seen[$Listlevel]++ == 0 ) {
		push( @Listend, "</$tag>" );
		print HTML "<$tag>\n";
	}
	my $emitted = $tag eq 'dl' ? 'dt' : 'li';
	print HTML "<$emitted>";
	return $emitted;
}

#
# process_item - convert a pod item tag and convert it to HTML format.
#
sub process_item {
	my ($otext) = @_;
	my $need_dd = 0;    # set to 1 if we need a <dd></dd> after an item

	# lots of documents start a list without doing an =over.  this is
	# bad!  but, the proper thing to do seems to be to just assume
	# they did do an =over.  so warn them once and then continue.
	if ( $Listlevel == 0 ) {
		warn
"$0: $Podfile: unexpected =item directive in paragraph $Paragraph.  ignoring.\n"
			unless $Quiet;
		process_over();
	}

	# formatting: insert a paragraph if preceding item has >1 paragraph
	if ($After_Lpar) {
		print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
		$After_Lpar = 0;
	}

	# remove formatting instructions from the text
	my $text = depod($otext);

	my $emitted;    # the tag actually emitted, used for closing

	# all the list variants:
	if ( $text =~ /\A\*/ ) {    # bullet
		$emitted = emit_li('ul');
		if ( $text =~ /\A\*\s+(\S.*)\Z/s ) {    # with additional text
			my $tag = $1;
			$otext =~ s/\A\*\s+//;
			emit_item_tag( $otext, $tag, 1 );
		}
		print HTML "</li>"
	} elsif ( $text =~ /\A\d+/ ) {    # numbered list
		$emitted = emit_li('ol');
		if ( $text =~ /\A(?>\d+\.?)\s*(\S.*)\Z/s ) {    # with additional text
			my $tag = $1;
			$otext =~ s/\A\d+\.?\s*//;
			emit_item_tag( $otext, $tag, 1 );
		}
		print HTML "</li>";
	} else {    # definition list
		$emitted = emit_li('dl');
		if ( $text =~ /\A(.+)\Z/s ) {    # should have text
			emit_item_tag( $otext, $text, 1 );
		}
		$need_dd = 1;
	}
	print HTML "\n";
	return $need_dd;
}

#
# process_over - process a pod over tag and start a corresponding HTML list.
#
sub process_over {

	# start a new list
	$Listlevel++;
	push( @Items_Seen, 0 );
	$After_Lpar = 0;
}

#
# process_back - process a pod back tag and convert it to HTML format.
#
sub process_back {
	my $need_dd = shift;
	if ( $Listlevel == 0 ) {
		warn
"$0: $Podfile: unexpected =back directive in paragraph $Paragraph.  ignoring.\n"
			unless $Quiet;
		return;
	}

	# close off the list.  note, I check to see if $Listend[$Listlevel] is
	# defined because an =item directive may have never appeared and thus
	# $Listend[$Listlevel] may have never been initialized.
	$Listlevel--;
	if ( defined $Listend[$Listlevel] ) {
		print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
		print HTML $Listend[$Listlevel];
		print HTML "\n";
		pop(@Listend);
	}
	$After_Lpar = 0;

	# clean up item count
	pop(@Items_Seen);
}

#
# process_cut - process a pod cut tag, thus start ignoring pod directives.
#
sub process_cut {
	$Ignore = 1;
}

#
# process_pod - process a pod tag, thus stop ignoring pod directives
# until we see a corresponding cut.
#
sub process_pod {

	# no need to set $Ignore to 0 cause the main loop did it
}

#
# process_for - process a =for pod tag.  if it's for html, spit
# it out verbatim, if illustration, center it, otherwise ignore it.
#
sub process_for {
	my ( $whom, $text ) = @_;
	if ( $whom =~ /^(pod2)?html$/i ) {
		print HTML $text;
	} elsif ( $whom =~ /^illustration$/i ) {
		1 while chomp $text;
		for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) {
			$text .= $ext, last if -r "$text$ext";
		}
		print HTML
qq{<p align="center"><img src="$text" alt="$text illustration" /></p>};
	}
}

#
# process_begin - process a =begin pod tag.  this pushes
# whom we're beginning on the begin stack.  if there's a
# begin stack, we only print if it us.
#
sub process_begin {
	my ( $whom, $text ) = @_;
	$whom = lc($whom);
	push( @Begin_Stack, $whom );
	if ( $whom =~ /^(pod2)?html$/ ) {
		print HTML $text if $text;
	}
}

#
# process_end - process a =end pod tag.  pop the
# begin stack.  die if we're mismatched.
#
sub process_end {
	my ( $whom, $text ) = @_;
	$whom = lc($whom);
	if ( !defined $Begin_Stack[-1] or $Begin_Stack[-1] ne $whom ) {
		Carp::confess(
			"Unmatched begin/end at chunk $Paragraph in pod $Podfile\n");
	}
	pop(@Begin_Stack);
}

#
# process_pre - indented paragraph, made into <pre></pre>
#
sub process_pre {
	my ($text) = @_;
	my ($rest);
	return if $Ignore;

	$rest = $$text;

	# insert spaces in place of tabs
	$rest =~ s#(.+)#
	    my $line = $1;
            1 while $line =~ s/(\t+)/' ' x ((length($1) * 8) - $-[0] % 8)/e;
	    $line;
	#eg;

	# convert some special chars to HTML escapes
	$rest = html_escape($rest);

	# try and create links for all occurrences of perl.* within
	# the preformatted text.
	$rest =~ s{
	         (\s*)(perl\w+)
	      }{
		 if ( defined $Pages{$2} ){	# is a link
		     qq($1<a href="$Htmlroot/$Pages{$2}">$2</a>);
		 } elsif (defined $Pages{dosify($2)}) {	# is a link
		     qq($1<a href="$Htmlroot/$Pages{dosify($2)}">$2</a>);
		 } else {
		     "$1$2";
		 }
	      }xeg;
	$rest =~ s{
		 (<a\ href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]*:)?
               }{
                  my $url ;
                  if ( $Htmlfileurl ne '' ){
		     # Here, we take advantage of the knowledge
		     # that $Htmlfileurl ne '' implies $Htmlroot eq ''.
		     # Since $Htmlroot eq '', we need to prepend $Htmldir
		     # on the fron of the link to get the absolute path
		     # of the link's target. We check for a leading '/'
		     # to avoid corrupting links that are #, file:, etc.
		     my $old_url = $3 ;
		     $old_url = "$Htmldir$old_url" if $old_url =~ m{^\/};
 		     $url = relativize_url( "$old_url.html", $Htmlfileurl );
	          } else {
		     $url = "$3.html" ;
		  }
		  "$1$url" ;
	       }xeg;

	# Look for embedded URLs and make them into links.  We don't
	# relativize them since they are best left as the author intended.

	my $urls = '(' . join(
		'|', qw{
			http
			telnet
			mailto
			news
			gopher
			file
			wais
			ftp
			}
	) . ')';

	my $ltrs = '\w';
	my $gunk = '/#~:.?+=&%@!\-';
	my $punc = '.:!?\-;';
	my $any  = "${ltrs}${gunk}${punc}";

	$rest =~ s{
	\b			# start at word boundary
	(			# begin $1  {
	    $urls :		# need resource and a colon
	    (?!:)		# Ignore File::, among others.
	    [$any] +?		# followed by one or more of any valid
				#   character, but be conservative and
				#   take only what you need to....
	)			# end   $1  }
	(?=
	    &quot; &gt;		# maybe pre-quoted '<a href="...">'
	|			# or:
	    [$punc]*		# 0 or more punctuation
	    (?:			#   followed
		[^$any]		#   by a non-url char
	    |			#   or
		$		#   end of the string
	    )			#
	|			# or else
	    $			#   then end of the string
        )
      }{<a href="$1">$1</a>}igox;

	# text should be as it is (verbatim)
	$$text = $rest;
}

#
# pure text processing
#
# pure_text/inIS_text: differ with respect to automatic C<> recognition.
# we don't want this to happen within IS
#
sub pure_text($) {
	my $text = shift();
	process_puretext( $text, 1 );
}

sub inIS_text($) {
	my $text = shift();
	process_puretext( $text, 0 );
}

#
# process_puretext - process pure text (without pod-escapes) converting
#  double-quotes and handling implicit C<> links.
#
sub process_puretext {
	my ( $text, $notinIS ) = @_;

	## Guessing at func() or [\$\@%&]*var references in plain text is destined
	## to produce some strange looking ref's. uncomment to disable:
	## $notinIS = 0;

	my ( @words, $lead, $trail );

	# keep track of leading and trailing white-space
	$lead  = ( $text =~ s/\A(\s+)//s ? $1 : "" );
	$trail = ( $text =~ s/(\s+)\Z//s ? $1 : "" );

	# split at space/non-space boundaries
	@words = split( /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $text );

	# process each word individually
	foreach my $word (@words) {

		# skip space runs
		next if $word =~ /^\s*$/;

		# see if we can infer a link or a function call
		#
		# NOTE: This is a word based search, it won't automatically
		# mark "substr($var, 1, 2)" because the 1st word would be "substr($var"
		# User has to enclose those with proper C<>

		if (
			   $notinIS
			&& $word =~ m/
		^([a-z_]{2,})                 # The function name
		\(
		    ([0-9][a-z]*              # Manual page(1) or page(1M)
		    |[^)]*[\$\@\%][^)]+       # ($foo), (1, @foo), (%hash)
		    |                         # ()
		    )
		\)
		([.,;]?)$                     # a possible punctuation follows
	    /xi
			)
		{

			# has parenthesis so should have been a C<> ref
			## try for a pagename (perlXXX(1))?
			my ( $func, $args, $rest ) = ( $1, $2, $3 || '' );
			if ( $args =~ /^\d+$/ ) {
				my $url = page_sect( $word, '' );
				if ( defined $url ) {
					$word =
qq(<a href="$url" class="man">the $word manpage</a>$rest);
					next;
				}
			}
			## try function name for a link, append tt'ed argument list
			$word = emit_C( $func, '', "($args)" ) . $rest;

#### disabled. either all (including $\W, $\w+{.*} etc.) or nothing.
##      } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) {
##	    # perl variables, should be a C<> ref
##	    $word = emit_C( $word );

		} elsif ( $word =~ m,^\w+://\w, ) {

			# looks like a URL
			# Don't relativize it: leave it as the author intended
			$word = qq(<a href="$word">$word</a>);
		} elsif ( $word =~ /[\w.-]+\@[\w-]+\.\w/ ) {

			# looks like an e-mail address
			my ( $w1, $w2, $w3 ) = ( "", $word, "" );
			( $w1, $w2, $w3 ) = ( "(", $1, ")$2" ) if $word =~ /^\((.*?)\)(,?)/;
			( $w1, $w2, $w3 ) = ( "&lt;", $1, "&gt;$2" )
				if $word =~ /^<(.*?)>(,?)/;
			$word = qq($w1<a href="mailto:$w2">$w2</a>$w3);
		} else {
			$word = html_escape($word) if $word =~ /["&<>]/;
		}
	}

	# put everything back together
	return $lead . join( '', @words ) . $trail;
}

#
# process_text - handles plaintext that appears in the input pod file.
# there may be pod commands embedded within the text so those must be
# converted to html commands.
#

sub process_text1($$;$$);
sub pattern ($) { $_[0] ? '\s+' . ( '>' x ( $_[0] + 1 ) ) : '>' }
sub closing ($) { local ($_) = shift; ( defined && s/\s+\z// ) ? length : 0 }

sub process_text {
	return if $Ignore;
	my ($tref) = @_;
	my $res = process_text1( 0, $tref );
	$res =~ s/\s+$//s;
	$$tref = $res;
}

sub process_text_rfc_links {
	my $text = shift;

	# For every "RFCnnnn" or "RFC nnn", link it to the authoritative
	# ource. Do not use the /i modifier here. Require "RFC" to be written in
	#  in capital letters.

	$text =~ s{
	(?<=[^<>[:alpha:]])           # Make sure this is not an URL already
	(RFC\s*([0-9]{1,5}))(?![0-9]) # max 5 digits
    }
    {<a href="http://www.ietf.org/rfc/rfc$2.txt" class="rfc">$1</a>}gx;

	$text;
}

sub process_text1($$;$$) {
	my ( $lev, $rstr, $func, $closing ) = @_;
	my $res = '';

	unless ( defined $func ) {
		$func = '';
		$lev++;
	}

	if ( $func eq 'B' ) {

		# B<text> - boldface
		$res = '<strong>' . process_text1( $lev, $rstr ) . '</strong>';

	} elsif ( $func eq 'C' ) {

		# C<code> - can be a ref or <code></code>
		# need to extract text
		my $par = go_ahead( $rstr, 'C', $closing );

		## clean-up of the link target
		my $text = depod($par);

		### my $x = $par =~ /[BI]</ ? 'yes' : 'no' ;
		### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n";

		$res = emit_C( $text, $lev > 1 || ( $par =~ /[BI]</ ) );

	} elsif ( $func eq 'E' ) {

		# E<x> - convert to character
		$$rstr =~ s/^([^>]*)>//;
		my $escape = $1;
		$escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i;
		$res = "&$escape;";

	} elsif ( $func eq 'F' ) {

		# F<filename> - italicize
		$res = '<em class="file">' . process_text1( $lev, $rstr ) . '</em>';

	} elsif ( $func eq 'I' ) {

		# I<text> - italicize
		$res = '<em>' . process_text1( $lev, $rstr ) . '</em>';

	} elsif ( $func eq 'L' ) {

		# L<link> - link
		## L<text|cross-ref> => produce text, use cross-ref for linking
		## L<cross-ref> => make text from cross-ref
		## need to extract text
		my $par = go_ahead( $rstr, 'L', $closing );

		# some L<>'s that shouldn't be:
		# a) full-blown URL's are emitted as-is
		if ( $par =~ m{^\w+://}s ) {
			return make_URL_href($par);
		}

		# b) C<...> is stripped and treated as C<>
		if ( $par =~ /^C<(.*)>$/ ) {
			my $text = depod($1);
			return emit_C( $text, $lev > 1 || ( $par =~ /[BI]</ ) );
		}

		# analyze the contents
		$par =~ s/\n/ /g;    # undo word-wrapped tags
		my $opar = $par;
		my $linktext;
		if ( $par =~ s{^([^|]+)\|}{} ) {
			$linktext = $1;
		}

		if( $par =~ m{^\w+://}s ) {
			return make_URL_href( $par, $linktext );
		}

		# make sure sections start with a /
		$par =~ s{^"}{/"};

		my ( $page, $section, $ident );

		# check for link patterns
		if ( $par =~ m{^([^/]+?)/(?!")(.*?)$} ) {    # name/ident
			    # we've got a name/ident (no quotes)
			if ( length $2 ) {
				( $page, $ident ) = ( $1, $2 );
			} else {
				( $page, $section ) = ( $1, $2 );
			}
			### print STDERR "--> L<$par> to page $page, ident $ident\n";

		} elsif ( $par =~ m{^(.*?)/"?(.*?)"?$} ) {    # [name]/"section"
			    # even though this should be a "section", we go for ident first
			( $page, $ident ) = ( $1, $2 );
			### print STDERR "--> L<$par> to page $page, section $section\n";

		} elsif ( $par =~ /\s/ ) {  # this must be a section with missing quotes
			( $page, $section ) = ( '', $par );
			### print STDERR "--> L<$par> to void page, section $section\n";

		} else {
			( $page, $section ) = ( $par, '' );
			### print STDERR "--> L<$par> to page $par, void section\n";
		}

		# now, either $section or $ident is defined. the convoluted logic
		# below tries to resolve L<> according to what the user specified.
		# failing this, we try to find the next best thing...
		my ( $url, $ltext, $fid );

	RESOLVE: {
			if ( defined $ident ) {
				## try to resolve $ident as an item
				( $url, $fid ) = coderef( $page, $ident );
				if ($url) {
					if ( !defined($linktext) ) {
						$linktext = $ident;
						$linktext .= " in " if $ident && $page;
						$linktext .= "the $page manpage" if $page;
					}
					###  print STDERR "got coderef url=$url\n";
					last RESOLVE;
				}
				## no luck: go for a section (auto-quoting!)
				$section = $ident;
			}
			## now go for a section
			my $htmlsection = htmlify($section);
			$url = page_sect( $page, $htmlsection );
			if ($url) {
				if ( !defined($linktext) ) {
					$linktext = $section;
					$linktext .= " in " if $section && $page;
					$linktext .= "the $page manpage" if $page;
				}
				### print STDERR "got page/section url=$url\n";
				last RESOLVE;
			}
			## no luck: go for an ident
			if ($section) {
				$ident = $section;
			} else {
				$ident = $page;
				$page  = undef();
			}
			( $url, $fid ) = coderef( $page, $ident );
			if ($url) {
				if ( !defined($linktext) ) {
					$linktext = $ident;
					$linktext .= " in " if $ident && $page;
					$linktext .= "the $page manpage" if $page;
				}
				### print STDERR "got section=>coderef url=$url\n";
				last RESOLVE;
			}

			# warning; show some text.
			$linktext = $opar unless defined $linktext;
			warn
"$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n"
				unless $Quiet;
		}

		# now we have a URL or just plain code
		$$rstr = $linktext . '>' . $$rstr;
		if ( defined($url) ) {
			$res = "<a href=\"$url\">" . process_text1( $lev, $rstr ) . '</a>';
		} else {
			$res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
		}

	} elsif ( $func eq 'S' ) {

		# S<text> - non-breaking spaces
		$res = process_text1( $lev, $rstr );
		$res =~ s/ /&nbsp;/g;

	} elsif ( $func eq 'X' ) {

		# X<> - ignore
		warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n"
			unless $$rstr =~ s/^[^>]*>//
				or $Quiet;
	} elsif ( $func eq 'Z' ) {

		# Z<> - empty
		warn "$0: $Podfile: invalid Z<> in paragraph $Paragraph.\n"
			unless $$rstr =~ s/^>//
				or $Quiet;

	} else {
		my $term = pattern $closing;
		while ( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ) {

			# all others: either recurse into new function or
			# terminate at closing angle bracket(s)
			my $pt = $1;
			$pt .= $2 if !$3 && $lev == 1;
			$res .= $lev == 1 ? pure_text($pt) : inIS_text($pt);
			return $res if !$3 && $lev > 1;
			if ($3) {
				$res .= process_text1( $lev, $rstr, $3, closing $4 );
			}
		}
		if ( $lev == 1 ) {
			$res .= pure_text($$rstr);
		} elsif ( !$Quiet ) {
			my $snippet = substr( $$rstr, 0, 60 );
			warn
"$0: $Podfile: undelimited $func<> in paragraph $Paragraph: '$snippet'.\n"

		}
		$res = process_text_rfc_links($res);
	}
	return $res;
}

#
# go_ahead: extract text of an IS (can be nested)
#
sub go_ahead($$$) {
	my ( $rstr, $func, $closing ) = @_;
	my $res     = '';
	my @closing = ($closing);
	while ( $$rstr =~
		s/\A(.*?)(([BCEFILSXZ])<(<+\s+)?|@{[pattern $closing[0]]})//s )
	{
		$res .= $1;
		unless ($3) {
			shift @closing;
			return $res unless @closing;
		} else {
			unshift @closing, closing $4;
		}
		$res .= $2;
	}
	unless ($Quiet) {
		my $snippet = substr( $$rstr, 0, 60 );
		warn
"$0: $Podfile: undelimited $func<> in paragraph $Paragraph (go_ahead): '$snippet'.\n";
	}
	return $res;
}

#
# emit_C - output result of C<text>
#    $text is the depod-ed text
#
sub emit_C($;$$) {
	my ( $text, $nocode, $args ) = @_;
	$args = '' unless defined $args;
	my $res;
	my ( $url, $fid ) = coderef( undef(), $text );

	# need HTML-safe text
	my $linktext = html_escape("$text$args");

	if ( $text !~ /^[\$@%]/
		&& defined($url)
		&& ( !defined($EmittedItem) || $EmittedItem ne $fid ) )
	{
		$res = "<a href=\"$url\"><code>$linktext</code></a>";
	} elsif ( 0 && $nocode ) {
		$res = $linktext;
	} else {
		$res = "<code>$linktext</code>";
	}
	return $res;
}

#
# html_escape: make text safe for HTML
#
sub html_escape {
	my $rest = $_[0];
	$rest =~ s/&/&amp;/g;
	$rest =~ s/</&lt;/g;
	$rest =~ s/>/&gt;/g;
	$rest =~ s/"/&quot;/g;

	# &apos; is only in XHTML, not HTML4.  Be conservative
	#$rest   =~ s/'/&apos;/g;
	return $rest;
}

#
# dosify - convert filenames to 8.3
#
sub dosify {
	my ($str) = @_;
	return lc($str) if $^O eq 'VMS';    # VMS just needs casing
	if ($Is83) {
		$str = lc $str;
		$str =~ s/(\.\w+)/substr ($1,0,4)/ge;
		$str =~ s/(\w+)/substr ($1,0,8)/ge;
	}
	return $str;
}

#
# page_sect - make a URL from the text of a L<>
#
sub page_sect($$) {
	my ( $page, $section ) = @_;
	my ( $linktext, $page83, $link );    # work strings

	# check if we know that this is a section in this page
	if ( !defined $Pages{$page} && defined $Sections{$page} ) {
		$section = $page;
		$page    = "";
		### print STDERR "reset page='', section=$section\n";
	}

	$page83 = dosify($page);
	$page = $page83 if ( defined $Pages{$page83} );
	if ( $page eq "" ) {
		$link = "#" . anchorify($section);
	} elsif ( $page =~ /::/ ) {
		$page =~ s,::,/,g;

		# Search page cache for an entry keyed under the html page name,
		# then look to see what directory that page might be in.  NOTE:
		# this will only find one page. A better solution might be to produce
		# an intermediate page that is an index to all such pages.
		my $page_name = $page;
		$page_name =~ s,^.*/,,s;
		if ( defined( $Pages{$page_name} )
			&& $Pages{$page_name} =~ /([^:]*$page)\.(?:pod|pm):/ )
		{
			$page = $1;
		} else {

			# NOTE: This branch assumes that all A::B pages are located in
			# $Htmlroot/A/B.html . This is often incorrect, since they are
			# often in $Htmlroot/lib/A/B.html or such like. Perhaps we could
			# analyze the contents of %Pages and figure out where any
			# cousins of A::B are, then assume that.  So, if A::B isn't found,
			# but A::C is found in lib/A/C.pm, then A::B is assumed to be in
			# lib/A/B.pm. This is also limited, but it's an improvement.
			# Maybe a hints file so that the links point to the correct places
			# nonetheless?

		}
		$link = "$Htmlroot/$page.html";
		$link .= "#" . anchorify($section) if ($section);
	} elsif ( !defined $Pages{$page} ) {
		$link = "";
	} else {
		$section = anchorify($section) if $section ne "";
		### print STDERR "...section=$section\n";

		# if there is a directory by the name of the page, then assume that an
		# appropriate section will exist in the subdirectory
		#	if ($section ne "" && $Pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
		if ( $section ne "" && $Pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/ )
		{
			$link = "$Htmlroot/$1/$section.html";
			### print STDERR "...link=$link\n";

		 # since there is no directory by the name of the page, the section will
		 # have to exist within a .html of the same name.  thus, make sure there
		 # is a .pod or .pm that might become that .html
		} else {
			$section = "#$section" if $section;
			### print STDERR "...section=$section\n";

			# check if there is a .pod with the page name.
			# for L<Foo>, Foo.(pod|pm) is preferred to A/Foo.(pod|pm)
			if ( $Pages{$page} =~ /([^:]*)\.(?:pod|pm):/ ) {
				$link = "$Htmlroot/$1.html$section";
			} else {
				$link = "";
			}
		}
	}

	if ($link) {

		# Here, we take advantage of the knowledge that $Htmlfileurl ne ''
		# implies $Htmlroot eq ''. This means that the link in question
		# needs a prefix of $Htmldir if it begins with '/'. The test for
		# the initial '/' is done to avoid '#'-only links, and to allow
		# for other kinds of links, like file:, ftp:, etc.
		my $url;
		if ( $Htmlfileurl ne '' ) {
			$link = "$Htmldir$link" if $link =~ m{^/}s;
			$url = relativize_url( $link, $Htmlfileurl );

			# print( "  b: [$link,$Htmlfileurl,$url]\n" );
		} else {
			$url = $link;
		}
		return $url;

	} else {
		return undef();
	}
}

#
# relativize_url - convert an absolute URL to one relative to a base URL.
# Assumes both end in a filename.
#
sub relativize_url {
	my ( $dest, $source ) = @_;

	my ( $dest_volume, $dest_directory, $dest_file ) =
		File::Spec::Unix->splitpath($dest);
	$dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' );

	my ( $source_volume, $source_directory, $source_file ) =
		File::Spec::Unix->splitpath($source);
	$source =
		File::Spec::Unix->catpath( $source_volume, $source_directory, '' );

	my $rel_path = '';
	if ( $dest ne '' ) {
		$rel_path = File::Spec::Unix->abs2rel( $dest, $source );
	}

	if (   $rel_path ne ''
		&& substr( $rel_path, -1 ) ne '/'
		&& substr( $dest_file, 0, 1 ) ne '#' )
	{
		$rel_path .= "/$dest_file";
	} else {
		$rel_path .= "$dest_file";
	}

	return $rel_path;
}

#
# coderef - make URL from the text of a C<>
#
sub coderef($$) {
	my ( $page, $item ) = @_;
	my ($url);

	my $fid = fragment_id($item);

	if ( defined($page) && $page ne "" ) {

		# we have been given a $page...
		$page =~ s{::}{/}g;

		Carp::confess(
"Undefined fragment '$item' from fragment_id() in coderef() in $Podfile"
		) if !defined $fid;

		# Do we take it? Item could be a section!
		my $base = $Items{$fid} || "";
		$base =~ s{[^/]*/}{};
		if ( $base ne "$page.html" ) {
			###   print STDERR "coderef( $page, $item ): items{$fid} = $Items{$fid} = $base => discard page!\n";
			$page = undef();
		}

	} else {

		# no page - local items precede cached items
		if ( defined($fid) ) {
			if ( exists $Local_Items{$fid} ) {
				$page = $Local_Items{$fid};
			} else {
				$page = $Items{$fid};
			}
		}
	}

	# if there was a pod file that we found earlier with an appropriate
	# =item directive, then create a link to that page.
	if ( defined $page ) {
		if ($page) {
			if ( exists $Pages{$page} and $Pages{$page} =~ /([^:.]*)\.[^:]*:/ )
			{
				$page = $1 . '.html';
			}
			my $link = "$Htmlroot/$page#" . anchorify($fid);

			# Here, we take advantage of the knowledge that $Htmlfileurl
			# ne '' implies $Htmlroot eq ''.
			if ( $Htmlfileurl ne '' ) {
				$link = "$Htmldir$link";
				$url = relativize_url( $link, $Htmlfileurl );
			} else {
				$url = $link;
			}
		} else {
			$url = "#" . anchorify($fid);
		}

		confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/;
	}
	return ( $url, $fid );
}

#
# Adapted from Nick Ing-Simmons' PodToHtml package.
sub relative_url {
	my $source_file      = shift;
	my $destination_file = shift;

	my $source = URI::file->new_abs($source_file);
	my $uo = URI::file->new( $destination_file, $source )->abs;
	return $uo->rel->as_string;
}

#
# finish_list - finish off any pending HTML lists.  this should be called
# after the entire pod file has been read and converted.
#
sub finish_list {
	while ( $Listlevel > 0 ) {
		print HTML "</dl>\n";
		$Listlevel--;
	}
}

#
# htmlify - converts a pod section specification to a suitable section
# specification for HTML. Note that we keep spaces and special characters
# except ", ? (Netscape problem) and the hyphen (writer's problem...).
#
sub htmlify {
	my ($heading) = @_;
	$heading =~ s/(\s+)/ /g;
	$heading =~ s/\s+\Z//;
	$heading =~ s/\A\s+//;

	# The hyphen is a disgrace to the English language.
	# $heading =~ s/[-"?]//g;
	$heading =~ s/["?]//g;
	$heading = lc($heading);
	return $heading;
}

#
# similar to htmlify, but turns non-alphanumerics into underscores
#
sub anchorify {
	my ($anchor) = @_;
	$anchor =~ s/\([^)]*\)//;
	$anchor = htmlify($anchor);
	$anchor =~ s/\W/_/g;
	$anchor =~ tr/_/_/s;
	return $anchor;
}

#
# depod - convert text by eliminating all interior sequences
# Note: can be called with copy or modify semantics
#
my %E2c;
$E2c{lt}     = '<';
$E2c{gt}     = '>';
$E2c{sol}    = '/';
$E2c{verbar} = '|';
$E2c{amp}    = '&';    # in Tk's pods

sub depod1($;$$);

sub depod($) {
	my $string;
	if ( ref( $_[0] ) ) {
		$string = ${ $_[0] };
		${ $_[0] } = depod1( \$string );
	} else {
		$string = $_[0];
		depod1( \$string );
	}
}

sub depod1($;$$) {
	my ( $rstr, $func, $closing ) = @_;
	my $res = '';
	return $res unless defined $$rstr;
	if ( !defined($func) ) {

		# skip to next begin of an interior sequence
		while ( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?//s ) {

			# recurse into its text
			$res .= $1 . depod1( $rstr, $2, closing $3);
		}
		$res .= $$rstr;
	} elsif ( $func eq 'E' ) {

		# E<x> - convert to character
		$$rstr =~ s/^([^>]*)>//;
		$res .= $E2c{$1} || "";
	} elsif ( $func eq 'X' ) {

		# X<> - ignore
		$$rstr =~ s/^[^>]*>//;
	} elsif ( $func eq 'Z' ) {

		# Z<> - empty
		$$rstr =~ s/^>//;
	} else {

		# all others: either recurse into new function or
		# terminate at closing angle bracket
		my $term = pattern $closing;
		while ( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ) {
			$res .= $1;
			last unless $3;
			$res .= depod1( $rstr, $3, closing $4 );
		}
		## If we're here and $2 ne '>': undelimited interior sequence.
		## Ignored, as this is called without proper indication of where we are.
		## Rely on process_text to produce diagnostics.
	}
	return $res;
}

{
	my %seen;    # static fragment record hash

	sub fragment_id_readable {
		my $text     = shift;
		my $generate = shift;    # optional flag

		my $orig = $text;

		# leave the words for the fragment identifier,
		# change everything else to underbars.
		$text =~
			s/[^A-Za-z0-9_]+/_/g;    # do not use \W to avoid locale dependency.
		$text =~ s/_{2,}/_/g;
		$text =~ s/\A_//;
		$text =~ s/_\Z//;

		unless ($text) {

			# Nothing left after removing punctuation, so leave it as is
			# E.g. if option is named: "=item -#"

			$text = $orig;
		}

		if ($generate) {
			if ( exists $seen{$text} ) {

				# This already exists, make it unique
				$seen{$text}++;
				$text = $text . $seen{$text};
			} else {
				$seen{$text} = 1;    # first time seen this fragment
			}
		}

		$text;
	}
}

my @HC;

sub fragment_id_obfuscated {         # This was the old "_2d_2d__"
	my $text     = shift;
	my $generate = shift;            # optional flag

	# text? Normalize by obfuscating the fragment id to make it unique
	$text =~ s/\s+/_/sg;

	$text =~ s{(\W)}{
        defined( $HC[ord($1)] ) ? $HC[ord($1)]
        : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
	$text = substr( $text, 0, 50 );

	$text;
}

#
# fragment_id - construct a fragment identifier from:
#   a) =item text
#   b) contents of C<...>
#

sub fragment_id {
	my $text     = shift;
	my $generate = shift;    # optional flag

	$text =~ s/\s+\Z//s;
	if ($text) {

		# a method or function?
		return $1 if $text =~ /(\w+)\s*\(/;
		return $1 if $text =~ /->\s*(\w+)\s*\(?/;

		# a variable name?
		return $1 if $text =~ /^([\$\@%*]\S+)/;

		# some pattern matching operator?
		return $1 if $text =~ m|^(\w+/).*/\w*$|;

		# fancy stuff... like "do { }"
		return $1 if $text =~ m|^(\w+)\s*{.*}$|;

		# honour the perlfunc manpage: func [PAR[,[ ]PAR]...]
		# and some funnies with ... Module ...
		return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z,/& ][A-Z\d,/& ]*)?$};
		return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$};

		return fragment_id_readable( $text, $generate );
	} else {
		return;
	}
}

#
# make_URL_href - generate HTML href from URL
# Special treatment for CGI queries.
#
sub make_URL_href($;$) {
	my ($url) = shift;
	my $linktext = shift || $url;
	if ( $url !~ s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i ) {
		$url = "<a href=\"$url\">$linktext</a>";
	}
	return $url;
}

1;