use Pod::Functions;
use Getopt::Long; # package for handling command-line parameters
+use File::Spec::Unix;
require Exporter;
+use vars qw($VERSION);
+$VERSION = 1.02;
@ISA = Exporter;
@EXPORT = qw(pod2html htmlify);
use Cwd;
use Carp;
+use locale; # make \w work right in non-ASCII lands
+
use strict;
+use Config;
+
=head1 NAME
-Pod::HTML - module to convert pod files to HTML
+Pod::Html - module to convert pod files to HTML
=head1 SYNOPSIS
- use Pod::HTML;
+ use Pod::Html;
pod2html([options]);
=head1 DESCRIPTION
Displays the usage message.
+=item htmldir
+
+ --htmldir=name
+
+Sets the directory in which the resulting HTML file is placed. This
+is used to generate relative links to other files. Not passing this
+causes all links to be absolute, since this is the value that tells
+Pod::Html the root of the documentation tree.
+
=item htmlroot
--htmlroot=name
Specify the title of the resulting HTML file.
+=item css
+
+ --css=stylesheet
+
+Specify the URL of a cascading style sheet.
+
=item verbose
--verbose
Display progress messages.
+=item quiet
+
+ --quiet
+
+Don't display I<mostly harmless> warning messages.
+
=back
=head1 EXAMPLE
"--infile=foo.pod",
"--outfile=/perl/nmanual/foo.html");
+=head1 ENVIRONMENT
+
+Uses $Config{pod2html} to setup default options.
+
=head1 AUTHOR
Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
=cut
-my $dircache = "pod2html-dircache";
-my $itemcache = "pod2html-itemcache";
+my $cache_ext = $^O eq 'VMS' ? ".tmp" : ".x~~";
+my $dircache = "pod2htmd$cache_ext";
+my $itemcache = "pod2htmi$cache_ext";
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 $htmldir = ""; # The directory to which the html pages
+ # will (eventually) be written.
my $htmlfile = ""; # write to stdout by default
+my $htmlfileurl = "" ; # The url that other files would use to
+ # refer to this file. This is only used
+ # to make relative urls that point to
+ # other files.
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 $css = ''; # Cascading style sheet
my $recurse = 1; # recurse on subdirectories in $podpath.
+my $quiet = 0; # not quiet by default
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 @items_seen = ();
my $netscape = 0; # whether or not to use netscape directives.
my $title; # title to give the pod(s)
+my $header = 0; # produce block header/footer
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
my %sections = (); # sections within this page
my %items = (); # associative array used to find the location
# of =item directives referenced by C<> links
+my $Is83; # is dos with short filenames (8.3)
+
sub init_globals {
-$dircache = "pod2html-dircache";
-$itemcache = "pod2html-itemcache";
+$dircache = "pod2htmd$cache_ext";
+$itemcache = "pod2htmi$cache_ext";
@begin_stack = (); # begin/end stack
@podpath = (); # list of directories containing library pods.
$podroot = "."; # filesystem base directory from which all
# relative paths in $podpath stem.
+$css = ''; # Cascading style sheet
$recurse = 1; # recurse on subdirectories in $podpath.
+$quiet = 0; # not quiet by default
$verbose = 0; # not verbose by default
$doindex = 1; # non-zero if we should generate an index
$listlevel = 0; # current list depth
@items_seen = ();
%items_named = ();
$netscape = 0; # whether or not to use netscape directives.
+$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)
-%pages = (); # associative array used to find the location
- # of pages referenced by L<> links.
%sections = (); # sections within this page
-%items = (); # associative array used to find the location
- # of =item directives referenced by C<> links
+# 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
+$Is83=$^O eq 'dos';
}
sub pod2html {
init_globals();
+ $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
+
# cache of %pages and %items from last time we ran pod2html
- my $podpath = '';
#undef $opt_help if defined $opt_help;
}
$htmlfile = "-" unless $htmlfile; # stdout
$htmlroot = "" if $htmlroot eq "/"; # so we don't get a //
+ $htmldir =~ s#/$## ; # 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;
# 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
- $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;
- }
- }
+ # 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$/) {
+ # 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) {
+ if ($title) {
+ $title =~ s/\s*\(.*\)//;
+ } else {
+ warn "$0: no title for $podfile" unless $quiet;
$podfile =~ /^(.*)(\.[^.\/]+)?$/;
$title = ($podfile eq "-" ? 'No Title' : $1);
- warn "found $title" if $verbose;
- }
- if ($title =~ /\.pm/) {
- warn "$0: no title for $podfile";
- $title = $podfile;
+ warn "using $title" if $verbose;
}
- print HTML <<END_OF_HEAD;
- <HTML>
- <HEAD>
- <TITLE>$title</TITLE>
- </HEAD>
-
- <BODY>
+ my $csslink = $css ? qq(\n<LINK REL="stylesheet" HREF="$css" TYPE="text/css">) : '';
+ $csslink =~ s,\\,/,g;
+ $csslink =~ s,(/.):,$1|,;
+
+ my $block = $header ? <<END_OF_BLOCK : '';
+<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH=100%>
+<TR><TD CLASS=block VALIGN=MIDDLE WIDTH=100% BGCOLOR="#cccccc">
+<FONT SIZE=+1><STRONG><P CLASS=block> $title</P></STRONG></FONT>
+</TD></TR>
+</TABLE>
+END_OF_BLOCK
+ print HTML <<END_OF_HEAD;
+<HTML>
+<HEAD>
+<TITLE>$title</TITLE>$csslink
+<LINK REV="made" HREF="mailto:$Config{perladmin}">
+</HEAD>
+
+<BODY>
+$block
END_OF_HEAD
- # load a 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 = find_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);
- }
+ # load/reload/validate/cache %pages and %items
+ get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse);
# scan the pod for =item directives
scan_items("", \%items, @poddata);
print HTML $index;
print HTML "-->\n" unless $doindex;
print HTML "<!-- INDEX END -->\n\n";
- print HTML "<HR>\n" if $doindex;
+ print HTML "<HR>\n" if $doindex and $index;
# now convert this file
warn "Converting input file\n" if $verbose;
} else {
next if @begin_stack && $begin_stack[-1] ne 'html';
- if (/^=(head[1-6])\s+(.*)/s) { # =head[1-6] heading
+ if (/^=(head[1-6])\s+(.*\S)/s) { # =head[1-6] heading
process_head($1, $2);
- } elsif (/^=item\s*(.*)/sm) { # =item text
+ } elsif (/^=item\s*(.*\S)/sm) { # =item text
process_item($1);
} elsif (/^=over\s*(.*)/) { # =over N
process_over();
next if @begin_stack && $begin_stack[-1] ne 'html';
my $text = $_;
process_text(\$text, 1);
- print HTML "$text\n<P>\n\n";
+ print HTML "<P>\n$text</P>\n";
}
}
# finish off any pending directives
finish_list();
print HTML <<END_OF_TAIL;
- </BODY>
+$block
+</BODY>
- </HTML>
+</HTML>
END_OF_TAIL
# close the html file
--recurse - recurse on those subdirectories listed in podpath
(default behavior).
--title - title that will appear in resulting html file.
+ --header - produce block header/footer
+ --css - stylesheet URL
--verbose - self-explanatory
+ --quiet - supress some benign warning messages
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 ($opt_flush,$opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_norecurse,$opt_recurse,$opt_title,$opt_verbose,$opt_css,$opt_header,$opt_quiet);
+ unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
my $result = GetOptions(
'flush' => \$opt_flush,
'help' => \$opt_help,
+ 'htmldir=s' => \$opt_htmldir,
'htmlroot=s' => \$opt_htmlroot,
'index!' => \$opt_index,
'infile=s' => \$opt_infile,
'norecurse' => \$opt_norecurse,
'recurse!' => \$opt_recurse,
'title=s' => \$opt_title,
+ 'header' => \$opt_header,
+ 'css=s' => \$opt_css,
'verbose' => \$opt_verbose,
+ 'quiet' => \$opt_quiet,
);
usage("-", "invalid parameters") if not $result;
$podfile = $opt_infile if defined $opt_infile;
$htmlfile = $opt_outfile if defined $opt_outfile;
+ $htmldir = $opt_htmldir if defined $opt_outfile;
@podpath = split(":", $opt_podpath) if defined $opt_podpath;
@libpods = split(":", $opt_libpods) if defined $opt_libpods;
$doindex = $opt_index if defined $opt_index;
$recurse = $opt_recurse if defined $opt_recurse;
$title = $opt_title if defined $opt_title;
+ $header = defined $opt_header ? 1 : 0;
+ $css = $opt_css if defined $opt_css;
$verbose = defined $opt_verbose ? 1 : 0;
+ $quiet = defined $opt_quiet ? 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));
+}
+
#
-# find_cache - tries to find if the caches stored in $dircache and $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 find_cache {
+
+sub load_cache {
my($dircache, $itemcache, $podpath, $podroot) = @_;
my($tests);
local $_;
# is it the same podpath?
$_ = <CACHE>;
chomp($_);
- $tests++ if (join(":", @podpath) eq $_);
+ $tests++ if (join(":", @$podpath) eq $_);
# is it the same podroot?
$_ = <CACHE>;
# load the cache if its good
if ($tests != 2) {
close(CACHE);
-
- %items = ();
return 0;
}
# is it the same podpath?
$_ = <CACHE>;
chomp($_);
- $tests++ if (join(":", @podpath) eq $_);
+ $tests++ if (join(":", @$podpath) eq $_);
# is it the same podroot?
$_ = <CACHE>;
# load the cache if its good
if ($tests != 2) {
close(CACHE);
-
- %pages = ();
- %items = ();
return 0;
}
# @libpods for =item directives.
#
sub scan_podpath {
- my($podroot, $recurse) = @_;
+ 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)
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)]):/) {
+ # 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) ||
# scan for =head directives, note their name, and build an index
# pointing to each of them.
foreach my $line (@data) {
- if ($line =~ /^\s*=(head)([1-6])\s+(.*)/) {
+ 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";
+ while ($which_head != $listdepth) {
+ if ($which_head > $listdepth) {
+ $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
+ $listdepth++;
+ } 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>";
+ html_escape(process_text(\$title, 0)) . "</A></LI>";
}
}
# get rid of bogus lists
$index =~ s,\t*<UL>\s*</UL>\n,,g;
- $ignore = 1; # retore old value;
+ $ignore = 1; # restore old value;
return $index;
}
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;
+ } elsif ($1 =~ /^\d+/) { # numbered list
+ /\A=item\s+\d+\.?(.*?)\s*\Z/s;
$item = $1;
} else {
# /\A=item\s+(.*?)\s*\Z/s;
print HTML "<H$level>"; # unless $listlevel;
#print HTML "<H$level>" unless $listlevel;
my $convert = $heading; process_text(\$convert, 0);
+ $convert = html_escape($convert);
print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>";
print HTML "</H$level>"; # unless $listlevel;
print HTML "\n";
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>";
+ print HTML '<LI>';
+ if ($text =~ /\A\*\s*(.+)\Z/s) {
+ print HTML '<STRONG>';
+ if ($items_named{$1}++) {
+ print HTML html_escape($1);
+ } else {
+ my $name = 'item_' . htmlify(1,$1);
+ print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
+ }
+ print HTML '</STRONG>';
+ }
- } elsif ($text =~ /\A[0-9#]+/) { # numbered list
+ } elsif ($text =~ /\A[\d#]+/) { # 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>";
+ print HTML '<LI>';
+ if ($text =~ /\A\d+\.?\s*(.+)\Z/s) {
+ print HTML '<STRONG>';
+ if ($items_named{$1}++) {
+ print HTML html_escape($1);
+ } else {
+ my $name = 'item_' . htmlify(0,$1);
+ print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
+ }
+ print HTML '</STRONG>';
+ }
} else { # all others
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 '<DT>';
+ if ($text =~ /(\S+)/) {
+ print HTML '<STRONG>';
+ if ($items_named{$1}++) {
+ print HTML html_escape($text);
+ } else {
+ my $name = 'item_' . htmlify(1,$text);
+ print HTML qq(<A NAME="$name">), html_escape($text), '</A>';
+ }
+ print HTML '</STRONG>';
+ }
print HTML '<DD>';
}
#
# process_for - process a =for pod tag. if it's for html, split
-# it out verbatim, otherwise ignore it.
+# 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>};
+ }
}
#
}{
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:([^>:]*:)?/$1$3.html/g;
+# $rest =~ s/(<A HREF=)([^>:]*:)?([^>:]*)\.pod:([^>:]*:)?/$1$3.html/g;
+ $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 );
+# print( " a: [$old_url.html,$htmlfileurl,$url]\n" ) ;
+ }
+ else {
+ $url = "$3.html" ;
+ }
+ "$1$url" ;
+ }xeg;
+ # Look for embedded URLs and make them in to links. We don't
+ # relativize them since they are best left as the author intended.
my $urls = '(' . join ('|', qw{
http
telnet
\b # start at word boundary
( # begin $1 {
$urls : # need resource and a colon
+ (?!:) # Ignore File::, among others.
[$any] +? # followed by on or more
# of any valid character, but
# be conservative and take only
# 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) {
+ while (length $rest) {
# check to see if there are any possible pod directives in
# the remaining part of the text.
if ($rest =~ m/[BCEIFLSZ]</) {
sub html_escape {
my $rest = $_[0];
- $rest =~ s/&/&/g;
+ $rest =~ s/&(?!\w+;|#)/&/g; # XXX not bulletproof
$rest =~ s/</</g;
$rest =~ s/>/>/g;
$rest =~ s/"/"/g;
$word = process_C($word, 1);
} 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/) {
+ } elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) {
# looks like an e-mail address
- $word = qq(<A HREF="MAILTO:$word">$word</A>);
+ my ($w1, $w2, $w3) = ("", $word, "");
+ ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
+ ($w1, $w2, $w3) = ("<", $1, ">$2") if $word =~ /^<(.*?)>(,?)/;
+ $word = qq($w1<A HREF="mailto:$w2">$w2</A>$w3);
} elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase?
- $word = html_escape($word) if $word =~ /[&<>]/;
+ $word = html_escape($word) if $word =~ /["&<>]/;
$word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
} else {
- $word = html_escape($word) if $word =~ /[&<>]/;
+ $word = html_escape($word) if $word =~ /["&<>]/;
}
}
#
sub pre_escape {
my($str) = @_;
+ $$str =~ s/&(?!\w+;|#)/&/g; # XXX not bulletproof
+}
- $$str =~ s,&,&,g;
+#
+# 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;
}
#
#
sub process_L {
my($str) = @_;
- my($s1, $s2, $linktext, $page, $section, $link); # work strings
+ my($s1, $s2, $linktext, $page, $page83, $section, $link); # work strings
$str =~ s/\n/ /g; # undo word-wrapped tags
$s1 = $str;
for ($s1) {
- # a :: acts like a /
- s,::,/,;
+ # LREF: a la HREF L<show this text|man/section>
+ $linktext = $1 if s:^([^|]+)\|::;
# make sure sections start with a /
s,^",/",g;
$section = $page;
$page = "";
}
+
+ # remove trailing punctuation, like ()
+ $section =~ s/\W*$// ;
}
+ $page83=dosify($page);
+ $page=$page83 if (defined $pages{$page83});
if ($page eq "") {
$link = "#" . htmlify(0,$section);
- $linktext = $section;
+ $linktext = $section unless defined($linktext);
+ } elsif ( $page =~ /::/ ) {
+ $linktext = ($section ? "$section" : "$page")
+ unless defined($linktext);
+ $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,^.*/,, ;
+ 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
+ # non-theless?
+ # Also, maybe put a warn "$0: cannot resolve..." here.
+ }
+ $link = "$htmlroot/$page.html";
+ $link .= "#" . htmlify(0,$section) if ($section);
} elsif (!defined $pages{$page}) {
- warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n";
+ warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n" unless $quiet;
$link = "";
- $linktext = $page;
+ $linktext = $page unless defined($linktext);
} else {
- $linktext = ($section ? "$section" : "the $page manpage");
+ $linktext = ($section ? "$section" : "the $page manpage") unless defined($linktext);
$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)]):/) {
+# if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
+ 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
warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ".
"no .pod or .pm found\n";
$link = "";
- $linktext = $section;
+ $linktext = $section unless defined($linktext);
}
}
}
process_text(\$linktext, 0);
if ($link) {
- $s1 = "<A HREF=\"$link\">$linktext</A>";
+ # 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{^/} ) ;
+
+ $url = relativize_url( $link, $htmlfileurl ) ;
+# print( " b: [$link,$htmlfileurl,$url]\n" ) ;
+ }
+ else {
+ $url = $link ;
+ }
+
+ $s1 = "<A HREF=\"$url\">$linktext</A>";
} else {
$s1 = "<EM>$linktext</EM>";
}
}
#
+# 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 ;
+}
+
+#
# process_BFI - process any of the B<>, F<>, or I<> pod-escapes and
# convert them to corresponding HTML directives.
#
$s1 =~ s/\([^()]*\)//g; # delete parentheses
$s2 = $s1;
$s1 =~ s/\W//g; # delete bogus characters
+ $str = html_escape($str);
# 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>");
+ if ( $items{$s1} ) {
+ my $link = "$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) ;
+ # Here, we take advantage of the knowledge that $htmlfileurl ne ''
+ # implies $htmlroot eq ''.
+ my $url ;
+ if ( $htmlfileurl ne '' ) {
+ $link = "$htmldir$link" ;
+ $url = relativize_url( $link, $htmlfileurl ) ;
+ }
+ else {
+ $url = $link ;
+ }
+ $s1 = "<A HREF=\"$url\">$str</A>" ;
+ }
+ else {
+ $s1 = "<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 {
#
+# 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) {
+ while ($listlevel > 0) {
print HTML "</DL>\n";
$listlevel--;
}
}
1;
-
projects / p5sagit/p5-mst-13.2.git / blobdiff