use strict;
require Exporter;
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = 1.03;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+$VERSION = 1.0503;
@ISA = qw(Exporter);
@EXPORT = qw(pod2html htmlify);
+@EXPORT_OK = qw(anchorify);
use Carp;
use Config;
use Cwd;
+use File::Spec;
use File::Spec::Unix;
use Getopt::Long;
-use Pod::Functions;
use locale; # make \w work right in non-ASCII lands
--backlink="Back to Top"
-Adds "Back to Top" links in front of every HEAD1 heading (except for
-the first). By default, no backlink are being generated.
+Adds "Back to Top" links in front of every C<head1> heading (except for
+the first). By default, no backlinks are generated.
+
+=item cachedir
+
+ --cachedir=name
+
+Creates the item and directory caches in the given directory.
=item css
--css=stylesheet
-Specify the URL of a cascading style sheet.
+Specify the URL of a cascading style sheet. Also disables all HTML/CSS
+C<style> attributes that are output by default (to avoid conflicts).
=item flush
--header
--noheader
-Creates header and footer blocks containing the text of the NAME
-section. By default, no headers are being generated.
+Creates header and footer blocks containing the text of the C<NAME>
+section. By default, no headers are generated.
=item help
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
--netscape
--nonetscape
-Use Netscape HTML directives when applicable. By default, they will
-B<not> be used.
+B<Deprecated>, has no effect. For backwards compatibility only.
=item outfile
--podpath=name:...:name
Specify which subdirectories of the podroot contain pod files whose
-HTML converted forms can be linked-to in cross-references.
+HTML converted forms can be linked to in cross references.
=item podroot
=head1 EXAMPLE
pod2html("pod2html",
- "--podpath=lib:ext:pod:vms",
+ "--podpath=lib:ext:pod:vms",
"--podroot=/usr/src/perl",
"--htmlroot=/perl/nmanual",
"--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
=head1 ENVIRONMENT
-Uses $Config{pod2html} to setup default options.
+Uses C<$Config{pod2html}> to setup default options.
=head1 AUTHOR
=cut
-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($Cachedir);
+my($Dircache, $Itemcache);
+my @Begin_Stack;
+my @Libpods;
+my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl);
+my($Podfile, @Podpath, $Podroot);
+my $Css;
-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 $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 $Recurse;
+my $Quiet;
+my $HiddenDirs;
+my $Verbose;
+my $Doindex;
-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 $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 $Backlink;
+my($Listlevel, @Listend);
+my $After_Lpar;
+use vars qw($Ignore); # need to localize it later.
+
+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 $PTQuote;
+
+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.
-@begin_stack = (); # begin/end stack
+ $Dircache = "pod2htmd.tmp";
+ $Itemcache = "pod2htmi.tmp";
-@libpods = (); # files to search for links from C<> directives
-$htmlroot = "/"; # http-server base directory from which all
+ @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.
-$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 = "."; # 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 = ();
-$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
+ @Items_Seen = (); # for multiples of the same item in perlfunc
+ %Items_Named = ();
+ $Header = 0; # produce block header/footer
+ $Title = ''; # title to give the pod(s)
+ $Top = 1; # true if we are at the top of the doc. used
+ # to prevent the first <hr /> directive.
+ $Paragraph = ''; # which paragraph we're processing (used
# for error messages)
-%sections = (); # sections within this page
+ $PTQuote = 0; # status of double-quote conversion
+ %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?
}
#
#
sub clean_data($){
my( $dataref ) = @_;
- my $i;
- for( $i = 0; $i <= $#$dataref; $i++ ){
+ for my $i ( 0..$#{$dataref} ) {
${$dataref}[$i] =~ s/\s+\Z//;
# have a look for all-space lines
- if( ${$dataref}[$i] =~ /^\s+$/m ){
+ if( ${$dataref}[$i] =~ /^\s+$/m and $dataref->[$i] !~ /^\s/ ){
my @chunks = split( /^\s+$/m, ${$dataref}[$i] );
splice( @$dataref, $i, 1, @chunks );
}
$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 the command-line parameters
parse_command_line();
+ # escape the backlink argument (same goes for title but is done later...)
+ $Backlink = html_escape($Backlink) if defined $Backlink;
+
# set some variables to their default values if necessary
local *POD;
- unless (@ARGV && $ARGV[0]) {
- $podfile = "-" unless $podfile; # stdin
- open(POD, "<$podfile")
- || die "$0: cannot open $podfile file for input: $!\n";
+ 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
+ $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
+ # 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);
+
+ # be eol agnostic
+ for (@poddata) {
+ if (/\r/) {
+ if (/\r\n/) {
+ @poddata = map { s/\r\n/\n/g;
+ /\n\n/ ?
+ map { "$_\n\n" } split /\n\n/ :
+ $_ } @poddata;
+ } else {
+ @poddata = map { s/\r/\n/g;
+ /\n\n/ ?
+ map { "$_\n\n" } split /\n\n/ :
+ $_ } @poddata;
+ }
+ last;
+ }
+ }
+
clean_data( \@poddata );
# scan the pod for =head[1-6] directives and build an index
- my $index = scan_headings(\%sections, @poddata);
+ 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++) {
+ for (my $i = 0; $i < @poddata; $i++) {
if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
- for my $para ( @poddata[$i, $i+1] ) {
+ 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*(.*)/;
- }
- warn "adopted '$title' as title for $podfile\n"
- if $verbose and $title;
- }
- if ($title) {
- $title =~ s/\s*\(.*\)//;
+ for (my $i = 0; $i < @poddata; $i++) {
+ last if ($Title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
+ }
+ warn "adopted '$Title' as title for $Podfile\n"
+ if $Verbose and $Title;
+ }
+ if ($Title) {
+ $Title =~ s/\s*\(.*\)//;
} else {
- warn "$0: no title for $podfile" 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);
+
+ my $csslink = '';
+ my $bodystyle = ' style="background-color: white"';
+ my $tdstyle = ' style="background-color: #cccccc"';
+
+ if ($Css) {
+ $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />);
+ $csslink =~ s,\\,/,g;
+ $csslink =~ s,(/.):,$1|,;
+ $bodystyle = '';
+ $tdstyle = '';
}
- my $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>
+
+ 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>
+</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>
+<!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
+<link rev="made" href="mailto:$Config{perladmin}" />
+</head>
+
+<body$bodystyle>
$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 "<A NAME=\"__index__\"></A>\n";
+ print HTML "<p><a name=\"__index__\"></a></p>\n";
print HTML "<!-- INDEX BEGIN -->\n";
- print HTML "<!--\n" unless $doindex;
+ print HTML "<!--\n" unless $Doindex;
print HTML $index;
- print HTML "-->\n" unless $doindex;
+ print HTML "-->\n" unless $Doindex;
print HTML "<!-- INDEX END -->\n\n";
- print HTML "<HR>\n" if $doindex and $index;
+ print HTML "<hr />\n" if $Doindex and $index;
# now convert this file
my $after_item; # set to true after an =item
- warn "Converting input file $podfile\n" if $verbose;
+ my $need_dd = 0;
+ warn "Converting input file $Podfile\n" if $Verbose;
foreach my $i (0..$#poddata){
- $ptQuote = 0; # status of quote conversion
+ $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;
if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
process_begin($1, $2);
} 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
- warn "$0: $podfile: =item without bullet, number or text"
- . " in paragraph $paragraph.\n" if !defined($1) or $1 eq '';
- process_item( $1 );
+ $need_dd = process_item( $1 );
$after_item = 1;
} elsif (/^=over\s*(.*)/) { # =over N
process_over();
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';
+ next if $Ignore;
+ next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
+ print HTML and next if @Begin_Stack && $Begin_Stack[-1] eq 'html';
+ print HTML "<dd>\n" if $need_dd;
my $text = $_;
if( $text =~ /\A\s+/ ){
process_pre( \$text );
- print HTML "<PRE>\n$text</PRE>\n";
+ print HTML "<pre>\n$text</pre>\n";
} else {
process_text( \$text );
}
}
if( $all > 0 ){
- $text =~ s/\t+/<TD>/g;
- $text =~ s/^/<TR><TD>/gm;
- $text = '<TABLE CELLSPACING=0 CELLPADDING=0>' .
- $text . '</TABLE>';
+ $text =~ s/\t+/<td>/g;
+ $text =~ s/^/<tr><td>/gm;
+ $text = '<table cellspacing="0" cellpadding="0">' .
+ $text . '</table>';
}
}
}
if( $after_item ){
print HTML "$text\n";
- $after_lpar = 1;
+ $After_Lpar = 1;
} else {
- print HTML "<P>$text</P>\n";
+ 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
-</BODY>
+</body>
-</HTML>
+</html>
END_OF_TAIL
# 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
- --netscape --norecurse --noindex
+ --netscape --norecurse --noindex --cachedir=<name>
--backlink - set text for "back to top" links (default: none).
+ --cachedir - directory for the item and directory cache files.
--css - stylesheet URL
--flush - flushes the item and directory caches.
--[no]header - produce block header/footer (default is no headers).
--help - prints this message.
+ --hiddendirs - search hidden directories in podpath
--htmldir - directory for resulting HTML files.
--htmlroot - http-server base directory from which all relative paths
in podpath stem (default is /).
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.
- --[no]netscape - will use netscape html directives when applicable.
- (default is not to use them).
--outfile - filename for the resulting html file (output sent to
stdout by default).
--podpath - colon-separated list of directories containing library
(default behaviour).
--title - title that will appear in resulting html file.
--[no]verbose - self-explanatory (off by default).
+ --[no]netscape - deprecated, has no effect. for backwards compatibility only.
END_OF_USAGE
+}
+
sub parse_command_line {
- my ($opt_backlink,$opt_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);
+ my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,$opt_help,
+ $opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,
+ $opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet,
+ $opt_recurse,$opt_title,$opt_verbose,$opt_hiddendirs);
unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
my $result = GetOptions(
'backlink=s' => \$opt_backlink,
+ 'cachedir=s' => \$opt_cachedir,
'css=s' => \$opt_css,
'flush' => \$opt_flush,
'header!' => \$opt_header,
'help' => \$opt_help,
+ 'hiddendirs!'=> \$opt_hiddendirs,
'htmldir=s' => \$opt_htmldir,
'htmlroot=s' => \$opt_htmlroot,
'index!' => \$opt_index,
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;
- $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;
- $netscape = $opt_netscape if defined $opt_netscape;
- $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;
- unlink($dircache, $itemcache) if defined $opt_flush;
+ $Dircache = "$Cachedir/pod2htmd.tmp";
+ $Itemcache = "$Cachedir/pod2htmi.tmp";
+ if (defined $opt_flush) {
+ 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:";
} 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");
}
}
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 = "";
# scan for =head directives, note their name, and build an index
# pointing to each of them.
foreach my $line (@data) {
- if ($line =~ /^=(head)([1-6])\s+(.*)/) {
- ($tag, $which_head, $otitle) = ($1,$2,$3);
+ if ($line =~ /^=(head)([1-6])\s+(.*)/) {
+ ($tag, $which_head, $otitle) = ($1,$2,$3);
- my $title = depod( $otitle );
- my $name = htmlify( $title );
- $$sections{$name} = 1;
- $title = process_text( \$otitle );
+ my $title = depod( $otitle );
+ my $name = anchorify( $title );
+ $$sections{$name} = 1;
+ $title = process_text( \$otitle );
while ($which_head != $listdepth) {
if ($which_head > $listdepth) {
- $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
+ $index .= "\n" . ("\t" x $listdepth) . "<ul>\n";
$listdepth++;
} elsif ($which_head < $listdepth) {
$listdepth--;
- $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+ $index .= "\n" . ("\t" x $listdepth) . "</ul>\n";
}
}
- $index .= "\n" . ("\t" x $listdepth) . "<LI>" .
- "<A HREF=\"#" . $name . "\">" .
- $title . "</A></LI>";
+ $index .= "\n" . ("\t" x $listdepth) . "<li>" .
+ "<a href=\"#" . $name . "\">" .
+ $title . "</a></li>";
}
}
# finish off the lists
while ($listdepth--) {
- $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
+ $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;
+ $index =~ s,\t*<ul>\s*</ul>\n,,g;
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;
- print HTML "<HR>\n"
+ print HTML "<p>\n";
+ if( $level == 1 && ! $Top ){
+ print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n"
+ if $hasindex and $Backlink;
+ print HTML "</p>\n<hr />\n"
+ } else {
+ print HTML "</p>\n";
}
- my $name = htmlify( depod( $heading ) );
+ my $name = anchorify( depod( $heading ) );
my $convert = process_text( \$heading );
- print HTML "<H$level><A NAME=\"$name\">$convert</A></H$level>\n";
+ print HTML "<h$level><a name=\"$name\">$convert</a></h$level>\n";
}
$EmittedItem = $item;
### print STDERR "emit_item_tag=$item ($text)\n";
- print HTML '<STRONG>';
- if ($items_named{$item}++) {
+ print HTML '<strong>';
+ if ($Items_Named{$item}++) {
print HTML process_text( \$otext );
} else {
- my $name = 'item_' . $item;
- print HTML qq{<A NAME="$name">}, process_text( \$otext ), '</A>';
+ my $name = 'item_' . $item;
+ $name = anchorify($name);
+ print HTML qq{<a name="$name">}, process_text( \$otext ), '</a>';
}
- print HTML "</STRONG><BR>\n";
+ print HTML "</strong><br />\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";
}
- print HTML $tag eq 'DL' ? '<DT>' : '<LI>';
+ my $emitted = $tag eq 'dl' ? 'dt' : 'li';
+ print HTML "<$emitted>";
+ return $emitted;
}
#
#
sub process_item {
my( $otext ) = @_;
+ my $need_dd = 0; # set to 1 if we need a <dd></dd> after an item
# lots of documents start a list without doing an =over. this is
# bad! but, the proper thing to do seems to be to just assume
# they did do an =over. so warn them once and then continue.
- if( $listlevel == 0 ){
- warn "$0: $podfile: unexpected =item directive in paragraph $paragraph. ignoring.\n";
+ 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 "<p></p>\n";
+ $After_Lpar = 0;
}
# remove formatting instructions from the text
my $text = depod( $otext );
+ my $emitted; # the tag actually emitted, used for closing
+
# all the list variants:
if( $text =~ /\A\*/ ){ # bullet
- emit_li( 'UL' );
- if ($text =~ /\A\*\s+(.+)\Z/s ) { # with additional text
- my $tag = $1;
- $otext =~ s/\A\*\s+//;
- emit_item_tag( $otext, $tag, 1 );
- }
+ $emitted = emit_li( 'ul' );
+ if ($text =~ /\A\*\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
- emit_li( 'OL' );
- if ($text =~ /\A(?>\d+\.?)\s*(.+)\Z/s ) { # with additional text
- my $tag = $1;
- $otext =~ s/\A\d+\.?\s*//;
- emit_item_tag( $otext, $tag, 1 );
- }
+ $emitted = emit_li( 'ol' );
+ if ($text =~ /\A(?>\d+\.?)\s*(.+)\Z/s ) { # with additional text
+ my $tag = $1;
+ $otext =~ s/\A\d+\.?\s*//;
+ emit_item_tag( $otext, $tag, 1 );
+ }
} else { # definition list
- emit_li( 'DL' );
- if ($text =~ /\A(.+)\Z/s ){ # should have text
- emit_item_tag( $otext, $text, 1 );
- }
- print HTML '<DD>';
+ $emitted = emit_li( 'dl' );
+ if ($text =~ /\A(.+)\Z/s ){ # should have text
+ emit_item_tag( $otext, $text, 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";
+ 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 '<p></p>' 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;
}
#
-# process_pod - process a pod pod tag, thus stop ignoring pod directives
+# process_pod - process a pod tag, thus stop ignoring pod directives
# until we see a corresponding cut.
#
sub process_pod {
- # no need to set $ignore to 0 cause the main loop did it
+ # no need to set $Ignore to 0 cause the main loop did it
}
#
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>};
+ print HTML qq{<p align="center"><img src="$text" alt="$text illustration" /></p>};
}
}
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"
- }
- pop( @begin_stack );
+ if ($Begin_Stack[-1] ne $whom ) {
+ die "Unmatched begin/end at chunk $Paragraph\n"
+ }
+ pop( @Begin_Stack );
}
#
-# process_pre - indented paragraph, made into <PRE></PRE>
+# process_pre - indented paragraph, made into <pre></pre>
#
sub process_pre {
my( $text ) = @_;
my( $rest );
- return if $ignore;
+ return if $Ignore;
$rest = $$text;
# insert spaces in place of tabs
- $rest =~ s#.*#
- my $line = $&;
- 1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
+ $rest =~ s#(.+)#
+ my $line = $1;
+ 1 while $line =~ s/(\t+)/' ' x ((length($1) * 8) - $-[0] % 8)/e;
$line;
#eg;
# convert some special chars to HTML escapes
- $rest =~ s/&/&/g;
- $rest =~ s/</</g;
- $rest =~ s/>/>/g;
- $rest =~ s/"/"/g;
+ $rest = html_escape($rest);
# try and create links for all occurrences of perl.* within
# the preformatted text.
$rest =~ s{
(\s*)(perl\w+)
}{
- if ( defined $pages{$2} ){ # is a link
- qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>);
- } elsif (defined $pages{dosify($2)}) { # is a link
- qq($1<A HREF="$htmlroot/$pages{dosify($2)}">$2</A>);
+ 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: ([^>:]*:)?
+ (<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
+ 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 );
+ $old_url = "$Htmldir$old_url" if $old_url =~ m{^\/};
+ $url = relativize_url( "$old_url.html", $Htmlfileurl );
} else {
$url = "$3.html" ;
}
file
wais
ftp
- } )
+ } )
. ')';
-
+
my $ltrs = '\w';
my $gunk = '/#~:.?+=&%@!\-';
- my $punc = '.:?\-';
+ my $punc = '.:!?\-;';
my $any = "${ltrs}${gunk}${punc}";
$rest =~ s{
- \b # start at word boundary
- ( # begin $1 {
- $urls : # need resource and a colon
- (?!:) # Ignore File::, among others.
- [$any] +? # followed by 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
+ \b # start at word boundary
+ ( # begin $1 {
+ $urls : # need resource and a colon
+ (?!:) # Ignore File::, among others.
+ [$any] +? # followed by one or more of any valid
+ # character, but be conservative and
+ # take only what you need to....
+ ) # end $1 }
+ (?=
+ " > # maybe pre-quoted '<a href="...">'
+ | # or:
+ [$punc]* # 0 or more punctuation
+ (?: # followed
+ [^$any] # by a non-url char
+ | # or
+ $ # end of the string
+ ) #
+ | # or else
+ $ # then end of the string
)
- }{<A HREF="$1">$1</A>}igox;
+ }{<a href="$1">$1</a>}igox;
# text should be as it is (verbatim)
$$text = $rest;
#
sub pure_text($){
my $text = shift();
- process_puretext( $text, \$ptQuote, 1 );
+ process_puretext( $text, \$PTQuote, 1 );
}
sub inIS_text($){
my $text = shift();
- process_puretext( $text, \$ptQuote, 0 );
+ process_puretext( $text, \$PTQuote, 0 );
}
#
if( $args =~ /^\d+$/ ){
my $url = page_sect( $word, '' );
if( defined $url ){
- $word = "<A HREF=\"$url\">the $word manpage</A>";
+ $word = "<a href=\"$url\">the $word manpage</a>";
next;
}
}
} 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>);
+ $word = qq(<a href="$word">$word</a>);
} elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) {
# looks like an e-mail address
my ($w1, $w2, $w3) = ("", $word, "");
($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
($w1, $w2, $w3) = ("<", $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 = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
- } else {
+ $word = qq($w1<a href="mailto:$w2">$w2</a>$w3);
+ } else {
$word = html_escape($word) if $word =~ /["&<>]/;
}
}
sub closing ($) { local($_) = shift; (defined && s/\s+$//) ? length : 0 }
sub process_text {
- return if $ignore;
+ return if $Ignore;
my( $tref ) = @_;
my $res = process_text1( 0, $tref );
$$tref = $res;
if( $func eq 'B' ){
# B<text> - boldface
- $res = '<STRONG>' . process_text1( $lev, $rstr ) . '</STRONG>';
+ $res = '<strong>' . process_text1( $lev, $rstr ) . '</strong>';
} elsif( $func eq 'C' ){
- # C<code> - can be a ref or <CODE></CODE>
+ # C<code> - can be a ref or <code></code>
# need to extract text
my $par = go_ahead( $rstr, 'C', $closing );
my $text = depod( $par );
### my $x = $par =~ /[BI]</ ? 'yes' : 'no' ;
- ### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n";
+ ### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n";
$res = emit_C( $text, $lev > 1 || ($par =~ /[BI]</) );
} elsif( $func eq 'F' ){
# F<filename> - italizice
- $res = '<EM>' . process_text1( $lev, $rstr ) . '</EM>';
+ $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
} elsif( $func eq 'I' ){
# I<text> - italizice
- $res = '<EM>' . process_text1( $lev, $rstr ) . '</EM>';
+ $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
} elsif( $func eq 'L' ){
# L<link> - link
- ## L<text|cross-ref> => produce text, use cross-ref for linking
+ ## L<text|cross-ref> => produce text, use cross-ref for linking
## L<cross-ref> => make text from cross-ref
## need to extract text
my $par = go_ahead( $rstr, 'L', $closing );
if( $par =~ s{^([^|]+)\|}{} ){
$linktext = $1;
}
-
+
# make sure sections start with a /
$par =~ s{^"}{/"};
# check for link patterns
if( $par =~ m{^([^/]+?)/(?!")(.*?)$} ){ # name/ident
- # we've got a name/ident (no quotes)
+ # we've got a name/ident (no quotes)
( $page, $ident ) = ( $1, $2 );
### print STDERR "--> L<$par> to page $page, ident $ident\n";
### print STDERR "got page/section url=$url\n";
last RESOLVE;
}
- ## no luck: go for an ident
+ ## no luck: go for an ident
if( $section ){
$ident = $section;
} else {
# warning; show some text.
$linktext = $opar unless defined $linktext;
- warn "$0: $podfile: cannot resolve L<$opar> in paragraph $paragraph.";
+ warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n" unless $Quiet;
}
- # now we have an URL or just plain code
+ # now we have a URL or just plain code
$$rstr = $linktext . '>' . $$rstr;
if( defined( $url ) ){
- $res = "<A HREF=\"$url\">" . process_text1( $lev, $rstr ) . '</A>';
+ $res = "<a href=\"$url\">" . process_text1( $lev, $rstr ) . '</a>';
} else {
- $res = '<EM>' . process_text1( $lev, $rstr ) . '</EM>';
+ $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
}
} elsif( $func eq 'S' ){
$$rstr =~ s/^[^>]*>//;
} elsif( $func eq 'Z' ){
- # Z<> - empty
- warn "$0: $podfile: invalid X<> in paragraph $paragraph."
- unless $$rstr =~ s/^>//;
+ # Z<> - empty
+ warn "$0: $Podfile: invalid X<> 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.";
+ warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet;
}
}
return $res;
}
$res .= $2;
}
- warn "$0: $podfile: undelimited $func<> in paragraph $paragraph.";
+ warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet;
return $res;
}
if( defined( $url ) &&
(!defined( $EmittedItem ) || $EmittedItem ne $fid ) ){
- $res = "<A HREF=\"$url\"><CODE>$linktext</CODE></A>";
+ $res = "<a href=\"$url\"><code>$linktext</code></a>";
} elsif( 0 && $nocode ){
$res = $linktext;
} else {
- $res = "<CODE>$linktext</CODE>";
+ $res = "<code>$linktext</code>";
}
return $res;
}
$rest =~ s/</</g;
$rest =~ s/>/>/g;
$rest =~ s/"/"/g;
+ # ' is only in XHTML, not HTML4. Be conservative
+ #$rest =~ s/'/'/g;
return $rest;
-}
+}
#
}
#
-# page_sect - make an URL from the text of a L<>
+# page_sect - make a URL from the text of a L<>
#
sub page_sect($$) {
my( $page, $section ) = @_;
my( $linktext, $page83, $link); # work strings
# check if we know that this is a section in this page
- if (!defined $pages{$page} && defined $sections{$page}) {
+ 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 = "#" . htmlify( $section );
+ $link = "#" . anchorify( $section );
} elsif ( $page =~ /::/ ) {
$page =~ s,::,/,g;
# Search page cache for an entry keyed under the html page name,
# 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 .= "#" . htmlify( $section ) if ($section);
- } elsif (!defined $pages{$page}) {
+ $link = "$Htmlroot/$page.html";
+ $link .= "#" . anchorify( $section ) if ($section);
+ } elsif (!defined $Pages{$page}) {
$link = "";
} else {
- $section = htmlify( $section ) if $section ne "";
+ $section = anchorify( $section ) if $section ne "";
### print STDERR "...section=$section\n";
# if there is a directory by the name of the page, then assume that an
# appropriate section will exist in the subdirectory
-# if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
- if ($section ne "" && $pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
- $link = "$htmlroot/$1/$section.html";
+# 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
### 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";
+ if ($Pages{$page} =~ /([^:]*)\.pod:/) {
+ $link = "$Htmlroot/$1.html$section";
+ } elsif ($Pages{$page} =~ /([^:]*)\.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 ;
sub relativize_url {
my ($dest,$source) = @_ ;
- my ($dest_volume,$dest_directory,$dest_file) =
+ 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) =
+ my ($source_volume,$source_directory,$source_file) =
File::Spec::Unix->splitpath( $source ) ;
$source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ) ;
$rel_path = File::Spec::Unix->abs2rel( $dest, $source ) ;
}
- if ( $rel_path ne '' &&
+ if ( $rel_path ne '' &&
substr( $rel_path, -1 ) ne '/' &&
- substr( $dest_file, 0, 1 ) ne '#'
+ substr( $dest_file, 0, 1 ) ne '#'
) {
$rel_path .= "/$dest_file" ;
}
my( $url );
my $fid = fragment_id( $item );
- if( defined( $page ) ){
+ if( defined( $page ) && $page ne "" ){
# we have been given a $page...
$page =~ s{::}{/}g;
# 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_$fid";
+ my $link = "$Htmlroot/$page#item_" . 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_" . $fid;
+ $url = "#item_" . anchorify($fid);
}
confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/;
- }
+ }
return( $url, $fid );
}
# after the entire pod file has been read and converted.
#
sub finish_list {
- while ($listlevel > 0) {
- print HTML "</DL>\n";
- $listlevel--;
+ while ($Listlevel > 0) {
+ print HTML "</dl>\n";
+ $Listlevel--;
}
}
}
#
+# similar to htmlify, but turns non-alphanumerics into underscores
+#
+sub anchorify {
+ my ($anchor) = @_;
+ $anchor = htmlify($anchor);
+ $anchor =~ s/\W/_/g;
+ return $anchor;
+}
+
+#
# depod - convert text by eliminating all interior sequences
# Note: can be called with copy or modify semantics
#
} else {
$string = $_[0];
depod1( \$string );
- }
+ }
}
sub depod1($;$$){
# X<> - ignore
$$rstr =~ s/^[^>]*>//;
} elsif( $func eq 'Z' ){
- # Z<> - empty
+ # Z<> - empty
$$rstr =~ s/^>//;
} else {
# all others: either recurse into new function or
# a) =item text
# b) contents of C<...>
#
-my @hc;
+my @HC;
sub fragment_id {
my $text = shift();
$text =~ s/\s+\Z//s;
# 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\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;
+ defined( $HC[ord($1)] ) ? $HC[ord($1)]
+ : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
$text = substr( $text, 0, 50 );
} else {
return undef();
#
sub make_URL_href($){
my( $url ) = @_;
- if( $url !~
- s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<A HREF="$1$2">$1</A>}i ){
- $url = "<A HREF=\"$url\">$url</A>";
+ if( $url !~
+ s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i ){
+ $url = "<a href=\"$url\">$url</a>";
}
return $url;
}
https://perl5.git.perl.org / perl5.git / blobdiff