diff options
author | Todd C. Miller <millert@cvs.openbsd.org> | 1997-11-30 08:00:34 +0000 |
---|---|---|
committer | Todd C. Miller <millert@cvs.openbsd.org> | 1997-11-30 08:00:34 +0000 |
commit | ebf0e4c599bca88436539559ca7c08c69ed197bf (patch) | |
tree | e362bb5a7d421f975e2c52ccd13c7479b8f6f175 /gnu/usr.bin/perl/lib/Pod/Html.pm | |
parent | 3d06de7fcff1d605886d3c63220956f7260ddb84 (diff) |
perl5.005_03
Diffstat (limited to 'gnu/usr.bin/perl/lib/Pod/Html.pm')
-rw-r--r-- | gnu/usr.bin/perl/lib/Pod/Html.pm | 1523 |
1 files changed, 1523 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/lib/Pod/Html.pm b/gnu/usr.bin/perl/lib/Pod/Html.pm new file mode 100644 index 00000000000..ffeb0b21361 --- /dev/null +++ b/gnu/usr.bin/perl/lib/Pod/Html.pm @@ -0,0 +1,1523 @@ +package Pod::Html; + +use Pod::Functions; +use Getopt::Long; # package for handling command-line parameters +require Exporter; +@ISA = Exporter; +@EXPORT = qw(pod2html htmlify); +use Cwd; + +use Carp; + +use strict; + +=head1 NAME + +Pod::HTML - module to convert pod files to HTML + +=head1 SYNOPSIS + + use Pod::HTML; + pod2html([options]); + +=head1 DESCRIPTION + +Converts files from pod format (see L<perlpod>) to HTML format. It +can automatically generate indexes and cross-references, and it keeps +a cache of things it knows how to cross-reference. + +=head1 ARGUMENTS + +Pod::Html takes the following arguments: + +=over 4 + +=item help + + --help + +Displays the usage message. + +=item htmlroot + + --htmlroot=name + +Sets the base URL for the HTML files. When cross-references are made, +the HTML root is prepended to the URL. + +=item infile + + --infile=name + +Specify the pod file to convert. Input is taken from STDIN if no +infile is specified. + +=item outfile + + --outfile=name + +Specify the HTML file to create. Output goes to STDOUT if no outfile +is specified. + +=item podroot + + --podroot=name + +Specify the base directory for finding library pods. + +=item podpath + + --podpath=name:...:name + +Specify which subdirectories of the podroot contain pod files whose +HTML converted forms can be linked-to in cross-references. + +=item libpods + + --libpods=name:...:name + +List of page names (eg, "perlfunc") which contain linkable C<=item>s. + +=item netscape + + --netscape + +Use Netscape HTML directives when applicable. + +=item nonetscape + + --nonetscape + +Do not use Netscape HTML directives (default). + +=item index + + --index + +Generate an index at the top of the HTML file (default behaviour). + +=item noindex + + --noindex + +Do not generate an index at the top of the HTML file. + + +=item recurse + + --recurse + +Recurse into subdirectories specified in podpath (default behaviour). + +=item norecurse + + --norecurse + +Do not recurse into subdirectories specified in podpath. + +=item title + + --title=title + +Specify the title of the resulting HTML file. + +=item verbose + + --verbose + +Display progress messages. + +=back + +=head1 EXAMPLE + + pod2html("pod2html", + "--podpath=lib:ext:pod:vms", + "--podroot=/usr/src/perl", + "--htmlroot=/perl/nmanual", + "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop", + "--recurse", + "--infile=foo.pod", + "--outfile=/perl/nmanual/foo.html"); + +=head1 AUTHOR + +Tom Christiansen, E<lt>tchrist@perl.comE<gt>. + +=head1 BUGS + +Has trouble with C<> etc in = commands. + +=head1 SEE ALSO + +L<perlpod> + +=head1 COPYRIGHT + +This program is distributed under the Artistic License. + +=cut + +my $dircache = "pod2html-dircache"; +my $itemcache = "pod2html-itemcache"; + +my @begin_stack = (); # begin/end stack + +my @libpods = (); # files to search for links from C<> directives +my $htmlroot = "/"; # http-server base directory from which all + # relative paths in $podpath stem. +my $htmlfile = ""; # write to stdout by default +my $podfile = ""; # read from stdin by default +my @podpath = (); # list of directories containing library pods. +my $podroot = "."; # filesystem base directory from which all + # relative paths in $podpath stem. +my $recurse = 1; # recurse on subdirectories in $podpath. +my $verbose = 0; # not verbose by default +my $doindex = 1; # non-zero if we should generate an index +my $listlevel = 0; # current list depth +my @listitem = (); # stack of HTML commands to use when a =item is + # encountered. the top of the stack is the + # current list. +my @listdata = (); # similar to @listitem, but for the text after + # an =item +my @listend = (); # similar to @listitem, but the text to use to + # end the list. +my $ignore = 1; # whether or not to format text. we don't + # format text until we hit our first pod + # directive. + +my %items_named = (); # for the multiples of the same item in perlfunc +my @items_seen = (); +my $netscape = 0; # whether or not to use netscape directives. +my $title; # title to give the pod(s) +my $top = 1; # true if we are at the top of the doc. used + # to prevent the first <HR> directive. +my $paragraph; # which paragraph we're processing (used + # for error messages) +my %pages = (); # associative array used to find the location + # of pages referenced by L<> links. +my %sections = (); # sections within this page +my %items = (); # associative array used to find the location + # of =item directives referenced by C<> links +sub init_globals { +$dircache = "pod2html-dircache"; +$itemcache = "pod2html-itemcache"; + +@begin_stack = (); # begin/end stack + +@libpods = (); # files to search for links from C<> directives +$htmlroot = "/"; # http-server base directory from which all + # relative paths in $podpath stem. +$htmlfile = ""; # write to stdout by default +$podfile = ""; # read from stdin by default +@podpath = (); # list of directories containing library pods. +$podroot = "."; # filesystem base directory from which all + # relative paths in $podpath stem. +$recurse = 1; # recurse on subdirectories in $podpath. +$verbose = 0; # not verbose by default +$doindex = 1; # non-zero if we should generate an index +$listlevel = 0; # current list depth +@listitem = (); # stack of HTML commands to use when a =item is + # encountered. the top of the stack is the + # current list. +@listdata = (); # similar to @listitem, but for the text after + # an =item +@listend = (); # similar to @listitem, but the text to use to + # end the list. +$ignore = 1; # whether or not to format text. we don't + # format text until we hit our first pod + # directive. + +@items_seen = (); +%items_named = (); +$netscape = 0; # whether or not to use netscape directives. +$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 + +# These are not reinitialised here but are kept as a cache. +# See get_cache and related cache management code. +#%pages = (); # associative array used to find the location + # of pages referenced by L<> links. +#%items = (); # associative array used to find the location + # of =item directives referenced by C<> links + +} + +sub pod2html { + local(@ARGV) = @_; + local($/); + local $_; + + init_globals(); + + # 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(); + + # 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 // + + # read the pod a paragraph at a time + warn "Scanning for sections in input file(s)\n" if $verbose; + $/ = ""; + my @poddata = <POD>; + close(POD); + + # scan the pod for =head[1-6] directives and build an index + my $index = scan_headings(\%sections, @poddata); + + unless($index) { + warn "No pod in $podfile\n" if $verbose; + return; + } + + # open the output file + open(HTML, ">$htmlfile") + || die "$0: cannot open $htmlfile file for output: $!\n"; + + # put a title in the HTML file + $title = ''; + 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$/) { + # 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; + } + unless ($title) { + warn "$0: no title for $podfile"; + $podfile =~ /^(.*)(\.[^.\/]+)?$/; + $title = ($podfile eq "-" ? 'No Title' : $1); + warn "using $title" if $verbose; + } + print HTML <<END_OF_HEAD; + <HTML> + <HEAD> + <TITLE>$title</TITLE> + </HEAD> + + <BODY> + +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("", \%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; + print HTML "<!-- INDEX BEGIN -->\n"; + print HTML "<!--\n" unless $doindex; + print HTML $index; + print HTML "-->\n" unless $doindex; + print HTML "<!-- INDEX END -->\n\n"; + print HTML "<HR>\n" if $doindex; + + # now convert this file + warn "Converting input file\n" if $verbose; + foreach my $i (0..$#poddata) { + $_ = $poddata[$i]; + $paragraph = $i+1; + if (/^(=.*)/s) { # is it a pod directive? + $ignore = 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) { # =head[1-6] heading + process_head($1, $2); + } elsif (/^=item\s*(.*)/sm) { # =item text + process_item($1); + } elsif (/^=over\s*(.*)/) { # =over N + process_over(); + } elsif (/^=back/) { # =back + process_back(); + } 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"; + } + } + $top = 0; + } + else { + next if $ignore; + next if @begin_stack && $begin_stack[-1] ne 'html'; + my $text = $_; + process_text(\$text, 1); + print HTML "$text\n<P>\n\n"; + } + } + + # finish off any pending directives + finish_list(); + print HTML <<END_OF_TAIL; + </BODY> + + </HTML> +END_OF_TAIL + + # close the html file + close(HTML); + + warn "Finished\n" if $verbose; +} + +############################################################################## + +my $usage; # see below +sub usage { + my $podfile = shift; + warn "$0: $podfile: @_\n" if @_; + die $usage; +} + +$usage =<<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 + + --flush - flushes the item and directory caches. + --help - prints this message. + --htmlroot - http-server base directory from which all relative paths + in podpath stem (default is /). + --index - generate an index at the top of the resulting html + (default). + --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. + --netscape - will use netscape html directives when applicable. + --nonetscape - will not use netscape directives (default). + --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 .). + --noindex - don't generate an index at the top of the resulting html. + --norecurse - don't recurse on those subdirectories listed in podpath. + --recurse - recurse on those subdirectories listed in podpath + (default behavior). + --title - title that will appear in resulting html file. + --verbose - self-explanatory + +END_OF_USAGE + +sub parse_command_line { + my ($opt_flush,$opt_help,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_norecurse,$opt_recurse,$opt_title,$opt_verbose); + my $result = GetOptions( + 'flush' => \$opt_flush, + 'help' => \$opt_help, + '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, + 'norecurse' => \$opt_norecurse, + '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. + + $podfile = $opt_infile if defined $opt_infile; + $htmlfile = $opt_outfile if defined $opt_outfile; + + @podpath = split(":", $opt_podpath) if defined $opt_podpath; + @libpods = split(":", $opt_libpods) if defined $opt_libpods; + + warn "Flushing item and directory caches\n" + if $opt_verbose && defined $opt_flush; + unlink($dircache, $itemcache) if defined $opt_flush; + + $htmlroot = $opt_htmlroot if defined $opt_htmlroot; + $podroot = $opt_podroot if defined $opt_podroot; + + $doindex = $opt_index if defined $opt_index; + $recurse = $opt_recurse if defined $opt_recurse; + $title = $opt_title if defined $opt_title; + $verbose = defined $opt_verbose ? 1 : 0; + $netscape = $opt_netscape if defined $opt_netscape; +} + + +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. + 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)$/ && ! -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); + + scan_items("$dirname/$pod", @poddata); + } + + # use the names of files as =item directives too. + 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); + + scan_items("$pod", @poddata); + } else { + warn "$0: shouldn't be here (line ".__LINE__."\n"; + } + } + @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 "..") { # directory + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_:"; + push(@subdirs, $_); + } elsif (/\.pod$/) { # .pod + s/\.pod$//; + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_.pod:"; + push(@pods, "$dir/$_.pod"); + } elsif (/\.pm$/) { # .pm + s/\.pm$//; + $pages{$_} = "" unless defined $pages{$_}; + $pages{$_} .= "$dir/$_.pm:"; + push(@pods, "$dir/$_.pm"); + } + } + 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, $title, $listdepth, $index); + + # here we need local $ignore = 0; + # unfortunately, we can't have it, because $ignore is lexical + $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, $title) = ($1,$2,$3); + chomp($title); + $$sections{htmlify(0,$title)} = 1; + + if ($which_head > $listdepth) { + $index .= "\n" . ("\t" x $listdepth) . "<UL>\n"; + } elsif ($which_head < $listdepth) { + $listdepth--; + $index .= "\n" . ("\t" x $listdepth) . "</UL>\n"; + } + $listdepth = $which_head; + + $index .= "\n" . ("\t" x $listdepth) . "<LI>" . + "<A HREF=\"#" . htmlify(0,$title) . "\">" . + process_text(\$title, 0) . "</A>"; + } + } + + # finish off the lists + while ($listdepth--) { + $index .= "\n" . ("\t" x $listdepth) . "</UL>\n"; + } + + # get rid of bogus lists + $index =~ s,\t*<UL>\s*</UL>\n,,g; + + $ignore = 1; # restore old value; + + 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($pod, @poddata) = @_; + my($i, $item); + local $_; + + $pod =~ s/\.pod$//; + $pod .= ".html" if $pod; + + foreach $i (0..$#poddata) { + $_ = $poddata[$i]; + + # remove any formatting instructions + s,[A-Z]<([^<>]*)>,$1,g; + + # figure out what kind of item it is and get the first word of + # it's name. + if (/^=item\s+(\w*)\s*.*$/s) { + if ($1 eq "*") { # bullet list + /\A=item\s+\*\s*(.*?)\s*\Z/s; + $item = $1; + } elsif ($1 =~ /^[0-9]+/) { # numbered list + /\A=item\s+[0-9]+\.?(.*?)\s*\Z/s; + $item = $1; + } else { +# /\A=item\s+(.*?)\s*\Z/s; + /\A=item\s+(\w*)/s; + $item = $1; + } + + $items{$item} = "$pod" if $item; + } + } +} + +# +# process_head - convert a pod head[1-6] tag and convert it to HTML format. +# +sub process_head { + my($tag, $heading) = @_; + my $firstword; + + # figure out the level of the =head + $tag =~ /head([1-6])/; + my $level = $1; + + # can't have a heading full of spaces and speechmarks and so on + $firstword = $heading; $firstword =~ s/\s*(\w+)\s.*/$1/; + + print HTML "<P>\n" unless $listlevel; + print HTML "<HR>\n" unless $listlevel || $top; + print HTML "<H$level>"; # unless $listlevel; + #print HTML "<H$level>" unless $listlevel; + my $convert = $heading; process_text(\$convert, 0); + print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>"; + print HTML "</H$level>"; # unless $listlevel; + print HTML "\n"; +} + +# +# process_item - convert a pod item tag and convert it to HTML format. +# +sub process_item { + my $text = $_[0]; + my($i, $quote, $name); + + my $need_preamble = 0; + my $this_entry; + + + # 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. + warn "$0: $podfile: unexpected =item directive in paragraph $paragraph. ignoring.\n" + unless $listlevel; + process_over() unless $listlevel; + + return unless $listlevel; + + # remove formatting instructions from the text + 1 while $text =~ s/[A-Z]<([^<>]*)>/$1/g; + pre_escape(\$text); + + $need_preamble = $items_seen[$listlevel]++ == 0; + + # check if this is the first =item after an =over + $i = $listlevel - 1; + my $need_new = $listlevel >= @listitem; + + if ($text =~ /\A\*/) { # bullet + + if ($need_preamble) { + push(@listend, "</UL>"); + print HTML "<UL>\n"; + } + + print HTML "<LI><STRONG>"; + $text =~ /\A\*\s*(.*)\Z/s; + print HTML "<A NAME=\"item_" . htmlify(1,$1) . "\">" if $1 && !$items_named{$1}++; + $quote = 1; + #print HTML process_puretext($1, \$quote); + print HTML $1; + print HTML "</A>" if $1; + print HTML "</STRONG>"; + + } elsif ($text =~ /\A[0-9#]+/) { # numbered list + + if ($need_preamble) { + push(@listend, "</OL>"); + print HTML "<OL>\n"; + } + + print HTML "<LI><STRONG>"; + $text =~ /\A[0-9]+\.?(.*)\Z/s; + print HTML "<A NAME=\"item_" . htmlify(0,$1) . "\">" if $1; + $quote = 1; + #print HTML process_puretext($1, \$quote); + print HTML $1 if $1; + print HTML "</A>" if $1; + print HTML "</STRONG>"; + + } else { # all others + + if ($need_preamble) { + push(@listend, '</DL>'); + print HTML "<DL>\n"; + } + + print HTML "<DT><STRONG>"; + print HTML "<A NAME=\"item_" . htmlify(1,$text) . "\">" + if $text && !$items_named{($text =~ /(\S+)/)[0]}++; + # preceding craziness so that the duplicate leading bits in + # perlfunc work to find just the first one. otherwise + # open etc would have many names + $quote = 1; + #print HTML process_puretext($text, \$quote); + print HTML $text; + print HTML "</A>" if $text; + print HTML "</STRONG>"; + + print HTML '<DD>'; + } + + print HTML "\n"; +} + +# +# process_over - process a pod over tag and start a corresponding HTML +# list. +# +sub process_over { + # start a new list + $listlevel++; +} + +# +# process_back - process a pod back tag and convert it to HTML format. +# +sub process_back { + warn "$0: $podfile: unexpected =back directive in paragraph $paragraph. ignoring.\n" + unless $listlevel; + return unless $listlevel; + + # 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--; + print HTML $listend[$listlevel] if defined $listend[$listlevel]; + print HTML "\n"; + + # don't need the corresponding perl code anymore + pop(@listitem); + pop(@listdata); + pop(@listend); + + pop(@items_seen); +} + +# +# process_cut - process a pod cut tag, thus stop ignoring pod directives. +# +sub process_cut { + $ignore = 1; +} + +# +# process_pod - process a pod pod tag, thus ignore 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, split +# it out verbatim, otherwise ignore it. +# +sub process_for { + my($whom, $text) = @_; + if ( $whom =~ /^(pod2)?html$/i) { + print HTML $text; + } +} + +# +# 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 ($begin_stack[-1] ne $whom ) { + die "Unmatched begin/end at chunk $paragraph\n" + } + pop @begin_stack; +} + +# +# 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_text { + my($text, $escapeQuotes) = @_; + my($result, $rest, $s1, $s2, $s3, $s4, $match, $bf); + my($podcommand, $params, $tag, $quote); + + return if $ignore; + + $quote = 0; # status of double-quote conversion + $result = ""; + $rest = $$text; + + if ($rest =~ /^\s+/) { # preformatted text, no pod directives + $rest =~ s/\n+\Z//; + $rest =~ s#.*# + my $line = $&; + 1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e; + $line; + #eg; + + $rest =~ s/&/&/g; + $rest =~ s/</</g; + $rest =~ s/>/>/g; + $rest =~ s/"/"/g; + + # 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>); + } else { + "$1$2"; + } + }xeg; + $rest =~ s/(<A HREF=)([^>:]*:)?([^>:]*)\.pod:([^>:]*:)?/$1$3.html/g; + + 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 + [$any] +? # followed by on or more + # of any valid character, but + # be conservative and take only + # what you need to.... + ) # end $1 } + (?= # look-ahead non-consumptive assertion + [$punc]* # either 0 or more puntuation + [^$any] # followed by a non-url char + | # or else + $ # then end of the string + ) + }{<A HREF="$1">$1</A>}igox; + + $result = "<PRE>" # text should be as it is (verbatim) + . "$rest\n" + . "</PRE>\n"; + } else { # formatted text + # parse through the string, stopping each time we find a + # pod-escape. once the string has been throughly processed + # we can output it. + while ($rest) { + # check to see if there are any possible pod directives in + # the remaining part of the text. + if ($rest =~ m/[BCEIFLSZ]</) { + warn "\$rest\t= $rest\n" unless + $rest =~ /\A + ([^<]*?) + ([BCEIFLSZ]?) + < + (.*)\Z/xs; + + $s1 = $1; # pure text + $s2 = $2; # the type of pod-escape that follows + $s3 = '<'; # '<' + $s4 = $3; # the rest of the string + } else { + $s1 = $rest; + $s2 = ""; + $s3 = ""; + $s4 = ""; + } + + if ($s3 eq '<' && $s2) { # a pod-escape + $result .= ($escapeQuotes ? process_puretext($s1, \$quote) : $s1); + $podcommand = "$s2<"; + $rest = $s4; + + # find the matching '>' + $match = 1; + $bf = 0; + while ($match && !$bf) { + $bf = 1; + if ($rest =~ /\A([^<>]*[BCEIFLSZ]<)(.*)\Z/s) { + $bf = 0; + $match++; + $podcommand .= $1; + $rest = $2; + } elsif ($rest =~ /\A([^>]*>)(.*)\Z/s) { + $bf = 0; + $match--; + $podcommand .= $1; + $rest = $2; + } + } + + if ($match != 0) { + warn <<WARN; +$0: $podfile: cannot find matching > for $s2 in paragraph $paragraph. +WARN + $result .= substr $podcommand, 0, 2; + $rest = substr($podcommand, 2) . $rest; + next; + } + + # pull out the parameters to the pod-escape + $podcommand =~ /^([BCFEILSZ]?)<(.*)>$/s; + $tag = $1; + $params = $2; + + # process the text within the pod-escape so that any escapes + # which must occur do. + process_text(\$params, 0) unless $tag eq 'L'; + + $s1 = $params; + if (!$tag || $tag eq " ") { # <> : no tag + $s1 = "<$params>"; + } elsif ($tag eq "L") { # L<> : link + $s1 = process_L($params); + } elsif ($tag eq "I" || # I<> : italicize text + $tag eq "B" || # B<> : bold text + $tag eq "F") { # F<> : file specification + $s1 = process_BFI($tag, $params); + } elsif ($tag eq "C") { # C<> : literal code + $s1 = process_C($params, 1); + } elsif ($tag eq "E") { # E<> : escape + $s1 = process_E($params); + } elsif ($tag eq "Z") { # Z<> : zero-width character + $s1 = process_Z($params); + } elsif ($tag eq "S") { # S<> : non-breaking space + $s1 = process_S($params); + } elsif ($tag eq "X") { # S<> : non-breaking space + $s1 = process_X($params); + } else { + warn "$0: $podfile: unhandled tag '$tag' in paragraph $paragraph\n"; + } + + $result .= "$s1"; + } else { + # for pure text we must deal with implicit links and + # double-quotes among other things. + $result .= ($escapeQuotes ? process_puretext("$s1$s2$s3", \$quote) : "$s1$s2$s3"); + $rest = $s4; + } + } + } + $$text = $result; +} + +sub html_escape { + my $rest = $_[0]; + $rest =~ s/&/&/g; + $rest =~ s/</</g; + $rest =~ s/>/>/g; + $rest =~ s/"/"/g; + return $rest; +} + +# +# process_puretext - process pure text (without pod-escapes) converting +# double-quotes and handling implicit C<> links. +# +sub process_puretext { + my($text, $quote) = @_; + my(@words, $result, $rest, $lead, $trail); + + # convert double-quotes to single-quotes + $text =~ s/\A([^"]*)"/$1''/s if $$quote; + while ($text =~ s/\A([^"]*)["]([^"]*)["]/$1``$2''/sg) {} + + $$quote = ($text =~ m/"/ ? 1 : 0); + $text =~ s/\A([^"]*)"/$1``/s if $$quote; + + # keep track of leading and trailing white-space + $lead = ($text =~ /\A(\s*)/s ? $1 : ""); + $trail = ($text =~ /(\s*)\Z/s ? $1 : ""); + + # collapse all white space into a single space + $text =~ s/\s+/ /g; + @words = split(" ", $text); + + # process each word individually + foreach my $word (@words) { + # see if we can infer a link + if ($word =~ /^\w+\(/) { + # has parenthesis so should have been a C<> ref + $word = process_C($word); +# $word =~ /^[^()]*]\(/; +# if (defined $items{$1} && $items{$1}) { +# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$1}#item_" +# . htmlify(0,$word) +# . "\">$word</A></CODE>"; +# } elsif (defined $items{$word} && $items{$word}) { +# $word = "\n<CODE><A HREF=\"$htmlroot/$items{$word}#item_" +# . htmlify(0,$word) +# . "\">$word</A></CODE>"; +# } else { +# $word = "\n<CODE><A HREF=\"#item_" +# . htmlify(0,$word) +# . "\">$word</A></CODE>"; +# } + } elsif ($word =~ /^[\$\@%&*]+\w+$/) { + # perl variables, should be a C<> ref + $word = process_C($word, 1); + } elsif ($word =~ m,^\w+://\w,) { + # looks like a URL + $word = qq(<A HREF="$word">$word</A>); + } elsif ($word =~ /[\w.-]+\@\w+\.\w/) { + # looks like an e-mail address + $word = qq(<A HREF="MAILTO:$word">$word</A>); + } elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase? + $word = html_escape($word) if $word =~ /[&<>]/; + $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape; + } else { + $word = html_escape($word) if $word =~ /[&<>]/; + } + } + + # build a new string based upon our conversion + $result = ""; + $rest = join(" ", @words); + while (length($rest) > 75) { + if ( $rest =~ m/^(.{0,75})\s(.*?)$/o || + $rest =~ m/^(\S*)\s(.*?)$/o) { + + $result .= "$1\n"; + $rest = $2; + } else { + $result .= "$rest\n"; + $rest = ""; + } + } + $result .= $rest if $rest; + + # restore the leading and trailing white-space + $result = "$lead$result$trail"; + + return $result; +} + +# +# pre_escape - convert & in text to $amp; +# +sub pre_escape { + my($str) = @_; + + $$str =~ s,&,&,g; +} + +# +# process_L - convert a pod L<> directive to a corresponding HTML link. +# most of the links made are inferred rather than known about directly +# (i.e it's not known whether the =head\d section exists in the target file, +# or whether a .pod file exists in the case of split files). however, the +# guessing usually works. +# +# Unlike the other directives, this should be called with an unprocessed +# string, else tags in the link won't be matched. +# +sub process_L { + my($str) = @_; + my($s1, $s2, $linktext, $page, $section, $link); # work strings + + $str =~ s/\n/ /g; # undo word-wrapped tags + $s1 = $str; + for ($s1) { + # a :: acts like a / + s,::,/,; + + # make sure sections start with a / + s,^",/",g; + s,^,/,g if (!m,/, && / /); + + # check if there's a section specified + if (m,^(.*?)/"?(.*?)"?$,) { # yes + ($page, $section) = ($1, $2); + } else { # no + ($page, $section) = ($str, ""); + } + + # check if we know that this is a section in this page + if (!defined $pages{$page} && defined $sections{$page}) { + $section = $page; + $page = ""; + } + } + + if ($page eq "") { + $link = "#" . htmlify(0,$section); + $linktext = $section; + } elsif (!defined $pages{$page}) { + warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n"; + $link = ""; + $linktext = $page; + } else { + $linktext = ($section ? "$section" : "the $page manpage"); + $section = htmlify(0,$section) if $section ne ""; + + # 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)]):/) { + $link = "$htmlroot/$1/$section.html"; + + # 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"; + # check if there is a .pod with the page name + if ($pages{$page} =~ /([^:]*)\.pod:/) { + $link = "$htmlroot/$1.html$section"; + } elsif ($pages{$page} =~ /([^:]*)\.pm:/) { + $link = "$htmlroot/$1.html$section"; + } else { + warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ". + "no .pod or .pm found\n"; + $link = ""; + $linktext = $section; + } + } + } + + process_text(\$linktext, 0); + if ($link) { + $s1 = "<A HREF=\"$link\">$linktext</A>"; + } else { + $s1 = "<EM>$linktext</EM>"; + } + return $s1; +} + +# +# process_BFI - process any of the B<>, F<>, or I<> pod-escapes and +# convert them to corresponding HTML directives. +# +sub process_BFI { + my($tag, $str) = @_; + my($s1); # work string + my(%repltext) = ( 'B' => 'STRONG', + 'F' => 'EM', + 'I' => 'EM'); + + # extract the modified text and convert to HTML + $s1 = "<$repltext{$tag}>$str</$repltext{$tag}>"; + return $s1; +} + +# +# process_C - process the C<> pod-escape. +# +sub process_C { + my($str, $doref) = @_; + my($s1, $s2); + + $s1 = $str; + $s1 =~ s/\([^()]*\)//g; # delete parentheses + $s2 = $s1; + $s1 =~ s/\W//g; # delete bogus characters + + # if there was a pod file that we found earlier with an appropriate + # =item directive, then create a link to that page. + if ($doref && defined $items{$s1}) { + $s1 = ($items{$s1} ? + "<A HREF=\"$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) . "\">$str</A>" : + "<A HREF=\"#item_" . htmlify(0,$s2) . "\">$str</A>"); + $s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,; + confess "s1 has space: $s1" if $s1 =~ /HREF="[^"]*\s[^"]*"/; + } else { + $s1 = "<CODE>$str</CODE>"; + # warn "$0: $podfile: cannot resolve C<$str> in paragraph $paragraph\n" if $verbose + } + + + return $s1; +} + +# +# process_E - process the E<> pod directive which seems to escape a character. +# +sub process_E { + my($str) = @_; + + for ($str) { + s,([^/].*),\&$1\;,g; + } + + return $str; +} + +# +# process_Z - process the Z<> pod directive which really just amounts to +# ignoring it. this allows someone to start a paragraph with an = +# +sub process_Z { + my($str) = @_; + + # there is no equivalent in HTML for this so just ignore it. + $str = ""; + return $str; +} + +# +# process_S - process the S<> pod directive which means to convert all +# spaces in the string to non-breaking spaces (in HTML-eze). +# +sub process_S { + my($str) = @_; + + # convert all spaces in the text to non-breaking spaces in HTML. + $str =~ s/ / /g; + return $str; +} + +# +# process_X - this is supposed to make an index entry. we'll just +# ignore it. +# +sub process_X { + return ''; +} + + +# +# 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. if first arg is 1, only takes 1st word. +# +sub htmlify { + my($compact, $heading) = @_; + + if ($compact) { + $heading =~ /^(\w+)/; + $heading = $1; + } + + # $heading = lc($heading); + $heading =~ s/[^\w\s]/_/g; + $heading =~ s/(\s+)/ /g; + $heading =~ s/^\s*(.*?)\s*$/$1/s; + $heading =~ s/ /_/g; + $heading =~ s/\A(.{32}).*\Z/$1/s; + $heading =~ s/\s+\Z//; + $heading =~ s/_{2,}/_/g; + + return $heading; +} + +BEGIN { +} + +1; + |