require Exporter;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = 1.03;
+$VERSION = 1.04;
@ISA = qw(Exporter);
@EXPORT = qw(pod2html htmlify);
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
Adds "Back to Top" links in front of every HEAD1 heading (except for
the first). By default, no backlink are being generated.
+=item cachedir
+
+ --cachedir=name
+
+Creates the item and directory caches in the given directory.
+
=item css
--css=stylesheet
=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";
# 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
+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.
$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
+$podroot = File::Spec->curdir; # filesystem base directory from which all
# relative paths in $podpath stem.
$css = ''; # Cascading style sheet
$recurse = 1; # recurse on subdirectories in $podpath.
#
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 );
}
}
$htmlfile = "-" unless $htmlfile; # stdout
$htmlroot = "" if $htmlroot eq "/"; # so we don't get a //
- $htmldir =~ s#/$## ; # so we don't get a //
+ $htmldir =~ s#/\z## ; # so we don't get a //
if ( $htmlroot eq ''
&& defined( $htmldir )
&& $htmldir ne ''
# put a title in the HTML file if one wasn't specified
if ($title eq '') {
TITLE_SEARCH: {
- for (my $i = 0; $i < @poddata; $i++) {
+ for my $i ( 0..$#poddata ) {
if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
for my $para ( @poddata[$i, $i+1] ) {
last TITLE_SEARCH
}
}
}
- if (!$title and $podfile =~ /\.pod$/) {
+ if (!$title and $podfile =~ /\.pod\z/) {
# probably a split pod so take first =head[12] as title
- for (my $i = 0; $i < @poddata; $i++) {
+ for my $i ( 0..$#poddata ) {
last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
}
warn "adopted '$title' as title for $podfile\n"
$title =~ s/\s*\(.*\)//;
} else {
warn "$0: no title for $podfile" unless $quiet;
- $podfile =~ /^(.*)(\.[^.\/]+)?$/;
+ $podfile =~ /^(.*)(\.[^.\/]+)?\z/s;
$title = ($podfile eq "-" ? 'No Title' : $1);
warn "using $title" if $verbose;
}
<HTML>
<HEAD>
<TITLE>$title</TITLE>$csslink
-<LINK REV="made" HREF="mailto:$Config{perladmin}">
</HEAD>
<BODY>
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';
my $text = $_;
if( $text =~ /\A\s+/ ){
process_pre( \$text );
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).
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);
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,
@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;
warn "Flushing item and directory caches\n"
if $opt_verbose && defined $opt_flush;
+ $dircache = "$cachedir/pod2htmd$cache_ext";
+ $itemcache = "$cachedir/pod2htmi$cache_ext";
unlink($dircache, $itemcache) if defined $opt_flush;
}
$dirname = $1;
opendir(DIR, $dirname) ||
die "$0: error opening directory $dirname: $!\n";
- @files = grep(/(\.pod|\.pm)$/ && ! -d $_, readdir(DIR));
+ @files = grep(/(\.pod|\.pm)\z/ && ! -d $_, readdir(DIR));
closedir(DIR);
# scan each .pod and .pm file for =item directives
$pages{$_} = "" unless defined $pages{$_};
$pages{$_} .= "$dir/$_:";
push(@subdirs, $_);
- } elsif (/\.pod$/) { # .pod
- s/\.pod$//;
+ } elsif (/\.pod\z/) { # .pod
+ s/\.pod\z//;
$pages{$_} = "" unless defined $pages{$_};
$pages{$_} .= "$dir/$_.pod:";
push(@pods, "$dir/$_.pod");
- } elsif (/\.pm$/) { # .pm
- s/\.pm$//;
+ } elsif (/\.html\z/) { # .html
+ s/\.html\z//;
+ $pages{$_} = "" unless defined $pages{$_};
+ $pages{$_} .= "$dir/$_.pod:";
+ } elsif (/\.pm\z/) { # .pm
+ s/\.pm\z//;
$pages{$_} = "" unless defined $pages{$_};
$pages{$_} .= "$dir/$_.pm:";
push(@pods, "$dir/$_.pm");
my($i, $item);
local $_;
- $pod =~ s/\.pod$//;
+ $pod =~ s/\.pod\z//;
$pod .= ".html" if $pod;
foreach $i (0..$#poddata) {
}
#
-# 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 {
# skip space runs
next if $word =~ /^\s*$/;
# see if we can infer a link
- if( $notinIS && $word =~ /^(\w+)\((.*)\)\W*$/ ) {
+ if( $notinIS && $word =~ /^(\w+)\((.*)\)$/ ) {
# has parenthesis so should have been a C<> ref
## try for a pagename (perlXXX(1))?
- if( $2 =~ /^\d+$/ ){
+ my( $func, $args ) = ( $1, $2 );
+ if( $args =~ /^\d+$/ ){
my $url = page_sect( $word, '' );
if( defined $url ){
$word = "<A HREF=\"$url\">the $word manpage</A>";
next;
}
}
- $word = emit_C( $word );
+ ## try function name for a link, append tt'ed argument list
+ $word = emit_C( $func, '', "($args)");
#### disabled. either all (including $\W, $\w+{.*} etc.) or nothing.
## } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) {
sub process_text1($$;$$){
my( $lev, $rstr, $func, $closing ) = @_;
- $lev++ unless defined $func;
my $res = '';
- $func ||= '';
+ unless (defined $func) {
+ $func = '';
+ $lev++;
+ }
+
if( $func eq 'B' ){
# B<text> - boldface
$res = '<STRONG>' . process_text1( $lev, $rstr ) . '</STRONG>';
} elsif( $func eq 'E' ){
# E<x> - convert to character
- $$rstr =~ s/^(\w+)>//;
- $res = "&$1;";
+ $$rstr =~ s/^([^>]*)>//;
+ my $escape = $1;
+ $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i;
+ $res = "&$escape;";
} elsif( $func eq 'F' ){
# F<filename> - italizice
warn "$0: $podfile: cannot resolve L<$opar> in paragraph $paragraph.";
}
- # 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>';
return $res if !$3 && $lev > 1;
if( $3 ){
$res .= process_text1( $lev, $rstr, $3, closing $4 );
- }
-
+ }
}
if( $lev == 1 ){
$res .= pure_text( $$rstr );
# emit_C - output result of C<text>
# $text is the depod-ed text
#
-sub emit_C($;$){
- my( $text, $nocode ) = @_;
+sub emit_C($;$$){
+ my( $text, $nocode, $args ) = @_;
+ $args = '' unless defined $args;
my $res;
my( $url, $fid ) = coderef( undef(), $text );
# need HTML-safe text
- my $linktext = html_escape( $text );
+ my $linktext = html_escape( "$text$args" );
if( defined( $url ) &&
(!defined( $EmittedItem ) || $EmittedItem ne $fid ) ){
}
#
-# 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 ) = @_;
# this will only find one page. A better solution might be to produce
# an intermediate page that is an index to all such pages.
my $page_name = $page ;
- $page_name =~ s,^.*/,, ;
+ $page_name =~ s,^.*/,,s ;
if ( defined( $pages{ $page_name } ) &&
$pages{ $page_name } =~ /([^:]*$page)\.(?:pod|pm):/
) {
# for other kinds of links, like file:, ftp:, etc.
my $url ;
if ( $htmlfileurl ne '' ) {
- $link = "$htmldir$link" if $link =~ m{^/};
+ $link = "$htmldir$link" if $link =~ m{^/}s;
$url = relativize_url( $link, $htmlfileurl );
# print( " b: [$link,$htmlfileurl,$url]\n" );
}
# skip to next begin of an interior sequence
while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?// ){
# recurse into its text
- $res .= $1 . depod1( $rstr, $2, closing $3);
+ $res .= $1 . depod1( $rstr, $2, closing $3);
}
$res .= $$rstr;
} elsif( $func eq 'E' ){
# E<x> - convert to character
- $$rstr =~ s/^(\w+)>//;
+ $$rstr =~ s/^([^>]*)>//;
$res .= $E2c{$1} || "";
} elsif( $func eq 'X' ){
# X<> - ignore
} else {
# all others: either recurse into new function or
# terminate at closing angle bracket
- my $term = pattern $closing;
+ my $term = pattern $closing;
while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)// ){
$res .= $1;
last unless $3;