line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Pod::L10N::Html; |
2
|
21
|
|
|
21
|
|
239038
|
use strict; |
|
21
|
|
|
|
|
207
|
|
|
21
|
|
|
|
|
914
|
|
3
|
|
|
|
|
|
|
require Exporter; |
4
|
|
|
|
|
|
|
|
5
|
21
|
|
|
21
|
|
122
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
|
21
|
|
|
|
|
41
|
|
|
21
|
|
|
|
|
2421
|
|
6
|
|
|
|
|
|
|
$VERSION = '1.05'; |
7
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
8
|
|
|
|
|
|
|
@EXPORT = qw(pod2htmll10n htmlify); |
9
|
|
|
|
|
|
|
@EXPORT_OK = qw(anchorify); |
10
|
|
|
|
|
|
|
|
11
|
21
|
|
|
21
|
|
151
|
use Carp; |
|
21
|
|
|
|
|
62
|
|
|
21
|
|
|
|
|
1843
|
|
12
|
21
|
|
|
21
|
|
142
|
use Config; |
|
21
|
|
|
|
|
46
|
|
|
21
|
|
|
|
|
845
|
|
13
|
21
|
|
|
21
|
|
112
|
use Cwd; |
|
21
|
|
|
|
|
35
|
|
|
21
|
|
|
|
|
1323
|
|
14
|
21
|
|
|
21
|
|
138
|
use File::Basename; |
|
21
|
|
|
|
|
41
|
|
|
21
|
|
|
|
|
2891
|
|
15
|
21
|
|
|
21
|
|
145
|
use File::Spec; |
|
21
|
|
|
|
|
72
|
|
|
21
|
|
|
|
|
504
|
|
16
|
21
|
|
|
21
|
|
129
|
use File::Spec::Unix; |
|
21
|
|
|
|
|
40
|
|
|
21
|
|
|
|
|
816
|
|
17
|
21
|
|
|
21
|
|
16396
|
use Getopt::Long; |
|
21
|
|
|
|
|
239438
|
|
|
21
|
|
|
|
|
125
|
|
18
|
21
|
|
|
21
|
|
17310
|
use Pod::Simple::Search; |
|
21
|
|
|
|
|
133938
|
|
|
21
|
|
|
|
|
839
|
|
19
|
|
|
|
|
|
|
|
20
|
21
|
|
|
21
|
|
9720
|
use Pod::L10N::Model; |
|
21
|
|
|
|
|
69
|
|
|
21
|
|
|
|
|
718
|
|
21
|
|
|
|
|
|
|
|
22
|
21
|
|
|
21
|
|
10696
|
use locale; # make \w work right in non-ASCII lands |
|
21
|
|
|
|
|
12835
|
|
|
21
|
|
|
|
|
128
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 NAME |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
Pod::L10N::Html - module to convert pod files to HTML with L10N |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 SYNOPSIS |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
use Pod::L10N::Html; |
31
|
|
|
|
|
|
|
pod2htmll10n([options]); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 DESCRIPTION |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Converts files from pod format (see L) to HTML format. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Its API is fully compatible with L. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
If input files support L extended format, |
40
|
|
|
|
|
|
|
Pod::L10N::Html do some more works to print translated text pretty well. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 ADDITIONAL FEATURES |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Additional features from L 1.2202 are: |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=over |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=item * |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Support L extended format. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=back |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head1 FUNCTIONS |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head2 pod2htmll10n |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
pod2htmll10n("pod2htmll10n", |
59
|
|
|
|
|
|
|
"--podpath=lib:ext:pod:vms", |
60
|
|
|
|
|
|
|
"--podroot=/usr/src/perl", |
61
|
|
|
|
|
|
|
"--htmlroot=/perl/nmanual", |
62
|
|
|
|
|
|
|
"--recurse", |
63
|
|
|
|
|
|
|
"--infile=foo.pod", |
64
|
|
|
|
|
|
|
"--outfile=/perl/nmanual/foo.html"); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
See L for details. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head2 htmlify |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
htmlify($heading); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
See L for details. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head2 anchorify |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
anchorify(@heading); |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
See L for details. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 ENVIRONMENT |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Uses C<$Config{pod2html}> to setup default options. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head1 AUTHOR |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
C is based on L Version 1.2202 written by |
87
|
|
|
|
|
|
|
Marc Green, Emarcgreen@cpan.orgE. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Modification to C is written by SHIRAKATA Kentaro, |
90
|
|
|
|
|
|
|
Eargrath@cpan.orgE. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head1 SEE ALSO |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
L, L, L |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head1 COPYRIGHT |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
This program is distributed under the Artistic License. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=cut |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# " |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
my $Cachedir; |
105
|
|
|
|
|
|
|
my $Dircache; |
106
|
|
|
|
|
|
|
my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl); |
107
|
|
|
|
|
|
|
my($Podfile, @Podpath, $Podroot); |
108
|
|
|
|
|
|
|
my $Poderrors; |
109
|
|
|
|
|
|
|
my $Css; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
my $Recurse; |
112
|
|
|
|
|
|
|
my $Quiet; |
113
|
|
|
|
|
|
|
my $Verbose; |
114
|
|
|
|
|
|
|
my $Doindex; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
my $Backlink; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
my($Title, $Header); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
my %Pages = (); # associative array used to find the location |
121
|
|
|
|
|
|
|
# of pages referenced by L<> links. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
my $Curdir = File::Spec->curdir; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
init_globals(); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub init_globals { |
128
|
49
|
|
|
49
|
0
|
618
|
$Cachedir = "."; # The directory to which directory caches |
129
|
|
|
|
|
|
|
# will be written. |
130
|
|
|
|
|
|
|
|
131
|
49
|
|
|
|
|
328
|
$Dircache = "pod2htmd.tmp"; |
132
|
|
|
|
|
|
|
|
133
|
49
|
|
|
|
|
326
|
$Htmlroot = "/"; # http-server base directory from which all |
134
|
|
|
|
|
|
|
# relative paths in $podpath stem. |
135
|
49
|
|
|
|
|
251
|
$Htmldir = ""; # The directory to which the html pages |
136
|
|
|
|
|
|
|
# will (eventually) be written. |
137
|
49
|
|
|
|
|
302
|
$Htmlfile = ""; # write to stdout by default |
138
|
49
|
|
|
|
|
233
|
$Htmlfileurl = ""; # The url that other files would use to |
139
|
|
|
|
|
|
|
# refer to this file. This is only used |
140
|
|
|
|
|
|
|
# to make relative urls that point to |
141
|
|
|
|
|
|
|
# other files. |
142
|
|
|
|
|
|
|
|
143
|
49
|
|
|
|
|
312
|
$Poderrors = 1; |
144
|
49
|
|
|
|
|
259
|
$Podfile = ""; # read from stdin by default |
145
|
49
|
|
|
|
|
220
|
@Podpath = (); # list of directories containing library pods. |
146
|
49
|
|
|
|
|
207
|
$Podroot = $Curdir; # filesystem base directory from which all |
147
|
|
|
|
|
|
|
# relative paths in $podpath stem. |
148
|
49
|
|
|
|
|
246
|
$Css = ''; # Cascading style sheet |
149
|
49
|
|
|
|
|
111
|
$Recurse = 1; # recurse on subdirectories in $podpath. |
150
|
49
|
|
|
|
|
107
|
$Quiet = 0; # not quiet by default |
151
|
49
|
|
|
|
|
94
|
$Verbose = 0; # not verbose by default |
152
|
49
|
|
|
|
|
88
|
$Doindex = 1; # non-zero if we should generate an index |
153
|
49
|
|
|
|
|
111
|
$Backlink = 0; # no backlinks added by default |
154
|
49
|
|
|
|
|
84
|
$Header = 0; # produce block header/footer |
155
|
49
|
|
|
|
|
197
|
$Title = ''; # title to give the pod(s) |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub pod2htmll10n { |
159
|
28
|
|
|
28
|
1
|
9193
|
local(@ARGV) = @_; |
160
|
28
|
|
|
|
|
249
|
local $_; |
161
|
|
|
|
|
|
|
|
162
|
28
|
|
|
|
|
256
|
init_globals(); |
163
|
28
|
|
|
|
|
314
|
parse_command_line(); |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# prevent '//' in urls |
166
|
28
|
100
|
|
|
|
128
|
$Htmlroot = "" if $Htmlroot eq "/"; |
167
|
28
|
|
|
|
|
293
|
$Htmldir =~ s#/\z##; |
168
|
|
|
|
|
|
|
|
169
|
28
|
100
|
66
|
|
|
558
|
if ( $Htmlroot eq '' |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
170
|
|
|
|
|
|
|
&& defined( $Htmldir ) |
171
|
|
|
|
|
|
|
&& $Htmldir ne '' |
172
|
|
|
|
|
|
|
&& substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir |
173
|
|
|
|
|
|
|
) { |
174
|
|
|
|
|
|
|
# Set the 'base' url for this file, so that we can use it |
175
|
|
|
|
|
|
|
# as the location from which to calculate relative links |
176
|
|
|
|
|
|
|
# to other files. If this is '', then absolute links will |
177
|
|
|
|
|
|
|
# be used throughout. |
178
|
|
|
|
|
|
|
#$Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1); |
179
|
|
|
|
|
|
|
# Is the above not just "$Htmlfileurl = $Htmlfile"? |
180
|
10
|
|
|
|
|
42
|
$Htmlfileurl = Pod::L10N::Html::_unixify($Htmlfile); |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# load or generate/cache %Pages |
185
|
28
|
100
|
|
|
|
267
|
unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) { |
186
|
|
|
|
|
|
|
# generate %Pages |
187
|
25
|
|
|
|
|
357
|
my $pwd = getcwd(); |
188
|
25
|
50
|
|
|
|
523
|
chdir($Podroot) || |
189
|
|
|
|
|
|
|
die "$0: error changing to directory $Podroot: $!\n"; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# find all pod modules/pages in podpath, store in %Pages |
192
|
|
|
|
|
|
|
# - callback used to remove Podroot and extension from each file |
193
|
|
|
|
|
|
|
# - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1) |
194
|
25
|
|
|
|
|
1056
|
Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1) |
195
|
|
|
|
|
|
|
->callback(\&_save_page)->recurse($Recurse)->survey(@Podpath); |
196
|
|
|
|
|
|
|
|
197
|
25
|
50
|
|
|
|
25426
|
chdir($pwd) || die "$0: error changing to directory $pwd: $!\n"; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# cache the directory list for later use |
200
|
25
|
100
|
|
|
|
247
|
warn "caching directories for later use\n" if $Verbose; |
201
|
25
|
50
|
|
|
|
3316
|
open my $cache, '>', $Dircache |
202
|
|
|
|
|
|
|
or die "$0: error open $Dircache for writing: $!\n"; |
203
|
|
|
|
|
|
|
|
204
|
25
|
|
|
|
|
1137
|
print $cache join(":", @Podpath) . "\n$Podroot\n"; |
205
|
25
|
|
33
|
|
|
714
|
my $_updirs_only = ($Podroot =~ /\.\./) && !($Podroot =~ /[^\.\\\/]/); |
206
|
25
|
|
|
|
|
361
|
foreach my $key (keys %Pages) { |
207
|
492
|
50
|
|
|
|
831
|
if($_updirs_only) { |
208
|
0
|
|
|
|
|
0
|
my $_dirlevel = $Podroot; |
209
|
0
|
|
|
|
|
0
|
while($_dirlevel =~ /\.\./) { |
210
|
0
|
|
|
|
|
0
|
$_dirlevel =~ s/\.\.//; |
211
|
|
|
|
|
|
|
# Assume $Pages{$key} has '/' separators (html dir separators). |
212
|
0
|
|
|
|
|
0
|
$Pages{$key} =~ s/^[\w\s\-\.]+\///; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
} |
215
|
492
|
|
|
|
|
968
|
print $cache "$key $Pages{$key}\n"; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
25
|
50
|
|
|
|
1517
|
close $cache or die "error closing $Dircache: $!"; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# set options for the parser |
222
|
28
|
|
|
|
|
2136
|
my $parser = Pod::L10N::Html::LocalPodLinks->new(); |
223
|
28
|
|
|
|
|
12163
|
$parser->codes_in_verbatim(0); |
224
|
28
|
|
|
|
|
713
|
$parser->anchor_items(1); # the old Pod::Html always did |
225
|
28
|
|
|
|
|
444
|
$parser->backlink($Backlink); # linkify =head1 directives |
226
|
28
|
|
|
|
|
482
|
$parser->htmldir($Htmldir); |
227
|
28
|
|
|
|
|
435
|
$parser->htmlfileurl($Htmlfileurl); |
228
|
28
|
|
|
|
|
466
|
$parser->htmlroot($Htmlroot); |
229
|
28
|
|
|
|
|
724
|
$parser->index($Doindex); |
230
|
28
|
|
|
|
|
925
|
$parser->no_errata_section(!$Poderrors); # note the inverse |
231
|
28
|
|
|
|
|
621
|
$parser->output_string(\my $output); # written to file later |
232
|
28
|
|
|
|
|
63119
|
$parser->pages(\%Pages); |
233
|
28
|
|
|
|
|
537
|
$parser->quiet($Quiet); |
234
|
28
|
|
|
|
|
297
|
$parser->verbose($Verbose); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
# $parser->html_charset('UTF-8'); |
237
|
28
|
|
|
|
|
460
|
$parser->html_encode_chars('&<>">'); |
238
|
|
|
|
|
|
|
# $parser->html_header_tags(''); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
# XXX: implement default title generator in pod::simple::xhtml |
241
|
|
|
|
|
|
|
# copy the way the old Pod::Html did it |
242
|
28
|
|
|
|
|
333
|
$Title = html_escape($Title); |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# We need to add this ourselves because we use our own header, not |
245
|
|
|
|
|
|
|
# ::XHTML's header. We need to set $parser->backlink to linkify |
246
|
|
|
|
|
|
|
# the =head1 directives |
247
|
28
|
100
|
|
|
|
168
|
my $bodyid = $Backlink ? ' id="_podtop_"' : ''; |
248
|
|
|
|
|
|
|
|
249
|
28
|
|
|
|
|
78
|
my $csslink = ''; |
250
|
28
|
|
|
|
|
57
|
my $tdstyle = ' style="background-color: #cccccc; color: #000"'; |
251
|
|
|
|
|
|
|
|
252
|
28
|
100
|
|
|
|
113
|
if ($Css) { |
253
|
4
|
|
|
|
|
19
|
$csslink = qq(\n); |
254
|
4
|
|
|
|
|
12
|
$csslink =~ s,\\,/,g; |
255
|
4
|
|
|
|
|
34
|
$csslink =~ s,(/.):,$1|,; |
256
|
4
|
|
|
|
|
11
|
$tdstyle= ''; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
28
|
|
|
|
|
56
|
my $input; |
260
|
28
|
50
|
33
|
|
|
151
|
unless (@ARGV && $ARGV[0]) { |
261
|
28
|
50
|
33
|
|
|
366
|
if ($Podfile and $Podfile ne '-') { |
262
|
28
|
|
|
|
|
97
|
$input = $Podfile; |
263
|
|
|
|
|
|
|
} else { |
264
|
0
|
|
|
|
|
0
|
$input = '-'; # XXX: make a test case for this |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
} else { |
267
|
0
|
|
|
|
|
0
|
$Podfile = $ARGV[0]; |
268
|
0
|
|
|
|
|
0
|
$input = *ARGV; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
28
|
|
|
|
|
158
|
my ($content, $encoding) = arrange($Podfile); |
272
|
28
|
100
|
|
|
|
124
|
if(!defined $encoding){ |
273
|
25
|
|
|
|
|
66
|
$encoding = 'utf-8'; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# header/footer block |
277
|
28
|
100
|
|
|
|
147
|
my $block = $Header ? <
|
278
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
END_OF_BLOCK |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# create own header/footer because of --header |
286
|
28
|
|
|
|
|
3583
|
$parser->html_header(<<"HTMLHEAD"); |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
$Title$csslink |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
$block |
298
|
|
|
|
|
|
|
HTMLHEAD |
299
|
|
|
|
|
|
|
|
300
|
28
|
|
|
|
|
510
|
$parser->html_footer(<<"HTMLFOOT"); |
301
|
|
|
|
|
|
|
$block |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
HTMLFOOT |
306
|
|
|
|
|
|
|
|
307
|
28
|
100
|
|
|
|
237
|
warn "Converting input file $Podfile\n" if $Verbose; |
308
|
|
|
|
|
|
|
# $parser->parse_file($input); |
309
|
28
|
|
|
|
|
514
|
$parser->parse_string_document($content); |
310
|
|
|
|
|
|
|
# $parser->html_charset($parser->encoding()); |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
# Write output to file |
313
|
28
|
50
|
|
|
|
25758
|
$Htmlfile = "-" unless $Htmlfile; # stdout |
314
|
28
|
|
|
|
|
99
|
my $fhout; |
315
|
28
|
50
|
33
|
|
|
391
|
if($Htmlfile and $Htmlfile ne '-') { |
316
|
28
|
50
|
|
|
|
3053
|
open $fhout, ">", $Htmlfile |
317
|
|
|
|
|
|
|
or die "$0: cannot open $Htmlfile file for output: $!\n"; |
318
|
|
|
|
|
|
|
} else { |
319
|
0
|
|
|
|
|
0
|
open $fhout, ">-"; |
320
|
|
|
|
|
|
|
} |
321
|
28
|
|
|
20
|
|
1679
|
binmode $fhout, ":encoding($encoding)"; |
|
20
|
|
|
|
|
399
|
|
|
20
|
|
|
|
|
64
|
|
|
20
|
|
|
|
|
414
|
|
322
|
28
|
|
|
|
|
234743
|
print $fhout $output; |
323
|
28
|
50
|
|
|
|
1593
|
close $fhout or die "Failed to close $Htmlfile: $!"; |
324
|
28
|
50
|
|
|
|
2295
|
chmod 0644, $Htmlfile unless $Htmlfile eq '-'; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
############################################################################## |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
sub usage { |
330
|
0
|
|
|
0
|
0
|
0
|
my $podfile = shift; |
331
|
0
|
0
|
|
|
|
0
|
warn "$0: $podfile: @_\n" if @_; |
332
|
0
|
|
|
|
|
0
|
die <
|
333
|
|
|
|
|
|
|
Usage: $0 --help --htmldir= --htmlroot= |
334
|
|
|
|
|
|
|
--infile= --outfile= |
335
|
|
|
|
|
|
|
--podpath=:...: --podroot= |
336
|
|
|
|
|
|
|
--cachedir= --flush --recurse --norecurse |
337
|
|
|
|
|
|
|
--quiet --noquiet --verbose --noverbose |
338
|
|
|
|
|
|
|
--index --noindex --backlink --nobacklink |
339
|
|
|
|
|
|
|
--header --noheader --poderrors --nopoderrors |
340
|
|
|
|
|
|
|
--css= --title= |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
--[no]backlink - turn =head1 directives into links pointing to the top of |
343
|
|
|
|
|
|
|
the page (off by default). |
344
|
|
|
|
|
|
|
--cachedir - directory for the directory cache files. |
345
|
|
|
|
|
|
|
--css - stylesheet URL |
346
|
|
|
|
|
|
|
--flush - flushes the directory cache. |
347
|
|
|
|
|
|
|
--[no]header - produce block header/footer (default is no headers). |
348
|
|
|
|
|
|
|
--help - prints this message. |
349
|
|
|
|
|
|
|
--htmldir - directory for resulting HTML files. |
350
|
|
|
|
|
|
|
--htmlroot - http-server base directory from which all relative paths |
351
|
|
|
|
|
|
|
in podpath stem (default is /). |
352
|
|
|
|
|
|
|
--[no]index - generate an index at the top of the resulting html |
353
|
|
|
|
|
|
|
(default behaviour). |
354
|
|
|
|
|
|
|
--infile - filename for the pod to convert (input taken from stdin |
355
|
|
|
|
|
|
|
by default). |
356
|
|
|
|
|
|
|
--outfile - filename for the resulting html file (output sent to |
357
|
|
|
|
|
|
|
stdout by default). |
358
|
|
|
|
|
|
|
--[no]poderrors - include a POD ERRORS section in the output if there were |
359
|
|
|
|
|
|
|
any POD errors in the input (default behavior). |
360
|
|
|
|
|
|
|
--podpath - colon-separated list of directories containing library |
361
|
|
|
|
|
|
|
pods (empty by default). |
362
|
|
|
|
|
|
|
--podroot - filesystem base directory from which all relative paths |
363
|
|
|
|
|
|
|
in podpath stem (default is .). |
364
|
|
|
|
|
|
|
--[no]quiet - suppress some benign warning messages (default is off). |
365
|
|
|
|
|
|
|
--[no]recurse - recurse on those subdirectories listed in podpath |
366
|
|
|
|
|
|
|
(default behaviour). |
367
|
|
|
|
|
|
|
--title - title that will appear in resulting html file. |
368
|
|
|
|
|
|
|
--[no]verbose - self-explanatory (off by default). |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
END_OF_USAGE |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
sub parse_command_line { |
375
|
28
|
|
|
28
|
0
|
205
|
my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header, |
376
|
|
|
|
|
|
|
$opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile, |
377
|
|
|
|
|
|
|
$opt_outfile,$opt_poderrors,$opt_podpath,$opt_podroot, |
378
|
|
|
|
|
|
|
$opt_quiet,$opt_recurse,$opt_title,$opt_verbose); |
379
|
|
|
|
|
|
|
|
380
|
28
|
50
|
|
|
|
4733
|
unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; |
381
|
28
|
|
|
|
|
790
|
my $result = GetOptions( |
382
|
|
|
|
|
|
|
'backlink!' => \$opt_backlink, |
383
|
|
|
|
|
|
|
'cachedir=s' => \$opt_cachedir, |
384
|
|
|
|
|
|
|
'css=s' => \$opt_css, |
385
|
|
|
|
|
|
|
'flush' => \$opt_flush, |
386
|
|
|
|
|
|
|
'help' => \$opt_help, |
387
|
|
|
|
|
|
|
'header!' => \$opt_header, |
388
|
|
|
|
|
|
|
'htmldir=s' => \$opt_htmldir, |
389
|
|
|
|
|
|
|
'htmlroot=s' => \$opt_htmlroot, |
390
|
|
|
|
|
|
|
'index!' => \$opt_index, |
391
|
|
|
|
|
|
|
'infile=s' => \$opt_infile, |
392
|
|
|
|
|
|
|
'outfile=s' => \$opt_outfile, |
393
|
|
|
|
|
|
|
'poderrors!' => \$opt_poderrors, |
394
|
|
|
|
|
|
|
'podpath=s' => \$opt_podpath, |
395
|
|
|
|
|
|
|
'podroot=s' => \$opt_podroot, |
396
|
|
|
|
|
|
|
'quiet!' => \$opt_quiet, |
397
|
|
|
|
|
|
|
'recurse!' => \$opt_recurse, |
398
|
|
|
|
|
|
|
'title=s' => \$opt_title, |
399
|
|
|
|
|
|
|
'verbose!' => \$opt_verbose, |
400
|
|
|
|
|
|
|
); |
401
|
28
|
50
|
|
|
|
76684
|
usage("-", "invalid parameters") if not $result; |
402
|
|
|
|
|
|
|
|
403
|
28
|
50
|
|
|
|
148
|
usage("-") if defined $opt_help; # see if the user asked for help |
404
|
28
|
|
|
|
|
135
|
$opt_help = ""; # just to make -w shut-up. |
405
|
|
|
|
|
|
|
|
406
|
28
|
100
|
|
|
|
256
|
@Podpath = split(":", $opt_podpath) if defined $opt_podpath; |
407
|
|
|
|
|
|
|
|
408
|
28
|
100
|
|
|
|
135
|
$Backlink = $opt_backlink if defined $opt_backlink; |
409
|
28
|
100
|
|
|
|
123
|
$Cachedir = _unixify($opt_cachedir) if defined $opt_cachedir; |
410
|
28
|
100
|
|
|
|
115
|
$Css = $opt_css if defined $opt_css; |
411
|
28
|
100
|
|
|
|
122
|
$Header = $opt_header if defined $opt_header; |
412
|
28
|
100
|
|
|
|
136
|
$Htmldir = _unixify($opt_htmldir) if defined $opt_htmldir; |
413
|
28
|
100
|
|
|
|
177
|
$Htmlroot = _unixify($opt_htmlroot) if defined $opt_htmlroot; |
414
|
28
|
100
|
|
|
|
143
|
$Doindex = $opt_index if defined $opt_index; |
415
|
28
|
50
|
|
|
|
150
|
$Podfile = _unixify($opt_infile) if defined $opt_infile; |
416
|
28
|
50
|
|
|
|
188
|
$Htmlfile = _unixify($opt_outfile) if defined $opt_outfile; |
417
|
28
|
100
|
|
|
|
124
|
$Poderrors = $opt_poderrors if defined $opt_poderrors; |
418
|
28
|
100
|
|
|
|
258
|
$Podroot = _unixify($opt_podroot) if defined $opt_podroot; |
419
|
28
|
100
|
|
|
|
129
|
$Quiet = $opt_quiet if defined $opt_quiet; |
420
|
28
|
100
|
|
|
|
107
|
$Recurse = $opt_recurse if defined $opt_recurse; |
421
|
28
|
100
|
|
|
|
103
|
$Title = $opt_title if defined $opt_title; |
422
|
28
|
100
|
|
|
|
120
|
$Verbose = $opt_verbose if defined $opt_verbose; |
423
|
|
|
|
|
|
|
|
424
|
28
|
50
|
66
|
|
|
109
|
warn "Flushing directory caches\n" |
425
|
|
|
|
|
|
|
if $opt_verbose && defined $opt_flush; |
426
|
28
|
|
|
|
|
93
|
$Dircache = "$Cachedir/pod2htmd.tmp"; |
427
|
28
|
50
|
|
|
|
145
|
if (defined $opt_flush) { |
428
|
0
|
|
|
|
|
0
|
1 while unlink($Dircache); |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
my $Saved_Cache_Key; |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
sub get_cache { |
435
|
28
|
|
|
28
|
0
|
169
|
my($dircache, $podpath, $podroot, $recurse) = @_; |
436
|
28
|
|
|
|
|
129
|
my @cache_key_args = @_; |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
# A first-level cache: |
439
|
|
|
|
|
|
|
# Don't bother reading the cache files if they still apply |
440
|
|
|
|
|
|
|
# and haven't changed since we last read them. |
441
|
|
|
|
|
|
|
|
442
|
28
|
|
|
|
|
139
|
my $this_cache_key = cache_key(@cache_key_args); |
443
|
28
|
100
|
100
|
|
|
241
|
return 1 if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key; |
444
|
26
|
|
|
|
|
65
|
$Saved_Cache_Key = $this_cache_key; |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# load the cache of %Pages if possible. $tests will be |
447
|
|
|
|
|
|
|
# non-zero if successful. |
448
|
26
|
|
|
|
|
72
|
my $tests = 0; |
449
|
26
|
100
|
|
|
|
293
|
if (-f $dircache) { |
450
|
1
|
50
|
|
|
|
5
|
warn "scanning for directory cache\n" if $Verbose; |
451
|
1
|
|
|
|
|
6
|
$tests = load_cache($dircache, $podpath, $podroot); |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
26
|
|
|
|
|
154
|
return $tests; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
sub cache_key { |
458
|
28
|
|
|
28
|
0
|
146
|
my($dircache, $podpath, $podroot, $recurse) = @_; |
459
|
28
|
|
|
|
|
667
|
return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache)); |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# |
463
|
|
|
|
|
|
|
# load_cache - tries to find if the cache stored in $dircache is a valid |
464
|
|
|
|
|
|
|
# cache of %Pages. if so, it loads them and returns a non-zero value. |
465
|
|
|
|
|
|
|
# |
466
|
|
|
|
|
|
|
sub load_cache { |
467
|
1
|
|
|
1
|
0
|
4
|
my($dircache, $podpath, $podroot) = @_; |
468
|
1
|
|
|
|
|
2
|
my $tests = 0; |
469
|
1
|
|
|
|
|
2
|
local $_; |
470
|
|
|
|
|
|
|
|
471
|
1
|
50
|
|
|
|
4
|
warn "scanning for directory cache\n" if $Verbose; |
472
|
1
|
50
|
|
|
|
39
|
open(my $cachefh, '<', $dircache) || |
473
|
|
|
|
|
|
|
die "$0: error opening $dircache for reading: $!\n"; |
474
|
1
|
|
|
|
|
5
|
$/ = "\n"; |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
# is it the same podpath? |
477
|
1
|
|
|
|
|
17
|
$_ = <$cachefh>; |
478
|
1
|
|
|
|
|
4
|
chomp($_); |
479
|
1
|
50
|
|
|
|
5
|
$tests++ if (join(":", @$podpath) eq $_); |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
# is it the same podroot? |
482
|
1
|
|
|
|
|
3
|
$_ = <$cachefh>; |
483
|
1
|
|
|
|
|
2
|
chomp($_); |
484
|
1
|
50
|
|
|
|
4
|
$tests++ if ($podroot eq $_); |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# load the cache if its good |
487
|
1
|
50
|
|
|
|
3
|
if ($tests != 2) { |
488
|
0
|
|
|
|
|
0
|
close($cachefh); |
489
|
0
|
|
|
|
|
0
|
return 0; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
1
|
50
|
|
|
|
4
|
warn "loading directory cache\n" if $Verbose; |
493
|
1
|
|
|
|
|
11
|
while (<$cachefh>) { |
494
|
0
|
|
|
|
|
0
|
/(.*?) (.*)$/; |
495
|
0
|
|
|
|
|
0
|
$Pages{$1} = $2; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
1
|
|
|
|
|
19
|
close($cachefh); |
499
|
1
|
|
|
|
|
7
|
return 1; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
# |
504
|
|
|
|
|
|
|
# html_escape: make text safe for HTML |
505
|
|
|
|
|
|
|
# |
506
|
|
|
|
|
|
|
sub html_escape { |
507
|
28
|
|
|
28
|
0
|
194
|
my $rest = $_[0]; |
508
|
28
|
|
|
|
|
116
|
$rest =~ s/&/&/g; |
509
|
28
|
|
|
|
|
67
|
$rest =~ s/</g; |
510
|
28
|
|
|
|
|
57
|
$rest =~ s/>/>/g; |
511
|
28
|
|
|
|
|
91
|
$rest =~ s/"/"/g; |
512
|
|
|
|
|
|
|
# ' is only in XHTML, not HTML4. Be conservative |
513
|
|
|
|
|
|
|
#$rest =~ s/'/'/g; |
514
|
28
|
|
|
|
|
157
|
return $rest; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
# " |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
# |
520
|
|
|
|
|
|
|
# htmlify - converts a pod section specification to a suitable section |
521
|
|
|
|
|
|
|
# specification for HTML. Note that we keep spaces and special characters |
522
|
|
|
|
|
|
|
# except ", ? (Netscape problem) and the hyphen (writer's problem...). |
523
|
|
|
|
|
|
|
# |
524
|
|
|
|
|
|
|
sub htmlify { |
525
|
0
|
|
|
0
|
1
|
0
|
my( $heading) = @_; |
526
|
0
|
|
|
|
|
0
|
$heading =~ s/(\s+)/ /g; |
527
|
0
|
|
|
|
|
0
|
$heading =~ s/\s+\Z//; |
528
|
0
|
|
|
|
|
0
|
$heading =~ s/\A\s+//; |
529
|
|
|
|
|
|
|
# The hyphen is a disgrace to the English language. |
530
|
|
|
|
|
|
|
# $heading =~ s/[-"?]//g; |
531
|
0
|
|
|
|
|
0
|
$heading =~ s/["?]//g; |
532
|
0
|
|
|
|
|
0
|
$heading = lc( $heading ); |
533
|
0
|
|
|
|
|
0
|
return $heading; |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
# " |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
# |
539
|
|
|
|
|
|
|
# similar to htmlify, but turns non-alphanumerics into underscores |
540
|
|
|
|
|
|
|
# |
541
|
|
|
|
|
|
|
sub anchorify { |
542
|
0
|
|
|
0
|
1
|
0
|
my ($anchor) = @_; |
543
|
0
|
|
|
|
|
0
|
$anchor = htmlify($anchor); |
544
|
0
|
|
|
|
|
0
|
$anchor =~ s/\W/_/g; |
545
|
0
|
|
|
|
|
0
|
return $anchor; |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
# |
549
|
|
|
|
|
|
|
# store POD files in %Pages |
550
|
|
|
|
|
|
|
# |
551
|
|
|
|
|
|
|
sub _save_page { |
552
|
444
|
|
|
444
|
|
386496
|
my ($modspec, $modname) = @_; |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
# Remove Podroot from path |
555
|
444
|
100
|
|
|
|
26932
|
$modspec = $Podroot eq File::Spec->curdir |
556
|
|
|
|
|
|
|
? File::Spec->abs2rel($modspec) |
557
|
|
|
|
|
|
|
: File::Spec->abs2rel($modspec, |
558
|
|
|
|
|
|
|
File::Spec->canonpath($Podroot)); |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
# Convert path to unix style path |
561
|
444
|
|
|
|
|
1875
|
$modspec = Pod::L10N::Html::_unixify($modspec); |
562
|
|
|
|
|
|
|
|
563
|
444
|
|
|
|
|
12445
|
my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext |
564
|
444
|
|
|
|
|
2901
|
$Pages{$modname} = $dir.$file; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub _unixify { |
568
|
669
|
|
|
669
|
|
142260
|
my $full_path = shift; |
569
|
669
|
100
|
|
|
|
2589
|
return '' unless $full_path; |
570
|
624
|
100
|
|
|
|
1665
|
return $full_path if $full_path eq '/'; |
571
|
|
|
|
|
|
|
|
572
|
597
|
|
|
|
|
9535
|
my ($vol, $dirs, $file) = File::Spec->splitpath($full_path); |
573
|
597
|
50
|
|
|
|
5082
|
my @dirs = $dirs eq File::Spec->curdir() |
574
|
|
|
|
|
|
|
? (File::Spec::Unix->curdir()) |
575
|
|
|
|
|
|
|
: File::Spec->splitdir($dirs); |
576
|
597
|
50
|
33
|
|
|
3424
|
if (defined($vol) && $vol) { |
577
|
0
|
0
|
|
|
|
0
|
$vol =~ s/:$// if $^O eq 'VMS'; |
578
|
0
|
0
|
|
|
|
0
|
$vol = uc $vol if $^O eq 'MSWin32'; |
579
|
|
|
|
|
|
|
|
580
|
0
|
0
|
|
|
|
0
|
if( $dirs[0] ) { |
581
|
0
|
|
|
|
|
0
|
unshift @dirs, $vol; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
else { |
584
|
0
|
|
|
|
|
0
|
$dirs[0] = $vol; |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
} |
587
|
597
|
100
|
|
|
|
3438
|
unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path); |
588
|
597
|
100
|
|
|
|
1761
|
return $file unless scalar(@dirs); |
589
|
577
|
|
|
|
|
4213
|
$full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs), |
590
|
|
|
|
|
|
|
$file); |
591
|
577
|
50
|
|
|
|
2585
|
$full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't |
592
|
577
|
50
|
|
|
|
1313
|
$full_path =~ s/\^\././g if $^O eq 'VMS'; # unescape dots |
593
|
577
|
|
|
|
|
1729
|
return $full_path; |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
sub arrange { |
597
|
28
|
|
|
28
|
0
|
77
|
my $fn = shift; |
598
|
28
|
|
|
|
|
115
|
my $base; |
599
|
|
|
|
|
|
|
my $ret; |
600
|
28
|
|
|
|
|
0
|
my $encoding; |
601
|
|
|
|
|
|
|
|
602
|
28
|
|
|
|
|
211
|
$base = Pod::L10N::Model::decode_file($fn); |
603
|
|
|
|
|
|
|
|
604
|
28
|
|
|
|
|
108
|
for (@$base){ |
605
|
354
|
|
|
|
|
588
|
my($o, $t) = @$_; |
606
|
354
|
100
|
|
|
|
901
|
if($o =~ /^=encoding (.+)/){ |
607
|
3
|
|
|
|
|
15
|
$encoding = $1; |
608
|
3
|
|
|
|
|
12
|
$ret .= $o . "\n\n"; |
609
|
3
|
|
|
|
|
9
|
next; |
610
|
|
|
|
|
|
|
} |
611
|
351
|
100
|
|
|
|
804
|
if($o =~ /^=/){ |
612
|
141
|
100
|
|
|
|
288
|
if(defined $t){ |
613
|
4
|
|
|
|
|
32
|
$t =~ /\((.+)\)/; |
614
|
4
|
|
|
|
|
23
|
$ret .= $o . '@@@@@@@@@@' . $1; |
615
|
|
|
|
|
|
|
} else { |
616
|
137
|
|
|
|
|
222
|
$ret .= $o; |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
} else { |
619
|
210
|
50
|
|
|
|
348
|
if(defined $t){ |
620
|
0
|
|
|
|
|
0
|
$ret .= $t; |
621
|
|
|
|
|
|
|
} else { |
622
|
210
|
|
|
|
|
304
|
$ret .= $o; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
} |
625
|
351
|
|
|
|
|
536
|
$ret .= "\n\n"; |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
|
628
|
28
|
|
|
|
|
178
|
return ($ret, $encoding); |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
package Pod::L10N::Html::LocalPodLinks; |
632
|
21
|
|
|
21
|
|
105191
|
use strict; |
|
21
|
|
|
|
|
49
|
|
|
21
|
|
|
|
|
709
|
|
633
|
21
|
|
|
21
|
|
126
|
use warnings; |
|
21
|
|
|
|
|
39
|
|
|
21
|
|
|
|
|
970
|
|
634
|
21
|
|
|
21
|
|
11308
|
use parent 'Pod::Simple::XHTML'; |
|
21
|
|
|
|
|
6697
|
|
|
21
|
|
|
|
|
121
|
|
635
|
|
|
|
|
|
|
|
636
|
21
|
|
|
21
|
|
930184
|
use File::Spec; |
|
21
|
|
|
|
|
54
|
|
|
21
|
|
|
|
|
588
|
|
637
|
21
|
|
|
21
|
|
123
|
use File::Spec::Unix; |
|
21
|
|
|
|
|
47
|
|
|
21
|
|
|
|
|
30019
|
|
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
__PACKAGE__->_accessorize( |
640
|
|
|
|
|
|
|
'htmldir', |
641
|
|
|
|
|
|
|
'htmlfileurl', |
642
|
|
|
|
|
|
|
'htmlroot', |
643
|
|
|
|
|
|
|
'pages', # Page name => relative/path/to/page from root POD dir |
644
|
|
|
|
|
|
|
'quiet', |
645
|
|
|
|
|
|
|
'verbose', |
646
|
|
|
|
|
|
|
); |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
sub idify { |
650
|
159
|
|
|
159
|
|
379
|
my ($self, $t, $not_unique) = @_; |
651
|
159
|
|
|
|
|
355
|
for ($t) { |
652
|
159
|
|
|
|
|
629
|
s/<[^>]+>//g; # Strip HTML. |
653
|
159
|
|
|
|
|
1383
|
s/&[^;]+;//g; # Strip entities. |
654
|
159
|
|
|
|
|
1422
|
s/^\s+//; s/\s+$//; # Strip white space. |
|
159
|
|
|
|
|
1349
|
|
655
|
159
|
|
|
|
|
1443
|
s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars. |
656
|
159
|
|
|
|
|
1338
|
s/^[^a-zA-Z]+//; # First char must be a letter. |
657
|
159
|
|
|
|
|
1227
|
s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid. |
658
|
159
|
|
|
|
|
2124
|
s/[-:.]+$//; # Strip trailing punctuation. |
659
|
|
|
|
|
|
|
} |
660
|
159
|
100
|
|
|
|
878
|
return $t if $not_unique; |
661
|
83
|
|
|
|
|
252
|
my $i = ''; |
662
|
83
|
|
|
|
|
590
|
$i++ while $self->{ids}{"$t$i"}++; |
663
|
83
|
|
|
|
|
285
|
return "$t$i"; |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
sub resolve_pod_page_link { |
667
|
118
|
|
|
118
|
|
106183
|
my ($self, $to, $section) = @_; |
668
|
|
|
|
|
|
|
|
669
|
118
|
50
|
66
|
|
|
698
|
return undef unless defined $to || defined $section; |
670
|
118
|
100
|
|
|
|
246
|
if (defined $section) { |
671
|
76
|
|
|
|
|
198
|
$section = '#' . $self->idify($section, 1); |
672
|
76
|
100
|
|
|
|
596
|
return $section unless defined $to; |
673
|
|
|
|
|
|
|
} else { |
674
|
42
|
|
|
|
|
118
|
$section = ''; |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
|
677
|
71
|
|
|
|
|
131
|
my $path; # path to $to according to %Pages |
678
|
71
|
100
|
|
|
|
215
|
unless (exists $self->pages->{$to}) { |
679
|
|
|
|
|
|
|
# Try to find a POD that ends with $to and use that. |
680
|
|
|
|
|
|
|
# e.g., given L, if there is no $Podpath/XHTML in %Pages, |
681
|
|
|
|
|
|
|
# look for $Podpath/*/XHTML in %Pages, with * being any path, |
682
|
|
|
|
|
|
|
# as a substitute (e.g., $Podpath/Pod/Simple/XHTML) |
683
|
27
|
|
|
|
|
600
|
my @matches; |
684
|
27
|
|
|
|
|
44
|
foreach my $modname (keys %{$self->pages}) { |
|
27
|
|
|
|
|
75
|
|
685
|
627
|
100
|
|
|
|
9979
|
push @matches, $modname if $modname =~ /::\Q$to\E\z/; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
27
|
100
|
|
|
|
458
|
if ($#matches == -1) { |
|
|
50
|
|
|
|
|
|
689
|
22
|
50
|
|
|
|
100
|
warn "Cannot find \"$to\" in podpath: " . |
690
|
|
|
|
|
|
|
"cannot find suitable replacement path, cannot resolve link\n" |
691
|
|
|
|
|
|
|
unless $self->quiet; |
692
|
22
|
|
|
|
|
264
|
return ''; |
693
|
|
|
|
|
|
|
} elsif ($#matches == 0) { |
694
|
5
|
50
|
|
|
|
15
|
warn "Cannot find \"$to\" in podpath: " . |
695
|
|
|
|
|
|
|
"using $matches[0] as replacement path to $to\n" |
696
|
|
|
|
|
|
|
unless $self->quiet; |
697
|
5
|
|
|
|
|
39
|
$path = $self->pages->{$matches[0]}; |
698
|
|
|
|
|
|
|
} else { |
699
|
0
|
0
|
|
|
|
0
|
warn "Cannot find \"$to\" in podpath: " . |
700
|
|
|
|
|
|
|
"more than one possible replacement path to $to, " . |
701
|
|
|
|
|
|
|
"using $matches[-1]\n" unless $self->quiet; |
702
|
|
|
|
|
|
|
# Use [-1] so newer (higher numbered) perl PODs are used |
703
|
0
|
|
|
|
|
0
|
$path = $self->pages->{$matches[-1]}; |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
} else { |
706
|
44
|
|
|
|
|
1031
|
$path = $self->pages->{$to}; |
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
|
709
|
49
|
|
|
|
|
839
|
my $url = File::Spec::Unix->catfile(Pod::L10N::Html::_unixify($self->htmlroot), |
710
|
|
|
|
|
|
|
$path); |
711
|
|
|
|
|
|
|
|
712
|
49
|
100
|
|
|
|
190
|
if ($self->htmlfileurl ne '') { |
713
|
|
|
|
|
|
|
# then $self->htmlroot eq '' (by definition of htmlfileurl) so |
714
|
|
|
|
|
|
|
# $self->htmldir needs to be prepended to link to get the absolute path |
715
|
|
|
|
|
|
|
# that will be relativized |
716
|
23
|
|
|
|
|
222
|
$url = relativize_url( |
717
|
|
|
|
|
|
|
File::Spec::Unix->catdir(Pod::L10N::Html::_unixify($self->htmldir), $url), |
718
|
|
|
|
|
|
|
$self->htmlfileurl # already unixified |
719
|
|
|
|
|
|
|
); |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
|
722
|
49
|
|
|
|
|
391
|
return $url . ".html$section"; |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
# |
726
|
|
|
|
|
|
|
# relativize_url - convert an absolute URL to one relative to a base URL. |
727
|
|
|
|
|
|
|
# Assumes both end in a filename. |
728
|
|
|
|
|
|
|
# |
729
|
|
|
|
|
|
|
sub relativize_url { |
730
|
23
|
|
|
23
|
|
179
|
my ($dest, $source) = @_; |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
# Remove each file from its path |
733
|
23
|
|
|
|
|
207
|
my ($dest_volume, $dest_directory, $dest_file) = |
734
|
|
|
|
|
|
|
File::Spec::Unix->splitpath( $dest ); |
735
|
23
|
|
|
|
|
174
|
$dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ); |
736
|
|
|
|
|
|
|
|
737
|
23
|
|
|
|
|
179
|
my ($source_volume, $source_directory, $source_file) = |
738
|
|
|
|
|
|
|
File::Spec::Unix->splitpath( $source ); |
739
|
23
|
|
|
|
|
117
|
$source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ); |
740
|
|
|
|
|
|
|
|
741
|
23
|
|
|
|
|
59
|
my $rel_path = ''; |
742
|
23
|
50
|
|
|
|
63
|
if ($dest ne '') { |
743
|
23
|
|
|
|
|
1248
|
$rel_path = File::Spec::Unix->abs2rel( $dest, $source ); |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
|
746
|
23
|
50
|
33
|
|
|
213
|
if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') { |
747
|
23
|
|
|
|
|
416
|
$rel_path .= "/$dest_file"; |
748
|
|
|
|
|
|
|
} else { |
749
|
0
|
|
|
|
|
0
|
$rel_path .= "$dest_file"; |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
|
752
|
23
|
|
|
|
|
69
|
return $rel_path; |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
sub _end_head { |
756
|
67
|
|
|
67
|
|
118487
|
my $h = delete $_[0]{in_head}; |
757
|
|
|
|
|
|
|
|
758
|
67
|
|
|
|
|
431
|
my $add = $_[0]->html_h_level; |
759
|
67
|
50
|
|
|
|
603
|
$add = 1 unless defined $add; |
760
|
67
|
|
|
|
|
173
|
$h += $add - 1; |
761
|
|
|
|
|
|
|
|
762
|
67
|
|
|
|
|
404
|
my ($orig, $trans) = split /@@@@@@@@@@/, $_[0]{scratch}; |
763
|
67
|
100
|
|
|
|
6797
|
if(!defined $trans){ |
764
|
65
|
|
|
|
|
126
|
$trans = $orig; |
765
|
|
|
|
|
|
|
} |
766
|
67
|
|
|
|
|
218
|
my $id = $_[0]->idify($orig); |
767
|
67
|
|
|
|
|
127
|
my $text = $trans; |
768
|
67
|
100
|
66
|
|
|
266
|
$_[0]{'scratch'} = $_[0]->backlink && ($h - $add == 0) |
769
|
|
|
|
|
|
|
# backlinks enabled && =head1 |
770
|
|
|
|
|
|
|
? qq{$text} |
771
|
|
|
|
|
|
|
: qq{$text}; |
772
|
67
|
|
|
|
|
902
|
$_[0]->emit; |
773
|
67
|
|
|
|
|
971
|
push @{ $_[0]{'to_index'} }, [$h, $id, $text]; |
|
67
|
|
|
|
|
328
|
|
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
sub end_item_text { |
777
|
16
|
|
|
16
|
|
49801
|
my ($orig, $trans) = split /@@@@@@@@@@/, $_[0]{scratch}; |
778
|
16
|
100
|
|
|
|
67
|
if(!defined $trans){ |
779
|
14
|
|
|
|
|
32
|
$trans = $orig; |
780
|
|
|
|
|
|
|
} |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
# idify and anchor =item content if wanted |
783
|
16
|
50
|
|
|
|
103
|
my $dt_id = $_[0]{'anchor_items'} |
784
|
|
|
|
|
|
|
? ' id="'. $_[0]->idify($orig) .'"' |
785
|
|
|
|
|
|
|
: ''; |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
# reset scratch |
788
|
16
|
|
|
|
|
35
|
my $text = $trans; |
789
|
16
|
|
|
|
|
36
|
$_[0]{'scratch'} = ''; |
790
|
|
|
|
|
|
|
|
791
|
16
|
100
|
|
|
|
69
|
if ($_[0]{'in_dd'}[ $_[0]{'dl_level'} ]) { |
792
|
6
|
|
|
|
|
11
|
$_[0]{'scratch'} = "\n"; |
793
|
6
|
|
|
|
|
12
|
$_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 0; |
794
|
|
|
|
|
|
|
} |
795
|
|
|
|
|
|
|
|
796
|
16
|
|
|
|
|
63
|
$_[0]{'scratch'} .= qq{$text\n}; |
797
|
16
|
|
|
|
|
52
|
$_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 1; |
798
|
16
|
|
|
|
|
58
|
$_[0]->emit; |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
1; |