require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.05;
+$VERSION = 1.08;
@ISA = qw(Exporter);
@EXPORT = qw(pod2html htmlify);
@EXPORT_OK = qw(anchorify);
can automatically generate indexes and cross-references, and it keeps
a cache of things it knows how to cross-reference.
-=head1 ARGUMENTS
+=head1 FUNCTIONS
-Pod::Html takes the following arguments:
+=head2 pod2html
+
+ 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");
+
+pod2html takes the following arguments:
=over 4
Displays the usage message.
+=item hiddendirs
+
+ --hiddendirs
+ --nohiddendirs
+
+Include hidden directories in the search for POD's in podpath if recurse
+is set.
+The default is not to traverse any directory whose name begins with C<.>.
+See L</"podpath"> and L</"recurse">.
+
+[This option is for backward compatibility only.
+It's hard to imagine that one would usefully create a module with a
+name component beginning with C<.>.]
+
=item htmldir
--htmldir=name
=back
-=head1 EXAMPLE
+=head2 htmlify
- 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");
+ htmlify($heading);
+
+Converts a pod section specification to a suitable section specification
+for HTML. Note that we keep spaces and special characters except
+C<", ?> (Netscape problem) and the hyphen (writer's problem...).
+
+=head2 anchorify
+
+ anchorify(@heading);
+
+Similar to C<htmlify()>, but turns non-alphanumerics into underscores. Note
+that C<anchorify()> is not exported by default.
=head1 ENVIRONMENT
=cut
-my $cachedir = "."; # The directory to which item and directory
- # caches will be written.
-my $cache_ext = $^O eq 'VMS' ? ".tmp" : ".x~~";
-my $dircache = "pod2htmd$cache_ext";
-my $itemcache = "pod2htmi$cache_ext";
+my($Cachedir);
+my($Dircache, $Itemcache);
+my @Begin_Stack;
+my @Libpods;
+my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl);
+my($Podfile, @Podpath, $Podroot);
+my $Css;
-my @begin_stack = (); # begin/end stack
+my $Recurse;
+my $Quiet;
+my $HiddenDirs;
+my $Verbose;
+my $Doindex;
-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 = File::Spec->curdir; # 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 $backlink = ''; # text for "back to top" links
-my $listlevel = 0; # current list depth
-my @listend = (); # the text to use to end the list.
-my $after_lpar = 0; # set to true after a par in an =item
-my $ignore = 1; # whether or not to format text. we don't
- # format text until we hit our first pod
- # directive.
+my $Backlink;
+my($Listlevel, @Listend);
+my $After_Lpar;
+use vars qw($Ignore); # need to localize it later.
-my %items_named = (); # for the multiples of the same item in perlfunc
-my @items_seen = ();
-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
- # for error messages)
-my $ptQuote = 0; # status of double-quote conversion
-my %pages = (); # associative array used to find the location
+my(%Items_Named, @Items_Seen);
+my($Title, $Header);
+
+my $Top;
+my $Paragraph;
+
+my %Sections;
+
+# Caches
+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
+my %Items = (); # associative array used to find the location
# of =item directives referenced by C<> links
-my %local_items = (); # local items - avoid destruction of %items
-my $Is83; # is dos with short filenames (8.3)
+
+my %Local_Items;
+my $Is83;
+
+my $Curdir = File::Spec->curdir;
+
+init_globals();
sub init_globals {
-$dircache = "pod2htmd$cache_ext";
-$itemcache = "pod2htmi$cache_ext";
+ $Cachedir = "."; # The directory to which item and directory
+ # caches will be written.
+
+ $Dircache = "pod2htmd.tmp";
+ $Itemcache = "pod2htmi.tmp";
-@begin_stack = (); # begin/end stack
+ @Begin_Stack = (); # begin/end stack
-@libpods = (); # files to search for links from C<> directives
-$htmlroot = "/"; # http-server base directory from which all
+ @Libpods = (); # files to search for links from C<> directives
+ $Htmlroot = "/"; # http-server base directory from which all
# relative paths in $podpath stem.
-$htmldir = ""; # The directory to which the html pages
+ $Htmldir = ""; # The directory to which the html pages
# will (eventually) be written.
-$htmlfile = ""; # write to stdout by default
-$podfile = ""; # read from stdin by default
-@podpath = (); # list of directories containing library pods.
-$podroot = File::Spec->curdir; # filesystem base directory from which all
+ $Htmlfile = ""; # write to stdout by default
+ $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.
+
+ $Podfile = ""; # read from stdin by default
+ @Podpath = (); # list of directories containing library pods.
+ $Podroot = $Curdir; # 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
-$backlink = ''; # text for "back to top" links
-$listlevel = 0; # current list depth
-@listend = (); # the text to use to end the list.
-$after_lpar = 0; # set to true after a par in an =item
-$ignore = 1; # whether or not to format text. we don't
+ $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
+ $Backlink = ''; # text for "back to top" links
+ $Listlevel = 0; # current list depth
+ @Listend = (); # the text to use to end the list.
+ $After_Lpar = 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 = ();
-%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
+ @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
+ $Paragraph = ''; # which paragraph we're processing (used
# for error messages)
-%sections = (); # sections within this page
+ %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
-%local_items = ();
-$Is83=$^O eq 'dos';
+ %Local_Items = ();
+ $Is83 = $^O eq 'dos'; # Is it an 8.3 filesystem?
}
#
$Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
- # cache of %pages and %items from last time we ran pod2html
+ # cache of %Pages and %Items from last time we ran pod2html
#undef $opt_help if defined $opt_help;
parse_command_line();
# escape the backlink argument (same goes for title but is done later...)
- $backlink = html_escape($backlink) if defined $backlink;
+ $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";
+ $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
+ $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
+ $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);
+ $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;
+ warn "Scanning for sections in input file(s)\n" if $Verbose;
$/ = "";
my @poddata = <POD>;
close(POD);
clean_data( \@poddata );
# scan the pod for =head[1-6] directives and build an index
- my $index = scan_headings(\%sections, @poddata);
+ my $index = scan_headings(\%Sections, @poddata);
unless($index) {
- warn "No headings in $podfile\n" if $verbose;
+ warn "No headings in $Podfile\n" if $Verbose;
}
# open the output file
- open(HTML, ">$htmlfile")
- || die "$0: cannot open $htmlfile file for output: $!\n";
+ 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 '') {
+ 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) = $para =~ /(\S+\s+-+.*\S)/s;
}
}
}
}
}
- if (!$title and $podfile =~ /\.pod\z/) {
+ 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*(.*)/;
+ last if ($Title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
}
- warn "adopted '$title' as title for $podfile\n"
- if $verbose and $title;
+ warn "adopted '$Title' as title for $Podfile\n"
+ if $Verbose and $Title;
}
- if ($title) {
- $title =~ s/\s*\(.*\)//;
+ 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;
+ 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);
+ $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" />);
+ 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 : '';
+ 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"> $title</span></strong></big>
+<big><strong><span class="block"> $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
+<title>$Title</title>$csslink
+<meta http-equiv="content-type" content="text/html; charset=utf-8" />
<link rev="made" href="mailto:$Config{perladmin}" />
</head>
$block
END_OF_HEAD
- # load/reload/validate/cache %pages and %items
- get_cache($dircache, $itemcache, \@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( \%local_items, "", @poddata);
+ scan_items( \%Local_Items, "", @poddata);
- # put an index at the top of the file. note, if $doindex is 0 we
+ # 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 "<p><a name=\"__index__\"></a></p>\n";
- 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 and $index;
+
+ my $hr = ($Doindex and $index) ? qq(<hr name="index" />) : "";
+
+ unless ($Doindex)
+ {
+ $index = qq(<!--\n$index\n-->\n);
+ }
+
+ print HTML << "END_OF_INDEX";
+
+<!-- INDEX BEGIN -->
+<div name="index">
+<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;
+ warn "Converting input file $Podfile\n" if $Verbose;
foreach my $i (0..$#poddata){
- $ptQuote = 0; # status of quote conversion
-
$_ = $poddata[$i];
- $paragraph = $i+1;
+ $Paragraph = $i+1;
if (/^(=.*)/s) { # is it a pod directive?
- $ignore = 0;
+ $Ignore = 0;
$after_item = 0;
$need_dd = 0;
$_ = $1;
} elsif (/^=pod/) { # =pod
process_pod();
} else {
- next if @begin_stack && $begin_stack[-1] ne 'html';
+ 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 );
+ 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();
+ 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";
+ warn "$0: $Podfile: unknown pod directive '$1' in "
+ . "paragraph $Paragraph. ignoring.\n" unless $Quiet;
}
}
- $top = 0;
+ $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';
+ 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+/ ){
## end of experimental
if( $after_item ){
- print HTML "$text\n";
- $after_lpar = 1;
- } else {
- print HTML "<p>$text</p>\n";
+ $After_Lpar = 1;
}
+ print HTML "<p>$text</p>\n";
}
print HTML "</dd>\n" if $need_dd;
$after_item = 0;
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 "<p><a href=\"#__index__\"><small>$Backlink</small></a></p>\n"
+ if $Doindex and $index and $Backlink;
print HTML <<END_OF_TAIL;
$block
# close the html file
close(HTML);
- warn "Finished\n" if $verbose;
+ 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;
+ die <<END_OF_USAGE;
Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
--podpath=<name>:...:<name> --podroot=<name>
--libpods=<name>:...:<name> --recurse --verbose --index
--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 /).
pods (empty by default).
--podroot - filesystem base directory from which all relative paths
in podpath stem (default is .).
- --[no]quiet - supress some benign warning messages (default is off).
+ --[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.
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_recurse,$opt_title,$opt_verbose,$opt_hiddendirs);
unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
my $result = GetOptions(
'flush' => \$opt_flush,
'header!' => \$opt_header,
'help' => \$opt_help,
+ 'hiddendirs!'=> \$opt_hiddendirs,
'htmldir=s' => \$opt_htmldir,
'htmlroot=s' => \$opt_htmlroot,
'index!' => \$opt_index,
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;
- $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;
+ @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$cache_ext";
- $itemcache = "$cachedir/pod2htmi$cache_ext";
+ $Dircache = "$Cachedir/pod2htmd.tmp";
+ $Itemcache = "$Cachedir/pod2htmi.tmp";
if (defined $opt_flush) {
- 1 while unlink($dircache, $itemcache);
+ 1 while unlink($Dircache, $Itemcache);
}
}
-my $saved_cache_key;
+my $Saved_Cache_Key;
sub get_cache {
my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
my $this_cache_key = cache_key(@cache_key_args);
- return if $saved_cache_key and $this_cache_key eq $saved_cache_key;
+ 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
+ # 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;
+ 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.
+ # %Pages and %Items.
if (!$tests) {
- warn "scanning directories in pod-path\n" if $verbose;
+ warn "scanning directories in pod-path\n" if $Verbose;
scan_podpath($podroot, $recurse, 0);
}
- $saved_cache_key = cache_key(@cache_key_args);
+ $Saved_Cache_Key = cache_key(@cache_key_args);
}
sub cache_key {
#
# 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
+# are valid caches of %Pages and %Items. if they are valid then it loads
# them and returns a non-zero value.
#
sub load_cache {
return 0;
}
- warn "loading item cache\n" if $verbose;
+ warn "loading item cache\n" if $Verbose;
while (<CACHE>) {
/(.*?) (.*)$/;
- $items{$1} = $2;
+ $Items{$1} = $2;
}
close(CACHE);
- warn "scanning for directory cache\n" if $verbose;
+ warn "scanning for directory cache\n" if $Verbose;
open(CACHE, "<$dircache") ||
die "$0: error opening $dircache for reading: $!\n";
$/ = "\n";
return 0;
}
- warn "loading directory cache\n" if $verbose;
+ warn "loading directory cache\n" if $Verbose;
while (<CACHE>) {
/(.*?) (.*)$/;
- $pages{$1} = $2;
+ $Pages{$1} = $2;
}
close(CACHE);
#
# 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.
+# @Libpods for =item directives.
#
sub scan_podpath {
my($podroot, $recurse, $append) = @_;
my($libpod, $dirname, $pod, @files, @poddata);
unless($append) {
- %items = ();
- %pages = ();
+ %Items = ();
+ %Pages = ();
}
- # scan each directory listed in @podpath
+ # scan each directory listed in @Podpath
$pwd = getcwd();
chdir($podroot)
|| die "$0: error changing to directory $podroot: $!\n";
- foreach $dir (@podpath) {
+ foreach $dir (@Podpath) {
scan_dir($dir, $recurse);
}
- # scan the pods listed in @libpods for =item directives
- foreach $libpod (@libpods) {
+ # 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};
+ 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)):/) {
+# 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) ||
close(POD);
clean_data( \@poddata );
- scan_items( \%items, "$dirname/$pod", @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;
+### $Items{$1} = "$dirname/$1.html" if $1;
### }
- } elsif ($pages{$libpod} =~ /([^:]*\.pod):/ ||
- $pages{$libpod} =~ /([^:]*\.pm):/) {
+ } elsif ($Pages{$libpod} =~ /([^:]*\.pod):/ ||
+ $Pages{$libpod} =~ /([^:]*\.pm):/) {
# scan the .pod or .pm file for =item directives
$pod = $1;
open(POD, "<$pod") ||
close(POD);
clean_data( \@poddata );
- scan_items( \%items, "$pod", @poddata);
+ scan_items( \%Items, "$pod", @poddata);
} else {
- warn "$0: shouldn't be here (line ".__LINE__."\n";
+ warn "$0: shouldn't be here (line ".__LINE__."\n" unless $Quiet;
}
}
@poddata = (); # clean-up a bit
|| 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";
+ 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";
+ 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";
+ 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";
+ print CACHE join(":", @Podpath) . "\n$podroot\n";
+ foreach my $key (keys %Pages) {
+ print CACHE "$key $Pages{$key}\n";
}
close(CACHE);
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/$_:";
+ 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:";
+ $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:";
+ $Pages{$_} = "" unless defined $Pages{$_};
+ $Pages{$_} .= "$dir/$_.pod:";
} elsif (/\.pm\z/) { # .pm
s/\.pm\z//;
- $pages{$_} = "" unless defined $pages{$_};
- $pages{$_} .= "$dir/$_.pm:";
+ $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);
my($sections, @data) = @_;
my($tag, $which_head, $otitle, $listdepth, $index);
- # here we need local $ignore = 0;
- # unfortunately, we can't have it, because $ignore is lexical
- $ignore = 0;
+ local $Ignore = 0;
$listdepth = 0;
$index = "";
# get rid of bogus lists
$index =~ s,\t*<ul>\s*</ul>\n,,g;
- $ignore = 1; # restore old value;
-
return $index;
}
$tag =~ /head([1-6])/;
my $level = $1;
- if( $listlevel ){
- warn "$0: $podfile: unterminated list at =head in paragraph $paragraph. ignoring.\n";
- while( $listlevel ){
+ 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;
+ 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";
sub emit_item_tag($$$){
my( $otext, $text, $compact ) = @_;
- my $item = fragment_id( $text );
-
+ 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}++) {
+ if ($Items_Named{$item}++) {
print HTML process_text( \$otext );
} else {
- my $name = 'item_' . $item;
+ my $name = $item;
$name = anchorify($name);
- print HTML qq{<a name="$name">}, process_text( \$otext ), '</a>';
+ print HTML qq{<a name="$name" class="item">}, process_text( \$otext ), '</a>';
}
- print HTML "</strong><br />\n";
+ print HTML "</strong>\n";
undef( $EmittedItem );
}
sub emit_li {
my( $tag ) = @_;
- if( $items_seen[$listlevel]++ == 0 ){
- push( @listend, "</$tag>" );
+ if( $Items_Seen[$Listlevel]++ == 0 ){
+ push( @Listend, "</$tag>" );
print HTML "<$tag>\n";
}
my $emitted = $tag eq 'dl' ? 'dt' : 'li';
# 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";
+ 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 "<p></p>\n";
- $after_lpar = 0;
+ if( $After_Lpar ){
+ print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
+ $After_Lpar = 0;
}
# remove formatting instructions from the text
# all the list variants:
if( $text =~ /\A\*/ ){ # bullet
$emitted = emit_li( 'ul' );
- if ($text =~ /\A\*\s+(.+)\Z/s ) { # with additional text
+ if ($text =~ /\A\*\s+(\S.*)\Z/s ) { # with additional text
my $tag = $1;
$otext =~ s/\A\*\s+//;
emit_item_tag( $otext, $tag, 1 );
} elsif( $text =~ /\A\d+/ ){ # numbered list
$emitted = emit_li( 'ol' );
- if ($text =~ /\A(?>\d+\.?)\s*(.+)\Z/s ) { # with additional text
+ 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 );
}
$need_dd = 1;
}
- print HTML "</$emitted>" if $emitted;
print HTML "\n";
return $need_dd;
}
#
sub process_over {
# start a new list
- $listlevel++;
- push( @items_seen, 0 );
- $after_lpar = 0;
+ $Listlevel++;
+ push( @Items_Seen, 0 );
+ $After_Lpar = 0;
}
#
# process_back - process a pod back tag and convert it to HTML format.
#
sub process_back {
- if( $listlevel == 0 ){
- warn "$0: $podfile: unexpected =back directive in paragraph $paragraph. ignoring.\n";
+ 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
+ # 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 '<p></p>' if $after_lpar;
- print HTML $listend[$listlevel];
+ # $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 );
+ pop( @Listend );
}
- $after_lpar = 0;
+ $After_Lpar = 0;
# clean up item count
- pop( @items_seen );
+ pop( @Items_Seen );
}
#
# process_cut - process a pod cut tag, thus start ignoring pod directives.
#
sub process_cut {
- $ignore = 1;
+ $Ignore = 1;
}
#
# until we see a corresponding cut.
#
sub process_pod {
- # no need to set $ignore to 0 cause the main loop did it
+ # no need to set $Ignore to 0 cause the main loop did it
}
#
sub process_begin {
my($whom, $text) = @_;
$whom = lc($whom);
- push (@begin_stack, $whom);
+ push (@Begin_Stack, $whom);
if ( $whom =~ /^(pod2)?html$/) {
print HTML $text if $text;
}
sub process_end {
my($whom, $text) = @_;
$whom = lc($whom);
- if ($begin_stack[-1] ne $whom ) {
- die "Unmatched begin/end at chunk $paragraph\n"
+ 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 );
+ pop( @Begin_Stack );
}
#
sub process_pre {
my( $text ) = @_;
my( $rest );
- return if $ignore;
+ return if $Ignore;
$rest = $$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>);
+ 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";
}
(<a\ href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]*:)?
}{
my $url ;
- if ( $htmlfileurl ne '' ){
+ if ( $Htmlfileurl ne '' ){
# Here, we take advantage of the knowledge
- # that $htmlfileurl ne '' implies $htmlroot eq ''.
- # Since $htmlroot eq '', we need to prepend $htmldir
+ # 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 );
+ $old_url = "$Htmldir$old_url" if $old_url =~ m{^\/};
+ $url = relativize_url( "$old_url.html", $Htmlfileurl );
} else {
$url = "$3.html" ;
}
#
sub pure_text($){
my $text = shift();
- process_puretext( $text, \$ptQuote, 1 );
+ process_puretext( $text, 1 );
}
sub inIS_text($){
my $text = shift();
- process_puretext( $text, \$ptQuote, 0 );
+ process_puretext( $text, 0 );
}
#
# double-quotes and handling implicit C<> links.
#
sub process_puretext {
- my($text, $quote, $notinIS) = @_;
+ my($text, $notinIS) = @_;
- ## Guessing at func() or [$@%&]*var references in plain text is destined
+ ## 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);
- # convert double-quotes to single-quotes
- if( $$quote && $text =~ s/"/''/s ){
- $$quote = 0;
- }
- while ($text =~ s/"([^"]*)"/``$1''/sg) {};
- $$quote = 1 if $text =~ s/"/``/s;
-
# keep track of leading and trailing white-space
$lead = ($text =~ s/\A(\s+)//s ? $1 : "");
$trail = ($text =~ s/(\s+)\Z//s ? $1 : "");
foreach my $word (@words) {
# skip space runs
next if $word =~ /^\s*$/;
- # see if we can infer a link
- if( $notinIS && $word =~ /^(\w+)\((.*)\)$/ ) {
+ # 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 ) = ( $1, $2 );
+ my( $func, $args, $rest ) = ( $1, $2, $3 || '' );
if( $args =~ /^\d+$/ ){
my $url = page_sect( $word, '' );
if( defined $url ){
- $word = "<a href=\"$url\">the $word manpage</a>";
+ $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)");
+ $word = emit_C( $func, '', "($args)") . $rest;
#### disabled. either all (including $\W, $\w+{.*} etc.) or nothing.
## } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) {
#
sub process_text1($$;$$);
-sub pattern ($) { $_[0] ? '[^\S\n]+'.('>' x ($_[0] + 1)) : '>' }
-sub closing ($) { local($_) = shift; (defined && s/\s+$//) ? length : 0 }
+sub pattern ($) { $_[0] ? '\s+'.('>' x ($_[0] + 1)) : '>' }
+sub closing ($) { local($_) = shift; (defined && s/\s+\z//) ? length : 0 }
sub process_text {
- return if $ignore;
+ 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 = '';
$res = "&$escape;";
} elsif( $func eq 'F' ){
- # F<filename> - italizice
- $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
+ # F<filename> - italicize
+ $res = '<em class="file">' . process_text1( $lev, $rstr ) . '</em>';
} elsif( $func eq 'I' ){
- # I<text> - italizice
+ # I<text> - italicize
$res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
} elsif( $func eq 'L' ){
# check for link patterns
if( $par =~ m{^([^/]+?)/(?!")(.*?)$} ){ # name/ident
# we've got a name/ident (no quotes)
- ( $page, $ident ) = ( $1, $2 );
+ 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"
# warning; show some text.
$linktext = $opar unless defined $linktext;
- warn "$0: $podfile: cannot resolve L<$opar> in paragraph $paragraph.\n";
+ warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n" unless $Quiet;
}
# now we have a URL or just plain code
} elsif( $func eq 'X' ){
# X<> - ignore
- $$rstr =~ s/^[^>]*>//;
-
+ warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n"
+ unless $$rstr =~ s/^[^>]*>// or $Quiet;
} elsif( $func eq 'Z' ){
# Z<> - empty
- warn "$0: $podfile: invalid X<> in paragraph $paragraph.\n"
- unless $$rstr =~ s/^>//;
+ warn "$0: $Podfile: invalid Z<> in paragraph $Paragraph.\n"
+ unless $$rstr =~ s/^>// or $Quiet;
} else {
my $term = pattern $closing;
}
if( $lev == 1 ){
$res .= pure_text( $$rstr );
- } else {
- warn "$0: $podfile: undelimited $func<> in paragraph $paragraph.\n";
+ } 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;
}
my $res = '';
my @closing = ($closing);
while( $$rstr =~
- s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|@{[pattern $closing[0]]})//s ){
+ s/\A(.*?)(([BCEFILSXZ])<(<+\s+)?|@{[pattern $closing[0]]})//s ){
$res .= $1;
unless( $3 ){
shift @closing;
}
$res .= $2;
}
- warn "$0: $podfile: undelimited $func<> in paragraph $paragraph.\n";
+ unless ($Quiet) {
+ my $snippet = substr($$rstr,0,60);
+ warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph (go_ahead): '$snippet'.\n"
+ }
return $res;
}
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}) {
+ 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});
+ $page=$page83 if (defined $Pages{$page83});
if ($page eq "") {
$link = "#" . anchorify( $section );
} elsif ( $page =~ /::/ ) {
# 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):/
+ 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
+ # $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.
# nonetheless?
}
- $link = "$htmlroot/$page.html";
+ $link = "$Htmlroot/$page.html";
$link .= "#" . anchorify( $section ) if ($section);
- } elsif (!defined $pages{$page}) {
+ } elsif (!defined $Pages{$page}) {
$link = "";
} else {
$section = anchorify( $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)):/) {
- $link = "$htmlroot/$1/$section.html";
+# 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
$section = "#$section" if $section;
### print STDERR "...section=$section\n";
- # 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";
+ # 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
+ # 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" );
+ if ( $Htmlfileurl ne '' ) {
+ $link = "$Htmldir$link" if $link =~ m{^/}s;
+ $url = relativize_url( $link, $Htmlfileurl );
+# print( " b: [$link,$Htmlfileurl,$url]\n" );
}
else {
$url = $link ;
my( $url );
my $fid = fragment_id( $item );
- if( defined( $page ) ){
+
+ 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} || "";
+ my $base = $Items{$fid} || "";
$base =~ s{[^/]*/}{};
if( $base ne "$page.html" ){
- ### print STDERR "coderef( $page, $item ): items{$fid} = $items{$fid} = $base => discard page!\n";
+ ### 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};
+ if( exists $Local_Items{$fid} ){
+ $page = $Local_Items{$fid};
} else {
- $page = $items{$fid};
+ $page = $Items{$fid};
}
}
}
# =item directive, then create a link to that page.
if( defined $page ){
if( $page ){
- if( exists $pages{$page} and $pages{$page} =~ /([^:.]*)\.[^:]*:/){
+ if( exists $Pages{$page} and $Pages{$page} =~ /([^:.]*)\.[^:]*:/){
$page = $1 . '.html';
}
- my $link = "$htmlroot/$page#item_" . anchorify($fid);
+ 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 ) ;
+ # 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 = "#item_" . anchorify($fid);
+ $url = "#" . anchorify($fid);
}
confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/;
# after the entire pod file has been read and converted.
#
sub finish_list {
- while ($listlevel > 0) {
+ while ($Listlevel > 0) {
print HTML "</dl>\n";
- $listlevel--;
+ $Listlevel--;
}
}
$heading =~ s/\s+\Z//;
$heading =~ s/\A\s+//;
# The hyphen is a disgrace to the English language.
- $heading =~ s/[-"?]//g;
+ # $heading =~ s/[-"?]//g;
+ $heading =~ s/["?]//g;
$heading = lc( $heading );
return $heading;
}
return $res unless defined $$rstr;
if( ! defined( $func ) ){
# skip to next begin of an interior sequence
- while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?// ){
+ while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?//s ){
# recurse into its text
$res .= $1 . depod1( $rstr, $2, closing $3);
}
# 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)// ){
+ while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){
$res .= $1;
last unless $3;
$res .= depod1( $rstr, $3, closing $4 );
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<...>
#
-my @hc;
+
sub fragment_id {
- my $text = shift();
+ my $text = shift;
+ my $generate = shift; # optional flag
+
$text =~ s/\s+\Z//s;
if( $text ){
# a method or function?
return $1 if $text =~ /->\s*(\w+)\s*\(?/;
# a variable name?
- return $1 if $text =~ /^([$@%*]\S+)/;
+ return $1 if $text =~ /^([\$\@%*]\S+)/;
# some pattern matching operator?
return $1 if $text =~ m|^(\w+/).*/\w*$|;
# honour the perlfunc manpage: func [PAR[,[ ]PAR]...]
# and some funnies with ... Module ...
- return $1 if $text =~ m{^([a-z\d]+)(\s+[A-Z\d,/& ]+)?$};
+ 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,/& ]+)?$};
- # text? normalize!
- $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 );
+ return fragment_id_readable($text, $generate);
} else {
- return undef();
+ return;
}
}
https://perl5.git.perl.org / perl5.git / blobdiff