Subversion Repositories DevTools

Rev

Rev 361 | Blame | Compare with Previous | Last modification | View Log | RSS feed 

package JatsDocTools::Pod;

use strict;
use base qw(Exporter);
our @EXPORT_OK = qw(pod2html pod2html_remove_cache_files);

use Carp qw(croak carp);

require Pod::Html;

my($basename, %expand); # XXX

sub pod2html {
    my(%opt) = @_;
    my $infile  = delete $opt{infile} || croak("Required infile argument missing");
    my $outfile = delete $opt{outfile} || croak("Required outfile argument missing");
    my $depth   = delete $opt{depth} || 0;
    my $podroot = delete $opt{podroot} || croak("Required podroot argument missing");
    my $cacheDir= delete $opt{cacheDir} || croak("Required cacheDir argument missing");
    my $podpath = delete $opt{podpath} || "bin:lib";
    my $index   = delete $opt{index} || 0;

    if (%opt && $^W) {
    carp("Unrecognized option $_ passed to pod2html")
        for sort keys %opt;
    }

    chmod(0644, $outfile);
    unlink($outfile);

    my $html_root = substr("../" x $depth || "./", 0, -1);
    $index = $index ? "index" : "noindex";
    $podpath = join(":", map { s/:/|/g; $_ } @$podpath) if ref($podpath);
    Pod::Html::pod2html(
#        "--quiet",
         "--$index",
         "--htmlroot=$html_root",
         "--podroot=$podroot",
         "--podpath=$podpath",
         "--libpods=EnvVars:PkgArchives:jats",
         "--infile=$infile",
         "--outfile=$outfile",
         "--css=${html_root}/Jats.css",
         "--cachedir=$cacheDir",
     );

    #
    #   Post process the html file
    #       Correct html header
    #       Insert style sheets and script links
    #       Correct Title
    #       Detect unprocessed POD constructs
    #

    open (HTMLFILE, "<$outfile") or die "Couldn't open $outfile: $!";
    open (TMPFILE, ">$outfile.tmp") or die "Couldn't open $outfile.tmp: $!";
    my $first_header = 1;
    my $title;
    while (my $content = <HTMLFILE> ) {
    # Despite what Pod::Html says, this is not XHTML.
    # IE6 doesn't display things correctly with the wrong DOCTYPE.
    $content =~ s#^<!DOCTYPE .*?>#<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">#i;
    $content =~ s#<html xmlns="http://www.w3.org/1999/xhtml">#<html>#i;

    if ($content =~ s/^(\s*)<HEAD>\s*//i) {
        print TMPFILE <<EOT;
$1<head>
$1<script language="JavaScript" src="$html_root/displayToc.js"></script>
$1<script language="JavaScript" src="$html_root/tocParas.js"></script>
$1<script language="JavaScript" src="$html_root/tocTab.js"></script>
$1<link rel="stylesheet" href="$html_root/scineplex.css" type="text/css" />
EOT
    }

    # Join split TITLE lines
    if ($content =~ /<TITLE>/i) {
        until ($content =~ /<\/TITLE>/i) {
        chomp $content;
        $content .= " " . <HTMLFILE>;
        }
    }
    if ($content =~ /<TITLE>(.*?)<\/TITLE>/i) {
        $title = $1;
    }

    if ($index eq "index" && $content =~ /^<p><a name="__index__"><\/a><\/p>$/i) {
        if ($title) {
        $content = <<EOT;
<script>writelinks('__top__',$depth);</script>
<h1><a>$title</a></h1>
$content
EOT
        }
        else {
        warn "DocTools: $outfile has no TITLE\n";
        }
    }

    # Don't duplicate the title if we don't have an index.
    # Instead put the TOC buttons on the first header in the document.
    # This is being used for release notes and changelogs.
    if ($first_header && $index eq "noindex" && $content =~ /^<H\d>/i) {
        $first_header = 0;
        $content = <<EOT;
<script>writelinks('__top__',$depth);</script>
$content
EOT
    }

    #
    #   Bad POD 2 HTML conversion will leave POD directives in the text
    #   Detect these and force an error.
    #
    if ( $content =~ m~^=~ )
    {
        die ("Suspect pod2html conversion. File: $outfile, Line $.\nLine begins with '='\n$content");
    }

    print TMPFILE $content;
    }
    close (TMPFILE) || die "Couldn't write all of $outfile.tmp: $!";
    close (HTMLFILE);
    unlink($outfile);
    rename("$outfile.tmp", $outfile) || die "Couldn't rename $outfile.tmp back to $outfile: $!";
}

sub pod2html_remove_cache_files {
    my ($cacheDir) =@_;
    unlink("pod2htmd.tmp",
           "pod2htmi.tmp",
           "$cacheDir/pod2htmd.tmp",
           "$cacheDir/pod2htmi.tmp");
}

1;

__END__

=head1 NAME

JatsDocTools::Pod - Functions to process POD for ActivePerl

=head1 DESCRIPTION

The following functions are provided:

=over

=item pod2html( %args )

Convert a POD document into an HTML document.  This is a wrapper for
the pod2html() function of C<Pod::Html> that also modify the document
produced with various ActivePerl enhancements.

The following arguments are recognized:

=over

=item infile => $filename

The name of the POD file you want to convert.  This argument is mandatory.

=item outfile => $filename

The name of the HTML file you want as output.  This argument is mandatory.

=item depth => $int

How many directory levels down from the root of the HTML tree will the
generated file eventually be installed.

The default is 0.

=item podroot => $dirname

Specify the base directory for finding library pods.

=item podpath => [$dir1, $dir2,...]

What subdirectories of the C<podroot> should be searched for POD files
in order to discover targets for links from the generated HTML file.
The specified directories must all exist.

The links are generated with the assumption that the discovered POD
files are converted into HTML files with and F<.html> extension and
placed into an hierarchy (the HTML tree rooted at xxx using the same layout as
the one found under C<podroot>.

Instead of passing an array reference, the directories can
alternatively be specified as a single string of directory names
separated by C<:>.

The default is C<< [qw(bin lib)] >>.

=item index => $bool

Should a table on contents be created at the start of the HTML
document.  By default no table of contents is generated.

=back

=item pod2html_remove_cache_files( )

The pod2html() will create cache files with names starting with
F<pod2htm> in the current directory.  These cache files allow pod2html
to save link state between runs.  Call this function to clean up these
cache files.

=back

=head1 SEE ALSO

L<Pod::Html>

=head1 BUGS

none.