| 361 |
dpurdie |
1 |
package JatsDocTools::Pod;
|
|
|
2 |
|
|
|
3 |
use strict;
|
|
|
4 |
use base qw(Exporter);
|
|
|
5 |
our @EXPORT_OK = qw(pod2html pod2html_remove_cache_files);
|
|
|
6 |
|
|
|
7 |
use Carp qw(croak carp);
|
|
|
8 |
|
|
|
9 |
require Pod::Html;
|
|
|
10 |
|
|
|
11 |
my($basename, %expand); # XXX
|
|
|
12 |
|
|
|
13 |
sub pod2html {
|
|
|
14 |
my(%opt) = @_;
|
|
|
15 |
my $infile = delete $opt{infile} || croak("Required infile argument missing");
|
|
|
16 |
my $outfile = delete $opt{outfile} || croak("Required outfile argument missing");
|
|
|
17 |
my $depth = delete $opt{depth} || 0;
|
|
|
18 |
my $podroot = delete $opt{podroot} || croak("Required podroot argument missing");
|
|
|
19 |
my $cacheDir= delete $opt{cacheDir} || croak("Required cacheDir argument missing");
|
|
|
20 |
my $podpath = delete $opt{podpath} || "bin:lib";
|
|
|
21 |
my $index = delete $opt{index} || 0;
|
|
|
22 |
|
|
|
23 |
if (%opt && $^W) {
|
|
|
24 |
carp("Unrecognized option $_ passed to pod2html")
|
|
|
25 |
for sort keys %opt;
|
|
|
26 |
}
|
|
|
27 |
|
|
|
28 |
chmod(0644, $outfile);
|
|
|
29 |
unlink($outfile);
|
|
|
30 |
|
|
|
31 |
my $html_root = substr("../" x $depth || "./", 0, -1);
|
|
|
32 |
$index = $index ? "index" : "noindex";
|
|
|
33 |
$podpath = join(":", map { s/:/|/g; $_ } @$podpath) if ref($podpath);
|
|
|
34 |
Pod::Html::pod2html(
|
|
|
35 |
# "--quiet",
|
|
|
36 |
"--$index",
|
|
|
37 |
"--htmlroot=$html_root",
|
|
|
38 |
"--podroot=$podroot",
|
|
|
39 |
"--podpath=$podpath",
|
|
|
40 |
"--libpods=EnvVars:PkgArchives:jats",
|
|
|
41 |
"--infile=$infile",
|
|
|
42 |
"--outfile=$outfile",
|
|
|
43 |
"--css=${html_root}/Jats.css",
|
|
|
44 |
"--cachedir=$cacheDir",
|
|
|
45 |
);
|
|
|
46 |
|
|
|
47 |
#
|
|
|
48 |
# Post process the html file
|
|
|
49 |
# Correct html header
|
|
|
50 |
# Insert style sheets and script links
|
|
|
51 |
# Correct Title
|
|
|
52 |
# Detect unprocessed POD constructs
|
|
|
53 |
#
|
|
|
54 |
|
|
|
55 |
open (HTMLFILE, "<$outfile") or die "Couldn't open $outfile: $!";
|
|
|
56 |
open (TMPFILE, ">$outfile.tmp") or die "Couldn't open $outfile.tmp: $!";
|
|
|
57 |
my $first_header = 1;
|
|
|
58 |
my $title;
|
|
|
59 |
while (my $content = <HTMLFILE> ) {
|
|
|
60 |
# Despite what Pod::Html says, this is not XHTML.
|
|
|
61 |
# IE6 doesn't display things correctly with the wrong DOCTYPE.
|
|
|
62 |
$content =~ s#^<!DOCTYPE .*?>#<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">#i;
|
|
|
63 |
$content =~ s#<html xmlns="http://www.w3.org/1999/xhtml">#<html>#i;
|
|
|
64 |
|
|
|
65 |
if ($content =~ s/^(\s*)<HEAD>\s*//i) {
|
|
|
66 |
print TMPFILE <<EOT;
|
|
|
67 |
$1<head>
|
|
|
68 |
$1<script language="JavaScript" src="$html_root/displayToc.js"></script>
|
|
|
69 |
$1<script language="JavaScript" src="$html_root/tocParas.js"></script>
|
|
|
70 |
$1<script language="JavaScript" src="$html_root/tocTab.js"></script>
|
|
|
71 |
$1<link rel="stylesheet" href="$html_root/scineplex.css" type="text/css" />
|
|
|
72 |
EOT
|
|
|
73 |
}
|
|
|
74 |
|
|
|
75 |
# Join split TITLE lines
|
|
|
76 |
if ($content =~ /<TITLE>/i) {
|
|
|
77 |
until ($content =~ /<\/TITLE>/i) {
|
|
|
78 |
chomp $content;
|
|
|
79 |
$content .= " " . <HTMLFILE>;
|
|
|
80 |
}
|
|
|
81 |
}
|
|
|
82 |
if ($content =~ /<TITLE>(.*?)<\/TITLE>/i) {
|
|
|
83 |
$title = $1;
|
|
|
84 |
}
|
|
|
85 |
|
|
|
86 |
if ($index eq "index" && $content =~ /^<p><a name="__index__"><\/a><\/p>$/i) {
|
|
|
87 |
if ($title) {
|
|
|
88 |
$content = <<EOT;
|
|
|
89 |
<script>writelinks('__top__',$depth);</script>
|
|
|
90 |
<h1><a>$title</a></h1>
|
|
|
91 |
$content
|
|
|
92 |
EOT
|
|
|
93 |
}
|
|
|
94 |
else {
|
|
|
95 |
warn "DocTools: $outfile has no TITLE\n";
|
|
|
96 |
}
|
|
|
97 |
}
|
|
|
98 |
|
|
|
99 |
# Don't duplicate the title if we don't have an index.
|
|
|
100 |
# Instead put the TOC buttons on the first header in the document.
|
|
|
101 |
# This is being used for release notes and changelogs.
|
|
|
102 |
if ($first_header && $index eq "noindex" && $content =~ /^<H\d>/i) {
|
|
|
103 |
$first_header = 0;
|
|
|
104 |
$content = <<EOT;
|
|
|
105 |
<script>writelinks('__top__',$depth);</script>
|
|
|
106 |
$content
|
|
|
107 |
EOT
|
|
|
108 |
}
|
|
|
109 |
|
|
|
110 |
#
|
|
|
111 |
# Bad POD 2 HTML conversion will leave POD directives in the text
|
|
|
112 |
# Detect these and force an error.
|
|
|
113 |
#
|
|
|
114 |
if ( $content =~ m~^=~ )
|
|
|
115 |
{
|
|
|
116 |
die ("Suspect pod2html conversion. File: $outfile, Line $.\nLine begins with '='\n$content");
|
|
|
117 |
}
|
|
|
118 |
|
|
|
119 |
print TMPFILE $content;
|
|
|
120 |
}
|
|
|
121 |
close (TMPFILE) || die "Couldn't write all of $outfile.tmp: $!";
|
|
|
122 |
close (HTMLFILE);
|
|
|
123 |
unlink($outfile);
|
|
|
124 |
rename("$outfile.tmp", $outfile) || die "Couldn't rename $outfile.tmp back to $outfile: $!";
|
|
|
125 |
}
|
|
|
126 |
|
|
|
127 |
sub pod2html_remove_cache_files {
|
|
|
128 |
my ($cacheDir) =@_;
|
|
|
129 |
unlink("pod2htmd.tmp",
|
|
|
130 |
"pod2htmi.tmp",
|
|
|
131 |
"$cacheDir/pod2htmd.tmp",
|
|
|
132 |
"$cacheDir/pod2htmi.tmp");
|
|
|
133 |
}
|
|
|
134 |
|
|
|
135 |
1;
|
|
|
136 |
|
|
|
137 |
__END__
|
|
|
138 |
|
|
|
139 |
=head1 NAME
|
|
|
140 |
|
|
|
141 |
JatsDocTools::Pod - Functions to process POD for ActivePerl
|
|
|
142 |
|
|
|
143 |
=head1 DESCRIPTION
|
|
|
144 |
|
|
|
145 |
The following functions are provided:
|
|
|
146 |
|
|
|
147 |
=over
|
|
|
148 |
|
|
|
149 |
=item pod2html( %args )
|
|
|
150 |
|
|
|
151 |
Convert a POD document into an HTML document. This is a wrapper for
|
|
|
152 |
the pod2html() function of C<Pod::Html> that also modify the document
|
|
|
153 |
produced with various ActivePerl enhancements.
|
|
|
154 |
|
|
|
155 |
The following arguments are recognized:
|
|
|
156 |
|
|
|
157 |
=over
|
|
|
158 |
|
|
|
159 |
=item infile => $filename
|
|
|
160 |
|
|
|
161 |
The name of the POD file you want to convert. This argument is mandatory.
|
|
|
162 |
|
|
|
163 |
=item outfile => $filename
|
|
|
164 |
|
|
|
165 |
The name of the HTML file you want as output. This argument is mandatory.
|
|
|
166 |
|
|
|
167 |
=item depth => $int
|
|
|
168 |
|
|
|
169 |
How many directory levels down from the root of the HTML tree will the
|
|
|
170 |
generated file eventually be installed.
|
|
|
171 |
|
|
|
172 |
The default is 0.
|
|
|
173 |
|
|
|
174 |
=item podroot => $dirname
|
|
|
175 |
|
|
|
176 |
Specify the base directory for finding library pods.
|
|
|
177 |
|
|
|
178 |
=item podpath => [$dir1, $dir2,...]
|
|
|
179 |
|
|
|
180 |
What subdirectories of the C<podroot> should be searched for POD files
|
|
|
181 |
in order to discover targets for links from the generated HTML file.
|
|
|
182 |
The specified directories must all exist.
|
|
|
183 |
|
|
|
184 |
The links are generated with the assumption that the discovered POD
|
|
|
185 |
files are converted into HTML files with and F<.html> extension and
|
|
|
186 |
placed into an hierarchy (the HTML tree rooted at xxx using the same layout as
|
|
|
187 |
the one found under C<podroot>.
|
|
|
188 |
|
|
|
189 |
Instead of passing an array reference, the directories can
|
|
|
190 |
alternatively be specified as a single string of directory names
|
|
|
191 |
separated by C<:>.
|
|
|
192 |
|
|
|
193 |
The default is C<< [qw(bin lib)] >>.
|
|
|
194 |
|
|
|
195 |
=item index => $bool
|
|
|
196 |
|
|
|
197 |
Should a table on contents be created at the start of the HTML
|
|
|
198 |
document. By default no table of contents is generated.
|
|
|
199 |
|
|
|
200 |
=back
|
|
|
201 |
|
|
|
202 |
=item pod2html_remove_cache_files( )
|
|
|
203 |
|
|
|
204 |
The pod2html() will create cache files with names starting with
|
|
|
205 |
F<pod2htm> in the current directory. These cache files allow pod2html
|
|
|
206 |
to save link state between runs. Call this function to clean up these
|
|
|
207 |
cache files.
|
|
|
208 |
|
|
|
209 |
=back
|
|
|
210 |
|
|
|
211 |
=head1 SEE ALSO
|
|
|
212 |
|
|
|
213 |
L<Pod::Html>
|
|
|
214 |
|
|
|
215 |
=head1 BUGS
|
|
|
216 |
|
|
|
217 |
none.
|