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 );
}
# 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\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"
<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;
}
$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{$_};
}
#
-# 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 {
# converted to html commands.
#
-sub process_text1($$;$);
+sub process_text1($$;$$);
+sub pattern ($) { $_[0] ? '[^\S\n]+'.('>' x ($_[0] + 1)) : '>' }
+sub closing ($) { local($_) = shift; (defined && s/\s+$//) ? length : 0 }
sub process_text {
return if $ignore;
$$tref = $res;
}
-sub process_text1($$;$){
- my( $lev, $rstr, $func ) = @_;
- $lev++ unless defined $func;
+sub process_text1($$;$$){
+ my( $lev, $rstr, $func, $closing ) = @_;
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 'C' ){
# C<code> - can be a ref or <CODE></CODE>
# need to extract text
- my $par = go_ahead( $rstr, 'C' );
+ my $par = go_ahead( $rstr, 'C', $closing );
## clean-up of the link target
my $text = depod( $par );
} 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
## 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' );
+ my $par = go_ahead( $rstr, 'L', $closing );
# some L<>'s that shouldn't be:
# a) full-blown URL's are emitted as-is
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>';
unless $$rstr =~ s/^>//;
} else {
- while( $$rstr =~ s/\A(.*?)([BCEFILSXZ]<|>)//s ){
+ my $term = pattern $closing;
+ while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){
# all others: either recurse into new function or
- # terminate at closing angle bracket
+ # terminate at closing angle bracket(s)
my $pt = $1;
- $pt .= '>' if $2 eq '>' && $lev == 1;
+ $pt .= $2 if !$3 && $lev == 1;
$res .= $lev == 1 ? pure_text( $pt ) : inIS_text( $pt );
- return $res if $2 eq '>' && $lev > 1;
- if( $2 ne '>' ){
- $res .= process_text1( $lev, $rstr, substr($2,0,1) );
- }
-
+ return $res if !$3 && $lev > 1;
+ if( $3 ){
+ $res .= process_text1( $lev, $rstr, $3, closing $4 );
+ }
}
if( $lev == 1 ){
$res .= pure_text( $$rstr );
#
# go_ahead: extract text of an IS (can be nested)
#
-sub go_ahead($$){
- my( $rstr, $func ) = @_;
+sub go_ahead($$$){
+ my( $rstr, $func, $closing ) = @_;
my $res = '';
- my $level = 1;
- while( $$rstr =~ s/\A(.*?)([BCEFILSXZ]<|>)//s ){
+ my @closing = ($closing);
+ while( $$rstr =~
+ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|@{[pattern $closing[0]]})//s ){
$res .= $1;
- if( $2 eq '>' ){
- return $res if --$level == 0;
+ unless( $3 ){
+ shift @closing;
+ return $res unless @closing;
} else {
- ++$level;
+ unshift @closing, closing $4;
}
$res .= $2;
}
#
sub emit_C($;$$){
my( $text, $nocode, $args ) = @_;
- $args ||= '';
+ $args = '' unless defined $args;
my $res;
my( $url, $fid ) = coderef( undef(), $text );
}
#
-# 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 ) = @_;
$E2c{verbar} = '|';
$E2c{amp} = '&'; # in Tk's pods
-sub depod1($;$);
+sub depod1($;$$);
sub depod($){
my $string;
}
}
-sub depod1($;$){
- my( $rstr, $func ) = @_;
+sub depod1($;$$){
+ my( $rstr, $func, $closing ) = @_;
my $res = '';
return $res unless defined $$rstr;
if( ! defined( $func ) ){
# skip to next begin of an interior sequence
- while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<// ){
+ while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?// ){
# recurse into its text
- $res .= $1 . depod1( $rstr, $2 );
+ $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
- while( $$rstr =~ s/\A(.*?)([BCEFILSXZ]<|>)// ){
+ my $term = pattern $closing;
+ while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)// ){
$res .= $1;
- last if $2 eq '>';
- $res .= depod1( $rstr, substr($2,0,1) );
+ last unless $3;
+ $res .= depod1( $rstr, $3, closing $4 );
}
## If we're here and $2 ne '>': undelimited interior sequence.
## Ignored, as this is called without proper indication of where we are.
projects / p5sagit/p5-mst-13.2.git / blobdiff