File Coverage

File:blib/lib/Pod/Html.pm
Coverage:77.7%

linestmtbrancondsubcode
1package Pod::Html;
2
9
9
9
use strict;
3require Exporter;
4
5
9
9
9
use vars qw($VERSION @ISA @EXPORT);
6$VERSION = 1.21;
7@ISA = qw(Exporter);
8@EXPORT = qw(pod2html);
9
10
9
9
9
use Carp;
11
9
9
9
use Config;
12
9
9
9
use Cwd;
13
9
9
9
use File::Basename;
14
9
9
9
use File::Spec;
15
9
9
9
use File::Spec::Unix;
16
9
9
9
use Getopt::Long;
17
9
9
9
use Pod::Simple::Search;
18
9
9
9
use lib ( './lib' );
19
9
use Pod::Html::Auxiliary qw(
20    parse_command_line
21    usage
22    html_escape
23    htmlify
24    anchorify
25    unixify
26
9
9
);
27
28BEGIN {
29
9
    if($Config{d_setlocale}) {
30
9
9
        require locale; import locale; # make \w work right in non-ASCII lands
31    }
32}
33
34 - 222
=head1 NAME

Pod::Html - module to convert pod files to HTML

=head1 SYNOPSIS

    use Pod::Html;
    pod2html([options]);

=head1 DESCRIPTION

Converts files from pod format (see L<perlpod>) to HTML format.  It
can automatically generate indexes and cross-references, and it keeps
a cache of things it knows how to cross-reference.

=head1 FUNCTIONS

=head2 pod2html

    pod2html("pod2html",
             "--podpath=lib:ext:pod:vms",
             "--podroot=/usr/src/perl",
             "--htmlroot=/perl/nmanual",
             "--recurse",
             "--infile=foo.pod",
             "--outfile=/perl/nmanual/foo.html");

pod2html takes the following arguments:

=over 4

=item backlink

    --backlink

Turns every C<head1> heading into a link back to the top of the page.
By default, no backlinks are generated.

=item cachedir

    --cachedir=name

Creates the directory cache in the given directory.

=item css

    --css=stylesheet

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

    --flush

Flushes the directory cache.

=item header

    --header
    --noheader

Creates header and footer blocks containing the text of the C<NAME>
section.  By default, no headers are generated.

=item help

    --help

Displays the usage message.

=item htmldir

    --htmldir=name

Sets the directory to which all cross references in the resulting
html file will be relative. Not passing this causes all links to be
absolute since this is the value that tells Pod::Html the root of the
documentation tree.

Do not use this and --htmlroot in the same call to pod2html; they are
mutually exclusive.

=item htmlroot

    --htmlroot=name

Sets the base URL for the HTML files.  When cross-references are made,
the HTML root is prepended to the URL.

Do not use this if relative links are desired: use --htmldir instead.

Do not pass both this and --htmldir to pod2html; they are mutually
exclusive.

=item index

    --index
    --noindex

Generate an index at the top of the HTML file.  This is the default
behaviour.

=item infile

    --infile=name

Specify the pod file to convert.  Input is taken from STDIN if no
infile is specified.

=item outfile

    --outfile=name

Specify the HTML file to create.  Output goes to STDOUT if no outfile
is specified.

=item poderrors

    --poderrors
    --nopoderrors

Include a "POD ERRORS" section in the outfile if there were any POD
errors in the infile. This section is included by default.

=item podpath

    --podpath=name:...:name

Specify which subdirectories of the podroot contain pod files whose
HTML converted forms can be linked to in cross references.

=item podroot

    --podroot=name

Specify the base directory for finding library pods. Default is the
current working directory.

=item quiet

    --quiet
    --noquiet

Don't display I<mostly harmless> warning messages.  These messages
will be displayed by default.  But this is not the same as C<verbose>
mode.

=item recurse

    --recurse
    --norecurse

Recurse into subdirectories specified in podpath (default behaviour).

=item title

    --title=title

Specify the title of the resulting HTML file.

=item verbose

    --verbose
    --noverbose

Display progress messages.  By default, they won't be displayed.

=back

=head1 ENVIRONMENT

Uses C<$Config{pod2html}> to setup default options.

=head1 AUTHOR

Marc Green, E<lt>marcgreen@cpan.orgE<gt>.

Original version by Tom Christiansen, E<lt>tchrist@perl.comE<gt>.

=head1 SEE ALSO

L<perlpod>

=head1 COPYRIGHT

This program is distributed under the Artistic License.

=cut
223
224sub new {
225
23
    my $class = shift;
226
23
    my %args = ();
227
23
    $args{Curdir} = File::Spec->curdir;
228
23
    $args{Cachedir} = "."; # The directory to which directory caches
229                                # will be written.
230
23
    $args{Dircache} = "pod2htmd.tmp";
231
23
    $args{Htmlroot} = "/"; # http-server base directory from which all
232                                # relative paths in $podpath stem.
233
23
    $args{Htmldir} = ""; # The directory to which the html pages
234                                # will (eventually) be written.
235
23
    $args{Htmlfile} = ""; # write to stdout by default
236
23
    $args{Htmlfileurl} = ""; # The url that other files would use to
237                                # refer to this file. This is only used
238                                # to make relative urls that point to
239                                # other files.
240
241
23
    $args{Poderrors} = 1;
242
23
    $args{Podfile} = ""; # read from stdin by default
243
23
    $args{Podpath} = [];
244
23
    $args{Podroot} = $args{Curdir}; # filesystem base directory from which all
245                                # relative paths in $podpath stem.
246
23
    $args{Css} = ''; # Cascading style sheet
247
23
    $args{Recurse} = 1; # recurse on subdirectories in $podpath.
248
23
    $args{Quiet} = 0; # not quiet by default
249
23
    $args{Verbose} = 0; # not verbose by default
250
23
    $args{Doindex} = 1; # non-zero if we should generate an index
251
23
    $args{Backlink} = 0; # no backlinks added by default
252
23
    $args{Header} = 0; # produce block header/footer
253
23
    $args{Title} = ''; # title to give the pod(s)
254
23
    $args{Saved_Cache_Key} = undef;
255
23
    return bless \%args, $class;
256}
257
258sub process_options {
259
23
    my ($self, $opts) = @_;
260
23
    if (defined $opts) {
261
22
        croak "process_options() needs hashref" unless ref($opts) eq 'HASH';
262    }
263    else {
264
1
        $opts = {};
265    }
266    # Declare intermediate hash to hold cleaned-up options
267
22
    my %h = ();
268
22
9
    @{$h{Podpath}} = split(":", $opts->{podpath}) if defined $opts->{podpath};
269
22
    warn "--libpods is no longer supported" if defined $opts->{libpods};
270
271
22
    $h{Backlink} = $opts->{backlink} if defined $opts->{backlink};
272
22
    $h{Cachedir} = unixify($opts->{cachedir}) if defined $opts->{cachedir};
273
22
    $h{Css} = $opts->{css} if defined $opts->{css};
274
22
    $h{Header} = $opts->{header} if defined $opts->{header};
275
22
    $h{Htmldir} = unixify($opts->{htmldir}) if defined $opts->{htmldir};
276
22
    $h{Htmlroot} = unixify($opts->{htmlroot}) if defined $opts->{htmlroot};
277
22
    $h{Doindex} = $opts->{index} if defined $opts->{index};
278
22
    $h{Podfile} = unixify($opts->{infile}) if defined $opts->{infile};
279
22
    $h{Htmlfile} = unixify($opts->{outfile}) if defined $opts->{outfile};
280
22
    $h{Poderrors} = $opts->{poderrors} if defined $opts->{poderrors};
281
22
    $h{Podroot} = unixify($opts->{podroot}) if defined $opts->{podroot};
282
22
    $h{Quiet} = $opts->{quiet} if defined $opts->{quiet};
283
22
    $h{Recurse} = $opts->{recurse} if defined $opts->{recurse};
284
22
    $h{Title} = $opts->{title} if defined $opts->{title};
285
22
    $h{Verbose} = $opts->{verbose} if defined $opts->{verbose};
286
22
    $h{flush} = $opts->{flush} if defined $opts->{flush};
287
288
22
    while (my ($k,$v) = each %h) {
289
73
        $self->{$k} = $v;
290    };
291
22
    return 1;
292}
293
294sub cleanup_elements {
295
19
    my $self = shift;
296
19
    warn "Flushing directory caches\n"
297        if $self->{Verbose} && defined $self->{flush};
298
19
    $self->{Dircache} = "$self->{Cachedir}/pod2htmd.tmp";
299
19
    if (defined $self->{flush}) {
300
2
        1 while unlink($self->{Dircache});
301    }
302    # prevent '//' in urls
303
19
    $self->{Htmlroot} = "" if $self->{Htmlroot} eq "/";
304
19
    $self->{Htmldir} =~ s#/\z##;
305    # Per documentation, Htmlroot and Htmldir cannot both be set to true
306    # values. Die if that is the case.
307
19
    my $msg = "htmlroot and htmldir cannot both be set to true values\n";
308
19
    $msg .= "Choose one or the other";
309
19
    croak $msg if ($self->{Htmlroot} and $self->{Htmldir});
310
311
312
18
    if ( $self->{Htmlroot} eq ''
313       && $self->{Htmldir} ne ''
314       && substr( $self->{Htmlfile}, 0, length( $self->{Htmldir} ) ) eq $self->{Htmldir}
315       ) {
316        # Set the 'base' url for this file, so that we can use it
317        # as the location from which to calculate relative links
318        # to other files. If this is '', then absolute links will
319        # be used throughout.
320        # $self->{Htmlfileurl} =
321        # "$self->{Htmldir}/" . substr( $self->{Htmlfile}, length( $self->{Htmldir} ) + 1);
322        # Is the above not just "$self->{Htmlfileurl} = $self->{Htmlfile}"?
323
1
        $self->{Htmlfileurl} = unixify($self->{Htmlfile});
324    }
325
326    # XXX: implement default title generator in pod::simple::xhtml
327    # copy the way the old Pod::Html did it
328
18
    $self->{Title} = html_escape($self->{Title});
329
18
    return 1;
330}
331
332sub generate_pages_cache {
333
14
    my $self = shift;
334
14
    my $cache_tests = $self->get_cache();
335
14
    return if $cache_tests;
336
337    # generate %{$self->{Pages}}
338
10
    my $pwd = getcwd();
339
10
    chdir($self->{Podroot}) ||
340        die "$0: error changing to directory $self->{Podroot}: $!\n";
341
342    # find all pod modules/pages in podpath, store in %{$self->{Pages}}
343    # - callback used to remove Podroot and extension from each file
344    # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
345
10
10
    my $name2path = Pod::Simple::Search->new->inc(0)->verbose($self->{Verbose})->laborious(1)->recurse($self->{Recurse})->survey(@{$self->{Podpath}});
346
10
10
    foreach my $modname (sort keys %{$name2path}) {
347
0
        $self->_save_page($name2path->{$modname}, $modname);
348    }
349
350
10
    chdir($pwd) || die "$0: error changing to directory $pwd: $!\n";
351
352    # cache the directory list for later use
353
10
    if ($self->{Verbose}) {
354
2
        warn "caching directories for later use\n";
355    }
356
10
    open my $CACHE, '>', $self->{Dircache}
357        or die "$0: error open $self->{Dircache} for writing: $!\n";
358
359
10
10
    my $cacheline = join(":", @{$self->{Podpath}}) . "\n$self->{Podroot}\n";
360
10
    print $CACHE $cacheline;
361
10
    my $_updirs_only = ($self->{Podroot} =~ /\.\./) && !($self->{Podroot} =~ /[^\.\\\/]/);
362
10
10
    foreach my $key (keys %{$self->{Pages}}) {
363
0
        if($_updirs_only) {
364
0
          my $_dirlevel = $self->{Podroot};
365
0
          while($_dirlevel =~ /\.\./) {
366
0
            $_dirlevel =~ s/\.\.//;
367            # Assume $self->{Pages}->{$key} has '/' separators (html dir separators).
368
0
            $self->{Pages}->{$key} =~ s/^[\w\s\-\.]+\///;
369          }
370        }
371
0
        my $keyline = "$key $self->{Pages}->{$key}\n";
372
0
        print $CACHE $keyline;
373    }
374
375
10
    close $CACHE or die "error closing $self->{Dircache}: $!";
376
10
    return 1;
377}
378
379sub prepare_parser {
380
6
    my $self = shift;
381
6
    my $parser = Pod::Simple::XHTML::LocalPodLinks->new();
382
6
    $parser->codes_in_verbatim(0);
383
6
    $parser->anchor_items(1); # the old Pod::Html always did
384
6
    $parser->backlink($self->{Backlink}); # linkify =head1 directives
385
6
    $parser->htmldir($self->{Htmldir});
386
6
    $parser->htmlfileurl($self->{Htmlfileurl});
387
6
    $parser->htmlroot($self->{Htmlroot});
388
6
    $parser->index($self->{Doindex});
389
6
    $parser->no_errata_section(!$self->{Poderrors}); # note the inverse
390# $parser->output_string(\my $output); # written to file later
391
6
    $parser->pages($self->{Pages});
392
6
    $parser->quiet($self->{Quiet});
393
6
    $parser->verbose($self->{Verbose});
394
6
    return $parser;
395}
396
397sub prepare_html_components {
398
6
    my ($self, $parser ) = @_;
399
6
    $parser->output_string(\my $output); # written to file later
400    # We need to add this ourselves because we use our own header, not
401    # ::XHTML's header. We need to set $parser->backlink to linkify
402    # the =head1 directives
403
6
    my $bodyid = $self->{Backlink} ? ' id="_podtop_"' : '';
404
405
6
    my $csslink = '';
406
6
    my $tdstyle = ' style="background-color: #cccccc; color: #000"';
407
408
6
    if ($self->{Css}) {
409
0
        $csslink = qq(\n<link rel="stylesheet" href="$self->{Css}" type="text/css" />);
410
0
        $csslink =~ s,\\,/,g;
411
0
        $csslink =~ s,(/.):,$1|,;
412
0
        $tdstyle= '';
413    }
414
415    # header/footer block
416
6
    my $block = $self->{Header} ? <<END_OF_BLOCK : '';
417<table border="0" width="100%" cellspacing="0" cellpadding="3">
418<tr><td class="_podblock_"$tdstyle valign="middle">
419<big><strong><span class="_podblock_">&nbsp;$self->{Title}</span></strong></big>
420</td></tr>
421</table>
422END_OF_BLOCK
423
424    # create own header/footer because of --header
425
6
    $parser->html_header(<<"HTMLHEAD");
426<?xml version="1.0" ?>
427<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
428<html xmlns="http://www.w3.org/1999/xhtml">
429<head>
430<title>$self->{Title}</title>$csslink
431<meta http-equiv="content-type" content="text/html; charset=utf-8" />
432<link rev="made" href="mailto:$Config{perladmin}" />
433</head>
434
435<body$bodyid>
436$block
437HTMLHEAD
438
439
6
    $parser->html_footer(<<"HTMLFOOT");
440$block
441</body>
442
443</html>
444HTMLFOOT
445
6
    return 1;
446}
447
448sub prepare_output {
449
5
    my ($self, $parser) = @_;
450
5
    my $input;
451
5
    unless (@ARGV && $ARGV[0]) {
452
5
        if ($self->{Podfile} and $self->{Podfile} ne '-') {
453
5
            $input = $self->{Podfile};
454        }
455        else {
456
0
            $input = '-'; # XXX: make a test case for this
457        }
458    } else {
459
0
        $self->{Podfile} = $ARGV[0];
460
0
        $input = *ARGV;
461    }
462
463
5
    warn "Converting input file $self->{Podfile}\n" if $self->{Verbose};
464
5
    $parser->output_string(\my $output); # written to file later
465
5
    $parser->parse_file($input);
466
5
    return $output;
467}
468
469sub write_html {
470
5
    my ($self, $output) = @_;
471
5
    my $FHOUT;
472
5
    if($self->{Htmlfile} and $self->{Htmlfile} ne '-') {
473
5
        open $FHOUT, ">", $self->{Htmlfile}
474            or die "$0: cannot open $self->{Htmlfile} file for output: $!\n";
475
5
        binmode $FHOUT, ":utf8";
476
5
        print $FHOUT $output;
477
5
        close $FHOUT or die "Failed to close $self->{Htmlfile}: $!";
478
5
        chmod 0644, $self->{Htmlfile};
479    }
480    else {
481
0
        open $FHOUT, ">-";
482
0
        binmode $FHOUT, ":utf8";
483
0
        print $FHOUT $output;
484
0
        close $FHOUT or die "Failed to close handle to STDOUT: $!";
485    }
486
5
    return 1;
487}
488
489sub pod2html {
490
4
    local @ARGV = @_;
491
4
    my $options = parse_command_line();
492
493
4
    my $p2h = Pod::Html->new();
494
4
    $p2h->process_options( $options );
495
4
    $p2h->cleanup_elements();
496
4
    $p2h->generate_pages_cache();
497
498
4
    my $parser = $p2h->prepare_parser();
499
4
    $p2h->prepare_html_components($parser);
500
4
    my $output = $p2h->prepare_output($parser);
501
4
    my $rv = $p2h->write_html($output);
502
4
    return $rv;
503}
504
505sub get_cache {
506
14
    my $self = shift;
507# my @cache_key_args = @_;
508
509    # A first-level cache:
510    # Don't bother reading the cache files if they still apply
511    # and haven't changed since we last read them.
512
513
14
    my $this_cache_key = $self->cache_key();
514
14
    return 1 if $self->{Saved_Cache_Key}
515        and $this_cache_key eq $self->{Saved_Cache_Key};
516
14
    $self->{Saved_Cache_Key} = $this_cache_key;
517
518    # load the cache of %Pages if possible. $tests will be
519    # non-zero if successful.
520
14
    my $tests = 0;
521
14
    if (-f $self->{Dircache}) {
522
5
        warn "scanning for directory cache\n" if $self->{Verbose};
523
5
        $tests = $self->load_cache();
524    }
525
526
14
    return $tests;
527}
528
529sub cache_key {
530
14
    my $self = shift;
531
14
    return join('!' => (
532        $self->{Dircache},
533        $self->{Recurse},
534
14
        @{$self->{Podpath}},
535        $self->{Podroot},
536        stat($self->{Dircache}),
537    ) );
538}
539
540#
541# load_cache - tries to find if the cache stored in $dircache is a valid
542# cache of %Pages. if so, it loads them and returns a non-zero value.
543#
544sub load_cache {
545
5
    my $self = shift;
546
5
    my $tests = 0;
547
5
    local $_;
548
549
5
    warn "scanning for directory cache\n" if $self->{Verbose};
550
5
    open(my $CACHEFH, '<', $self->{Dircache}) ||
551        die "$0: error opening $self->{Dircache} for reading: $!\n";
552
5
    $/ = "\n";
553
554    # is it the same podpath?
555
5
    $_ = <$CACHEFH>;
556
5
    chomp($_);
557
5
5
    $tests++ if (join(":", @{$self->{Podpath}}) eq $_);
558
559    # is it the same podroot?
560
5
    $_ = <$CACHEFH>;
561
5
    chomp($_);
562
5
    $tests++ if ($self->{Podroot} eq $_);
563
564    # load the cache if its good
565
5
    if ($tests != 2) {
566
1
        close($CACHEFH);
567
1
        return 0;
568    }
569
570
4
    warn "loading directory cache\n" if $self->{Verbose};
571
4
    while (<$CACHEFH>) {
572
0
        /(.*?) (.*)$/;
573
0
        $self->{Pages}->{$1} = $2;
574    }
575
576
4
    close($CACHEFH);
577
4
    return 1;
578}
579
580
581#
582# store POD files in %Pages
583#
584sub _save_page {
585
0
    my ($self, $modspec, $modname) = @_;
586
587    # Remove Podroot from path
588
0
    $modspec = $self->{Podroot} eq File::Spec->curdir
589               ? File::Spec->abs2rel($modspec)
590               : File::Spec->abs2rel($modspec,
591                                     File::Spec->canonpath($self->{Podroot}));
592
593    # Convert path to unix style path
594
0
    $modspec = unixify($modspec);
595
596
0
    my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext
597
0
    $self->{Pages}->{$modname} = $dir.$file;
598}
599
600 - 625
=head2 C<get()>

=over 4

=item * Purpose

Access current value of an element in the Pod::Html object.

=item * Arguments

    my $ucachefile = $p2h->get('Dircache');

String holding name of element in object.

=item * Return Value

String holding value of element in object if a value is provided and if that
value is defined.  Otherwise, return value is undefined.

=item * Comment

Useful in testing of Pod::Html, but not needed in production programs.

=back

=cut
626
627sub get {
628
16
    my ($self, $element) = @_;
629
16
    return unless defined $element;
630
15
    return unless (exists $self->{$element} and defined $self->{$element});
631
12
    return $self->{$element};
632}
633
6341;
635
636package Pod::Simple::XHTML::LocalPodLinks;
637
9
9
9
use strict;
638
9
9
9
use warnings;
639
9
9
9
use parent 'Pod::Simple::XHTML';
640
641
9
9
9
use File::Spec;
642
9
9
9
use File::Spec::Unix;
643
9
9
9
use lib ( './lib' );
644
9
use Pod::Html::Auxiliary qw(
645    unixify
646    relativize_url
647
9
9
);
648
649__PACKAGE__->_accessorize(
650 'htmldir',
651 'htmlfileurl',
652 'htmlroot',
653 'pages', # Page name => relative/path/to/page from root POD dir
654 'quiet',
655 'verbose',
656);
657
658# Subclass Pod::Simple::XHTML::resolve_pod_page_link()
659sub resolve_pod_page_link {
660
0
    my ($self, $to, $section) = @_;
661
662
0
    return undef unless defined $to || defined $section;
663
0
    if (defined $section) {
664
0
        $section = '#' . $self->idify($section, 1);
665
0
        return $section unless defined $to;
666    } else {
667
0
        $section = '';
668    }
669
670
0
    my $path; # path to $to according to %Pages
671
0
    unless (exists $self->pages->{$to}) {
672#print STDERR "AAA: In the unless block\n";
673        # Try to find a POD that ends with $to and use that.
674        # e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages,
675        # look for $Podpath/*/XHTML in %Pages, with * being any path,
676        # as a substitute (e.g., $Podpath/Pod/Simple/XHTML)
677
0
        my @matches;
678
0
0
        foreach my $modname (keys %{$self->pages}) {
679
0
            push @matches, $modname if $modname =~ /::\Q$to\E\z/;
680        }
681#print STDERR "BBB: matches: <@matches>\n";
682
683
0
        if ($#matches == -1) {
684
0
            warn "Cannot find \"$to\" in podpath: " .
685                 "cannot find suitable replacement path, cannot resolve link\n"
686                 unless $self->quiet;
687
0
            return '';
688        } elsif ($#matches == 0) {
689
0
            warn "Cannot find \"$to\" in podpath: " .
690                 "using $matches[0] as replacement path to $to\n"
691                 unless $self->quiet;
692
0
            $path = $self->pages->{$matches[0]};
693        } else {
694
0
            warn "Cannot find \"$to\" in podpath: " .
695                 "more than one possible replacement path to $to, " .
696                 "using $matches[-1]\n" unless $self->quiet;
697            # Use [-1] so newer (higher numbered) perl PODs are used
698
0
            $path = $self->pages->{$matches[-1]};
699        }
700    } else {
701#print STDERR "CCC: In the else block\n";
702
0
        $path = $self->pages->{$to};
703    }
704
705
0
    my $url = File::Spec::Unix->catfile(unixify($self->htmlroot),
706                                        $path);
707
708
0
    if ($self->htmlfileurl ne '') {
709#print STDERR "DDD: In the ne block\n";
710        # then $self->htmlroot eq '' (by definition of htmlfileurl) so
711        # $self->htmldir needs to be prepended to link to get the absolute path
712        # that will be relativized
713
0
        $url = relativize_url(
714            File::Spec::Unix->catdir(unixify($self->htmldir), $url),
715            $self->htmlfileurl # already unixified
716        );
717    }
718
719#print STDERR "EEE: Returning: ", $url . ".html$section", "\n";
720
0
    return $url . ".html$section";
721}
722
7231;