line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Pod::Man -- Convert POD data to formatted *roff input. |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# This module translates POD documentation into *roff markup using the man |
4
|
|
|
|
|
|
|
# macro set, and is intended for converting POD documents written as Unix |
5
|
|
|
|
|
|
|
# manual pages to manual pages that can be read by the man(1) command. It is |
6
|
|
|
|
|
|
|
# a replacement for the pod2man command distributed with versions of Perl |
7
|
|
|
|
|
|
|
# prior to 5.6. |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# Perl core hackers, please note that this module is also separately |
10
|
|
|
|
|
|
|
# maintained outside of the Perl core as part of the podlators. Please send |
11
|
|
|
|
|
|
|
# me any patches at the address above in addition to sending them to the |
12
|
|
|
|
|
|
|
# standard Perl mailing lists. |
13
|
|
|
|
|
|
|
# |
14
|
|
|
|
|
|
|
# Written by Russ Allbery |
15
|
|
|
|
|
|
|
# Substantial contributions by Sean Burke |
16
|
|
|
|
|
|
|
# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, |
17
|
|
|
|
|
|
|
# 2010, 2012, 2013, 2014, 2015, 2016 Russ Allbery |
18
|
|
|
|
|
|
|
# |
19
|
|
|
|
|
|
|
# This program is free software; you may redistribute it and/or modify it |
20
|
|
|
|
|
|
|
# under the same terms as Perl itself. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
############################################################################## |
23
|
|
|
|
|
|
|
# Modules and declarations |
24
|
|
|
|
|
|
|
############################################################################## |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
package Pod::Man; |
27
|
|
|
|
|
|
|
|
28
|
11
|
|
|
11
|
|
244452
|
use 5.006; |
|
11
|
|
|
|
|
31
|
|
29
|
11
|
|
|
11
|
|
37
|
use strict; |
|
11
|
|
|
|
|
14
|
|
|
11
|
|
|
|
|
193
|
|
30
|
11
|
|
|
11
|
|
36
|
use warnings; |
|
11
|
|
|
|
|
13
|
|
|
11
|
|
|
|
|
283
|
|
31
|
|
|
|
|
|
|
|
32
|
11
|
|
|
11
|
|
4557
|
use subs qw(makespace); |
|
11
|
|
|
|
|
618
|
|
|
11
|
|
|
|
|
49
|
|
33
|
11
|
|
|
11
|
|
1384
|
use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); |
|
11
|
|
|
|
|
13
|
|
|
11
|
|
|
|
|
2213
|
|
34
|
|
|
|
|
|
|
|
35
|
11
|
|
|
11
|
|
41
|
use Carp qw(carp croak); |
|
11
|
|
|
|
|
12
|
|
|
11
|
|
|
|
|
558
|
|
36
|
11
|
|
|
11
|
|
5377
|
use Pod::Simple (); |
|
11
|
|
|
|
|
248546
|
|
|
11
|
|
|
|
|
451
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# Conditionally import Encode and set $HAS_ENCODE if it is available. |
39
|
|
|
|
|
|
|
our $HAS_ENCODE; |
40
|
|
|
|
|
|
|
BEGIN { |
41
|
11
|
|
|
11
|
|
21
|
$HAS_ENCODE = eval { require Encode }; |
|
11
|
|
|
|
|
2567
|
|
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
@ISA = qw(Pod::Simple); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
$VERSION = '4.08'; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Set the debugging level. If someone has inserted a debug function into this |
49
|
|
|
|
|
|
|
# class already, use that. Otherwise, use any Pod::Simple debug function |
50
|
|
|
|
|
|
|
# that's defined, and failing that, define a debug level of 10. |
51
|
|
|
|
|
|
|
BEGIN { |
52
|
11
|
50
|
|
11
|
|
28953
|
my $parent = defined (&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG : undef; |
53
|
11
|
50
|
|
|
|
43
|
unless (defined &DEBUG) { |
54
|
11
|
|
50
|
|
|
223
|
*DEBUG = $parent || sub () { 10 }; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# Import the ASCII constant from Pod::Simple. This is true iff we're in an |
59
|
|
|
|
|
|
|
# ASCII-based universe (including such things as ISO 8859-1 and UTF-8), and is |
60
|
|
|
|
|
|
|
# generally only false for EBCDIC. |
61
|
11
|
|
|
11
|
|
167
|
BEGIN { *ASCII = \&Pod::Simple::ASCII } |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# Pretty-print a data structure. Only used for debugging. |
64
|
11
|
|
|
11
|
|
65545
|
BEGIN { *pretty = \&Pod::Simple::pretty } |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# Formatting instructions for various types of blocks. cleanup makes hyphens |
67
|
|
|
|
|
|
|
# hard, adds spaces between consecutive underscores, and escapes backslashes. |
68
|
|
|
|
|
|
|
# convert translates characters into escapes. guesswork means to apply the |
69
|
|
|
|
|
|
|
# transformations done by the guesswork sub. literal says to protect literal |
70
|
|
|
|
|
|
|
# quotes from being turned into UTF-8 quotes. By default, all transformations |
71
|
|
|
|
|
|
|
# are on except literal, but some elements override. |
72
|
|
|
|
|
|
|
# |
73
|
|
|
|
|
|
|
# DEFAULT specifies the default settings. All other elements should list only |
74
|
|
|
|
|
|
|
# those settings that they are overriding. Data indicates =for roff blocks, |
75
|
|
|
|
|
|
|
# which should be passed along completely verbatim. |
76
|
|
|
|
|
|
|
# |
77
|
|
|
|
|
|
|
# Formatting inherits negatively, in the sense that if the parent has turned |
78
|
|
|
|
|
|
|
# off guesswork, all child elements should leave it off. |
79
|
|
|
|
|
|
|
my %FORMATTING = ( |
80
|
|
|
|
|
|
|
DEFAULT => { cleanup => 1, convert => 1, guesswork => 1, literal => 0 }, |
81
|
|
|
|
|
|
|
Data => { cleanup => 0, convert => 0, guesswork => 0, literal => 0 }, |
82
|
|
|
|
|
|
|
Verbatim => { guesswork => 0, literal => 1 }, |
83
|
|
|
|
|
|
|
C => { guesswork => 0, literal => 1 }, |
84
|
|
|
|
|
|
|
X => { cleanup => 0, guesswork => 0 }, |
85
|
|
|
|
|
|
|
); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
############################################################################## |
88
|
|
|
|
|
|
|
# Object initialization |
89
|
|
|
|
|
|
|
############################################################################## |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# Initialize the object and set various Pod::Simple options that we need. |
92
|
|
|
|
|
|
|
# Here, we also process any additional options passed to the constructor or |
93
|
|
|
|
|
|
|
# set up defaults if none were given. Note that all internal object keys are |
94
|
|
|
|
|
|
|
# in all-caps, reserving all lower-case object keys for Pod::Simple and user |
95
|
|
|
|
|
|
|
# arguments. |
96
|
|
|
|
|
|
|
sub new { |
97
|
30
|
|
|
30
|
1
|
36239
|
my $class = shift; |
98
|
30
|
|
|
|
|
168
|
my $self = $class->SUPER::new; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# Tell Pod::Simple not to handle S<> by automatically inserting . |
101
|
30
|
|
|
|
|
675
|
$self->nbsp_for_S (1); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# Tell Pod::Simple to keep whitespace whenever possible. |
104
|
30
|
50
|
|
|
|
404
|
if (my $preserve_whitespace = $self->can ('preserve_whitespace')) { |
105
|
30
|
|
|
|
|
77
|
$self->$preserve_whitespace (1); |
106
|
|
|
|
|
|
|
} else { |
107
|
0
|
|
|
|
|
0
|
$self->fullstop_space_harden (1); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# The =for and =begin targets that we accept. |
111
|
30
|
|
|
|
|
205
|
$self->accept_targets (qw/man MAN roff ROFF/); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# Ensure that contiguous blocks of code are merged together. Otherwise, |
114
|
|
|
|
|
|
|
# some of the guesswork heuristics don't work right. |
115
|
30
|
|
|
|
|
631
|
$self->merge_text (1); |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# Pod::Simple doesn't do anything useful with our arguments, but we want |
118
|
|
|
|
|
|
|
# to put them in our object as hash keys and values. This could cause |
119
|
|
|
|
|
|
|
# problems if we ever clash with Pod::Simple's own internal class |
120
|
|
|
|
|
|
|
# variables. |
121
|
30
|
|
|
|
|
303
|
%$self = (%$self, @_); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# Send errors to stderr if requested. |
124
|
30
|
100
|
66
|
|
|
140
|
if ($$self{stderr} and not $$self{errors}) { |
125
|
1
|
|
|
|
|
2
|
$$self{errors} = 'stderr'; |
126
|
|
|
|
|
|
|
} |
127
|
30
|
|
|
|
|
37
|
delete $$self{stderr}; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# Validate the errors parameter and act on it. |
130
|
30
|
100
|
|
|
|
72
|
if (not defined $$self{errors}) { |
131
|
23
|
|
|
|
|
44
|
$$self{errors} = 'pod'; |
132
|
|
|
|
|
|
|
} |
133
|
30
|
100
|
100
|
|
|
202
|
if ($$self{errors} eq 'stderr' || $$self{errors} eq 'die') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
134
|
3
|
|
|
|
|
10
|
$self->no_errata_section (1); |
135
|
3
|
|
|
|
|
16
|
$self->complain_stderr (1); |
136
|
3
|
100
|
|
|
|
14
|
if ($$self{errors} eq 'die') { |
137
|
1
|
|
|
|
|
2
|
$$self{complain_die} = 1; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} elsif ($$self{errors} eq 'pod') { |
140
|
25
|
|
|
|
|
90
|
$self->no_errata_section (0); |
141
|
25
|
|
|
|
|
164
|
$self->complain_stderr (0); |
142
|
|
|
|
|
|
|
} elsif ($$self{errors} eq 'none') { |
143
|
2
|
|
|
|
|
10
|
$self->no_whining (1); |
144
|
|
|
|
|
|
|
} else { |
145
|
0
|
|
|
|
|
0
|
croak (qq(Invalid errors setting: "$$self{errors}")); |
146
|
|
|
|
|
|
|
} |
147
|
30
|
|
|
|
|
120
|
delete $$self{errors}; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# Degrade back to non-utf8 if Encode is not available. |
150
|
|
|
|
|
|
|
# |
151
|
|
|
|
|
|
|
# Suppress the warning message when PERL_CORE is set, indicating this is |
152
|
|
|
|
|
|
|
# running as part of the core Perl build. Perl builds podlators (and all |
153
|
|
|
|
|
|
|
# pure Perl modules) before Encode and other XS modules, so Encode won't |
154
|
|
|
|
|
|
|
# yet be available. Rely on the Perl core build to generate man pages |
155
|
|
|
|
|
|
|
# later, after all the modules are available, so that UTF-8 handling will |
156
|
|
|
|
|
|
|
# be correct. |
157
|
30
|
100
|
100
|
|
|
91
|
if ($$self{utf8} and !$HAS_ENCODE) { |
158
|
1
|
50
|
|
|
|
3
|
if (!$ENV{PERL_CORE}) { |
159
|
1
|
|
|
|
|
238
|
carp ('utf8 mode requested but Encode module not available,' |
160
|
|
|
|
|
|
|
. ' falling back to non-utf8'); |
161
|
|
|
|
|
|
|
} |
162
|
1
|
|
|
|
|
496
|
delete $$self{utf8}; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Initialize various other internal constants based on our arguments. |
166
|
30
|
|
|
|
|
75
|
$self->init_fonts; |
167
|
30
|
|
|
|
|
85
|
$self->init_quotes; |
168
|
30
|
|
|
|
|
73
|
$self->init_page; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# For right now, default to turning on all of the magic. |
171
|
30
|
|
|
|
|
37
|
$$self{MAGIC_CPP} = 1; |
172
|
30
|
|
|
|
|
40
|
$$self{MAGIC_EMDASH} = 1; |
173
|
30
|
|
|
|
|
35
|
$$self{MAGIC_FUNC} = 1; |
174
|
30
|
|
|
|
|
30
|
$$self{MAGIC_MANREF} = 1; |
175
|
30
|
|
|
|
|
42
|
$$self{MAGIC_SMALLCAPS} = 1; |
176
|
30
|
|
|
|
|
31
|
$$self{MAGIC_VARS} = 1; |
177
|
|
|
|
|
|
|
|
178
|
30
|
|
|
|
|
67
|
return $self; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# Translate a font string into an escape. |
182
|
120
|
50
|
|
120
|
0
|
414
|
sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] } |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# Determine which fonts the user wishes to use and store them in the object. |
185
|
|
|
|
|
|
|
# Regular, italic, bold, and bold-italic are constants, but the fixed width |
186
|
|
|
|
|
|
|
# fonts may be set by the user. Sets the internal hash key FONTS which is |
187
|
|
|
|
|
|
|
# used to map our internal font escapes to actual *roff sequences later. |
188
|
|
|
|
|
|
|
sub init_fonts { |
189
|
30
|
|
|
30
|
0
|
35
|
my ($self) = @_; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# Figure out the fixed-width font. If user-supplied, make sure that they |
192
|
|
|
|
|
|
|
# are the right length. |
193
|
30
|
|
|
|
|
66
|
for (qw/fixed fixedbold fixeditalic fixedbolditalic/) { |
194
|
120
|
|
|
|
|
112
|
my $font = $$self{$_}; |
195
|
120
|
50
|
33
|
|
|
209
|
if (defined ($font) && (length ($font) < 1 || length ($font) > 2)) { |
|
|
|
66
|
|
|
|
|
196
|
0
|
|
|
|
|
0
|
croak qq(roff font should be 1 or 2 chars, not "$font"); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# Set the default fonts. We can't be sure portably across different |
201
|
|
|
|
|
|
|
# implementations what fixed bold-italic may be called (if it's even |
202
|
|
|
|
|
|
|
# available), so default to just bold. |
203
|
30
|
|
100
|
|
|
113
|
$$self{fixed} ||= 'CW'; |
204
|
30
|
|
100
|
|
|
107
|
$$self{fixedbold} ||= 'CB'; |
205
|
30
|
|
100
|
|
|
180
|
$$self{fixeditalic} ||= 'CI'; |
206
|
30
|
|
100
|
|
|
110
|
$$self{fixedbolditalic} ||= 'CB'; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# Set up a table of font escapes. First number is fixed-width, second is |
209
|
|
|
|
|
|
|
# bold, third is italic. |
210
|
|
|
|
|
|
|
$$self{FONTS} = { '000' => '\fR', '001' => '\fI', |
211
|
|
|
|
|
|
|
'010' => '\fB', '011' => '\f(BI', |
212
|
|
|
|
|
|
|
'100' => toescape ($$self{fixed}), |
213
|
|
|
|
|
|
|
'101' => toescape ($$self{fixeditalic}), |
214
|
|
|
|
|
|
|
'110' => toescape ($$self{fixedbold}), |
215
|
30
|
|
|
|
|
89
|
'111' => toescape ($$self{fixedbolditalic}) }; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Initialize the quotes that we'll be using for C<> text. This requires some |
219
|
|
|
|
|
|
|
# special handling, both to parse the user parameters if given and to make |
220
|
|
|
|
|
|
|
# sure that the quotes will be safe against *roff. Sets the internal hash |
221
|
|
|
|
|
|
|
# keys LQUOTE and RQUOTE. |
222
|
|
|
|
|
|
|
sub init_quotes { |
223
|
30
|
|
|
30
|
0
|
41
|
my ($self) = (@_); |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# Handle the quotes option first, which sets both quotes at once. |
226
|
30
|
|
100
|
|
|
120
|
$$self{quotes} ||= '"'; |
227
|
30
|
50
|
|
|
|
113
|
if ($$self{quotes} eq 'none') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
228
|
0
|
|
|
|
|
0
|
$$self{LQUOTE} = $$self{RQUOTE} = ''; |
229
|
|
|
|
|
|
|
} elsif (length ($$self{quotes}) == 1) { |
230
|
29
|
|
|
|
|
82
|
$$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes}; |
231
|
|
|
|
|
|
|
} elsif (length ($$self{quotes}) % 2 == 0) { |
232
|
1
|
|
|
|
|
3
|
my $length = length ($$self{quotes}) / 2; |
233
|
1
|
|
|
|
|
4
|
$$self{LQUOTE} = substr ($$self{quotes}, 0, $length); |
234
|
1
|
|
|
|
|
2
|
$$self{RQUOTE} = substr ($$self{quotes}, $length); |
235
|
|
|
|
|
|
|
} else { |
236
|
0
|
|
|
|
|
0
|
croak(qq(Invalid quote specification "$$self{quotes}")) |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# Now handle the lquote and rquote options. |
240
|
30
|
100
|
|
|
|
74
|
if (defined $$self{lquote}) { |
241
|
2
|
50
|
|
|
|
7
|
$$self{LQUOTE} = $$self{lquote} eq 'none' ? q{} : $$self{lquote}; |
242
|
|
|
|
|
|
|
} |
243
|
30
|
100
|
|
|
|
63
|
if (defined $$self{rquote}) { |
244
|
2
|
100
|
|
|
|
6
|
$$self{RQUOTE} = $$self{rquote} eq 'none' ? q{} : $$self{rquote}; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
# Double the first quote; note that this should not be s///g as two double |
248
|
|
|
|
|
|
|
# quotes is represented in *roff as three double quotes, not four. Weird, |
249
|
|
|
|
|
|
|
# I know. |
250
|
30
|
|
|
|
|
89
|
$$self{LQUOTE} =~ s/\"/\"\"/; |
251
|
30
|
|
|
|
|
60
|
$$self{RQUOTE} =~ s/\"/\"\"/; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# Initialize the page title information and indentation from our arguments. |
255
|
|
|
|
|
|
|
sub init_page { |
256
|
30
|
|
|
30
|
0
|
30
|
my ($self) = @_; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# We used to try first to get the version number from a local binary, but |
259
|
|
|
|
|
|
|
# we shouldn't need that any more. Get the version from the running Perl. |
260
|
|
|
|
|
|
|
# Work a little magic to handle subversions correctly under both the |
261
|
|
|
|
|
|
|
# pre-5.6 and the post-5.6 version numbering schemes. |
262
|
30
|
|
|
|
|
181
|
my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); |
263
|
30
|
|
50
|
|
|
64
|
$version[2] ||= 0; |
264
|
30
|
|
|
|
|
93
|
$version[2] *= 10 ** (3 - length $version[2]); |
265
|
30
|
|
|
|
|
58
|
for (@version) { $_ += 0 } |
|
90
|
|
|
|
|
112
|
|
266
|
30
|
|
|
|
|
74
|
my $version = join ('.', @version); |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# Set the defaults for page titles and indentation if the user didn't |
269
|
|
|
|
|
|
|
# override anything. |
270
|
|
|
|
|
|
|
$$self{center} = 'User Contributed Perl Documentation' |
271
|
30
|
100
|
|
|
|
94
|
unless defined $$self{center}; |
272
|
|
|
|
|
|
|
$$self{release} = 'perl v' . $version |
273
|
30
|
100
|
|
|
|
114
|
unless defined $$self{release}; |
274
|
|
|
|
|
|
|
$$self{indent} = 4 |
275
|
30
|
50
|
|
|
|
73
|
unless defined $$self{indent}; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# Double quotes in things that will be quoted. |
278
|
30
|
|
|
|
|
56
|
for (qw/center release/) { |
279
|
60
|
100
|
|
|
|
172
|
$$self{$_} =~ s/\"/\"\"/g if $$self{$_}; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
############################################################################## |
284
|
|
|
|
|
|
|
# Core parsing |
285
|
|
|
|
|
|
|
############################################################################## |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# This is the glue that connects the code below with Pod::Simple itself. The |
288
|
|
|
|
|
|
|
# goal is to convert the event stream coming from the POD parser into method |
289
|
|
|
|
|
|
|
# calls to handlers once the complete content of a tag has been seen. Each |
290
|
|
|
|
|
|
|
# paragraph or POD command will have textual content associated with it, and |
291
|
|
|
|
|
|
|
# as soon as all of a paragraph or POD command has been seen, that content |
292
|
|
|
|
|
|
|
# will be passed in to the corresponding method for handling that type of |
293
|
|
|
|
|
|
|
# object. The exceptions are handlers for lists, which have opening tag |
294
|
|
|
|
|
|
|
# handlers and closing tag handlers that will be called right away. |
295
|
|
|
|
|
|
|
# |
296
|
|
|
|
|
|
|
# The internal hash key PENDING is used to store the contents of a tag until |
297
|
|
|
|
|
|
|
# all of it has been seen. It holds a stack of open tags, each one |
298
|
|
|
|
|
|
|
# represented by a tuple of the attributes hash for the tag, formatting |
299
|
|
|
|
|
|
|
# options for the tag (which are inherited), and the contents of the tag. |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
# Add a block of text to the contents of the current node, formatting it |
302
|
|
|
|
|
|
|
# according to the current formatting instructions as we do. |
303
|
|
|
|
|
|
|
sub _handle_text { |
304
|
674
|
|
|
674
|
|
3231
|
my ($self, $text) = @_; |
305
|
674
|
|
|
|
|
406
|
DEBUG > 3 and print "== $text\n"; |
306
|
674
|
|
|
|
|
569
|
my $tag = $$self{PENDING}[-1]; |
307
|
674
|
|
|
|
|
850
|
$$tag[2] .= $self->format_text ($$tag[1], $text); |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# Given an element name, get the corresponding method name. |
311
|
|
|
|
|
|
|
sub method_for_element { |
312
|
1442
|
|
|
1442
|
0
|
1070
|
my ($self, $element) = @_; |
313
|
1442
|
|
|
|
|
1276
|
$element =~ tr/A-Z-/a-z_/; |
314
|
1442
|
|
|
|
|
1160
|
$element =~ tr/_a-z0-9//cd; |
315
|
1442
|
|
|
|
|
1743
|
return $element; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# Handle the start of a new element. If cmd_element is defined, assume that |
319
|
|
|
|
|
|
|
# we need to collect the entire tree for this element before passing it to the |
320
|
|
|
|
|
|
|
# element method, and create a new tree into which we'll collect blocks of |
321
|
|
|
|
|
|
|
# text and nested elements. Otherwise, if start_element is defined, call it. |
322
|
|
|
|
|
|
|
sub _handle_element_start { |
323
|
721
|
|
|
721
|
|
90520
|
my ($self, $element, $attrs) = @_; |
324
|
721
|
|
|
|
|
498
|
DEBUG > 3 and print "++ $element (<", join ('> <', %$attrs), ">)\n"; |
325
|
721
|
|
|
|
|
859
|
my $method = $self->method_for_element ($element); |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# If we have a command handler, we need to accumulate the contents of the |
328
|
|
|
|
|
|
|
# tag before calling it. Turn off IN_NAME for any command other than |
329
|
|
|
|
|
|
|
# and the formatting codes so that IN_NAME isn't still set for the |
330
|
|
|
|
|
|
|
# first heading after the NAME heading. |
331
|
721
|
100
|
|
|
|
2500
|
if ($self->can ("cmd_$method")) { |
|
|
100
|
|
|
|
|
|
332
|
612
|
|
|
|
|
378
|
DEBUG > 2 and print "<$element> starts saving a tag\n"; |
333
|
612
|
100
|
100
|
|
|
1799
|
$$self{IN_NAME} = 0 if ($element ne 'Para' && length ($element) > 1); |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# How we're going to format embedded text blocks depends on the tag |
336
|
|
|
|
|
|
|
# and also depends on our parent tags. Thankfully, inside tags that |
337
|
|
|
|
|
|
|
# turn off guesswork and reformatting, nothing else can turn it back |
338
|
|
|
|
|
|
|
# on, so this can be strictly inherited. |
339
|
|
|
|
|
|
|
my $formatting = { |
340
|
612
|
100
|
|
|
|
1696
|
%{ $$self{PENDING}[-1][1] || $FORMATTING{DEFAULT} }, |
341
|
612
|
100
|
|
|
|
422
|
%{ $FORMATTING{$element} || {} }, |
|
612
|
|
|
|
|
2295
|
|
342
|
|
|
|
|
|
|
}; |
343
|
612
|
|
|
|
|
741
|
push (@{ $$self{PENDING} }, [ $attrs, $formatting, '' ]); |
|
612
|
|
|
|
|
989
|
|
344
|
612
|
|
|
|
|
863
|
DEBUG > 4 and print "Pending: [", pretty ($$self{PENDING}), "]\n"; |
345
|
|
|
|
|
|
|
} elsif (my $start_method = $self->can ("start_$method")) { |
346
|
105
|
|
|
|
|
210
|
$self->$start_method ($attrs, ''); |
347
|
|
|
|
|
|
|
} else { |
348
|
4
|
|
|
|
|
7
|
DEBUG > 2 and print "No $method start method, skipping\n"; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# Handle the end of an element. If we had a cmd_ method for this element, |
353
|
|
|
|
|
|
|
# this is where we pass along the tree that we built. Otherwise, if we have |
354
|
|
|
|
|
|
|
# an end_ method for the element, call that. |
355
|
|
|
|
|
|
|
sub _handle_element_end { |
356
|
721
|
|
|
721
|
|
5086
|
my ($self, $element) = @_; |
357
|
721
|
|
|
|
|
465
|
DEBUG > 3 and print "-- $element\n"; |
358
|
721
|
|
|
|
|
777
|
my $method = $self->method_for_element ($element); |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# If we have a command handler, pull off the pending text and pass it to |
361
|
|
|
|
|
|
|
# the handler along with the saved attribute hash. |
362
|
721
|
100
|
|
|
|
2238
|
if (my $cmd_method = $self->can ("cmd_$method")) { |
|
|
100
|
|
|
|
|
|
363
|
612
|
|
|
|
|
364
|
DEBUG > 2 and print "$element> stops saving a tag\n"; |
364
|
612
|
|
|
|
|
359
|
my $tag = pop @{ $$self{PENDING} }; |
|
612
|
|
|
|
|
630
|
|
365
|
612
|
|
|
|
|
396
|
DEBUG > 4 and print "Popped: [", pretty ($tag), "]\n"; |
366
|
612
|
|
|
|
|
329
|
DEBUG > 4 and print "Pending: [", pretty ($$self{PENDING}), "]\n"; |
367
|
612
|
|
|
|
|
901
|
my $text = $self->$cmd_method ($$tag[0], $$tag[2]); |
368
|
612
|
100
|
|
|
|
1177
|
if (defined $text) { |
369
|
578
|
100
|
|
|
|
351
|
if (@{ $$self{PENDING} } > 1) { |
|
578
|
|
|
|
|
849
|
|
370
|
191
|
|
|
|
|
519
|
$$self{PENDING}[-1][2] .= $text; |
371
|
|
|
|
|
|
|
} else { |
372
|
387
|
|
|
|
|
427
|
$self->output ($text); |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} elsif (my $end_method = $self->can ("end_$method")) { |
376
|
105
|
|
|
|
|
167
|
$self->$end_method (); |
377
|
|
|
|
|
|
|
} else { |
378
|
4
|
|
|
|
|
6
|
DEBUG > 2 and print "No $method end method, skipping\n"; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
############################################################################## |
383
|
|
|
|
|
|
|
# General formatting |
384
|
|
|
|
|
|
|
############################################################################## |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
# Format a text block. Takes a hash of formatting options and the text to |
387
|
|
|
|
|
|
|
# format. Currently, the only formatting options are guesswork, cleanup, and |
388
|
|
|
|
|
|
|
# convert, all of which are boolean. |
389
|
|
|
|
|
|
|
sub format_text { |
390
|
678
|
|
|
678
|
0
|
593
|
my ($self, $options, $text) = @_; |
391
|
678
|
|
100
|
|
|
1697
|
my $guesswork = $$options{guesswork} && !$$self{IN_NAME}; |
392
|
678
|
|
|
|
|
481
|
my $cleanup = $$options{cleanup}; |
393
|
678
|
|
|
|
|
441
|
my $convert = $$options{convert}; |
394
|
678
|
|
|
|
|
441
|
my $literal = $$options{literal}; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# Cleanup just tidies up a few things, telling *roff that the hyphens are |
397
|
|
|
|
|
|
|
# hard, putting a bit of space between consecutive underscores, and |
398
|
|
|
|
|
|
|
# escaping backslashes. Be careful not to mangle our character |
399
|
|
|
|
|
|
|
# translations by doing this before processing character translation. |
400
|
678
|
100
|
|
|
|
848
|
if ($cleanup) { |
401
|
669
|
|
|
|
|
716
|
$text =~ s/\\/\\e/g; |
402
|
669
|
|
|
|
|
656
|
$text =~ s/-/\\-/g; |
403
|
669
|
|
|
|
|
575
|
$text =~ s/_(?=_)/_\\|/g; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# Normally we do character translation, but we won't even do that in |
407
|
|
|
|
|
|
|
# blocks or if UTF-8 output is desired. |
408
|
678
|
100
|
100
|
|
|
2751
|
if ($convert && !$$self{utf8} && ASCII) { |
|
|
|
100
|
|
|
|
|
409
|
662
|
100
|
|
|
|
933
|
$text =~ s/([^\x00-\x7F])/$ESCAPES{ord ($1)} || "X"/eg; |
|
65
|
|
|
|
|
211
|
|
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
# Ensure that *roff doesn't convert literal quotes to UTF-8 single quotes, |
413
|
|
|
|
|
|
|
# but don't mess up our accept escapes. |
414
|
678
|
100
|
|
|
|
868
|
if ($literal) { |
415
|
110
|
|
|
|
|
128
|
$text =~ s/(?
|
416
|
110
|
|
|
|
|
89
|
$text =~ s/(?
|
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
# If guesswork is asked for, do that. This involves more substantial |
420
|
|
|
|
|
|
|
# formatting based on various heuristics that may only be appropriate for |
421
|
|
|
|
|
|
|
# particular documents. |
422
|
678
|
100
|
|
|
|
812
|
if ($guesswork) { |
423
|
540
|
|
|
|
|
727
|
$text = $self->guesswork ($text); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
678
|
|
|
|
|
1601
|
return $text; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
# Handles C<> text, deciding whether to put \*C` around it or not. This is a |
430
|
|
|
|
|
|
|
# whole bunch of messy heuristics to try to avoid overquoting, originally from |
431
|
|
|
|
|
|
|
# Barrie Slaymaker. This largely duplicates similar code in Pod::Text. |
432
|
|
|
|
|
|
|
sub quote_literal { |
433
|
73
|
|
|
73
|
0
|
54
|
my $self = shift; |
434
|
73
|
|
|
|
|
70
|
local $_ = shift; |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# A regex that matches the portion of a variable reference that's the |
437
|
|
|
|
|
|
|
# array or hash index, separated out just because we want to use it in |
438
|
|
|
|
|
|
|
# several places in the following regex. |
439
|
73
|
|
|
|
|
62
|
my $index = '(?: \[.*\] | \{.*\} )?'; |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# If in NAME section, just return an ASCII quoted string to avoid |
442
|
|
|
|
|
|
|
# confusing tools like whatis. |
443
|
73
|
100
|
|
|
|
110
|
return qq{"$_"} if $$self{IN_NAME}; |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
# Check for things that we don't want to quote, and if we find any of |
446
|
|
|
|
|
|
|
# them, return the string with just a font change and no quoting. |
447
|
71
|
100
|
|
|
|
2525
|
m{ |
448
|
|
|
|
|
|
|
^\s* |
449
|
|
|
|
|
|
|
(?: |
450
|
|
|
|
|
|
|
( [\'\`\"] ) .* \1 # already quoted |
451
|
|
|
|
|
|
|
| \\\*\(Aq .* \\\*\(Aq # quoted and escaped |
452
|
|
|
|
|
|
|
| \\?\` .* ( \' | \\\*\(Aq ) # `quoted' |
453
|
|
|
|
|
|
|
| \$+ [\#^]? \S $index # special ($^Foo, $") |
454
|
|
|
|
|
|
|
| [\$\@%&*]+ \#? [:\'\w]+ $index # plain var or func |
455
|
|
|
|
|
|
|
| [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call |
456
|
|
|
|
|
|
|
| [-+]? ( \d[\d.]* | \.\d+ ) (?: [eE][-+]?\d+ )? # a number |
457
|
|
|
|
|
|
|
| 0x [a-fA-F\d]+ # a hex constant |
458
|
|
|
|
|
|
|
) |
459
|
|
|
|
|
|
|
\s*\z |
460
|
|
|
|
|
|
|
}xso and return '\f(FS' . $_ . '\f(FE'; |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# If we didn't return, go ahead and quote the text. |
463
|
65
|
|
|
|
|
307
|
return '\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# Takes a text block to perform guesswork on. Returns the text block with |
467
|
|
|
|
|
|
|
# formatting codes added. This is the code that marks up various Perl |
468
|
|
|
|
|
|
|
# constructs and things commonly used in man pages without requiring the user |
469
|
|
|
|
|
|
|
# to add any explicit markup, and is applied to all non-literal text. We're |
470
|
|
|
|
|
|
|
# guaranteed that the text we're applying guesswork to does not contain any |
471
|
|
|
|
|
|
|
# *roff formatting codes. Note that the inserted font sequences must be |
472
|
|
|
|
|
|
|
# treated later with mapfonts or textmapfonts. |
473
|
|
|
|
|
|
|
# |
474
|
|
|
|
|
|
|
# This method is very fragile, both in the regular expressions it uses and in |
475
|
|
|
|
|
|
|
# the ordering of those modifications. Care and testing is required when |
476
|
|
|
|
|
|
|
# modifying it. |
477
|
|
|
|
|
|
|
sub guesswork { |
478
|
540
|
|
|
540
|
0
|
420
|
my $self = shift; |
479
|
540
|
|
|
|
|
510
|
local $_ = shift; |
480
|
540
|
|
|
|
|
371
|
DEBUG > 5 and print " Guesswork called on [$_]\n"; |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# By the time we reach this point, all hyphens will be escaped by adding a |
483
|
|
|
|
|
|
|
# backslash. We want to undo that escaping if they're part of regular |
484
|
|
|
|
|
|
|
# words and there's only a single dash, since that's a real hyphen that |
485
|
|
|
|
|
|
|
# *roff gets to consider a possible break point. Make sure that a dash |
486
|
|
|
|
|
|
|
# after the first character of a word stays non-breaking, however. |
487
|
|
|
|
|
|
|
# |
488
|
|
|
|
|
|
|
# Note that this is not user-controllable; we pretty much have to do this |
489
|
|
|
|
|
|
|
# transformation or *roff will mangle the output in unacceptable ways. |
490
|
540
|
|
|
|
|
754
|
s{ |
491
|
|
|
|
|
|
|
( (?:\G|^|\s) [\(\"]* [a-zA-Z] ) ( \\- )? |
492
|
|
|
|
|
|
|
( (?: [a-zA-Z\']+ \\-)+ ) |
493
|
|
|
|
|
|
|
( [a-zA-Z\']+ ) (?= [\)\".?!,;:]* (?:\s|\Z|\\\ ) ) |
494
|
|
|
|
|
|
|
\b |
495
|
|
|
|
|
|
|
} { |
496
|
19
|
|
|
|
|
66
|
my ($prefix, $hyphen, $main, $suffix) = ($1, $2, $3, $4); |
497
|
19
|
|
50
|
|
|
65
|
$hyphen ||= ''; |
498
|
19
|
|
|
|
|
39
|
$main =~ s/\\-/-/g; |
499
|
19
|
|
|
|
|
79
|
$prefix . $hyphen . $main . $suffix; |
500
|
|
|
|
|
|
|
}egx; |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# Translate "--" into a real em-dash if it's used like one. This means |
503
|
|
|
|
|
|
|
# that it's either surrounded by whitespace, it follows a regular word, or |
504
|
|
|
|
|
|
|
# it occurs between two regular words. |
505
|
540
|
50
|
|
|
|
749
|
if ($$self{MAGIC_EMDASH}) { |
506
|
540
|
|
|
|
|
452
|
s{ (\s) \\-\\- (\s) } { $1 . '\*(--' . $2 }egx; |
|
0
|
|
|
|
|
0
|
|
507
|
540
|
|
|
|
|
471
|
s{ (\b[a-zA-Z]+) \\-\\- (\s|\Z|[a-zA-Z]+\b) } { $1 . '\*(--' . $2 }egx; |
|
0
|
|
|
|
|
0
|
|
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# Make words in all-caps a little bit smaller; they look better that way. |
511
|
|
|
|
|
|
|
# However, we don't want to change Perl code (like @ARGV), nor do we want |
512
|
|
|
|
|
|
|
# to fix the MIME in MIME-Version since it looks weird with the |
513
|
|
|
|
|
|
|
# full-height V. |
514
|
|
|
|
|
|
|
# |
515
|
|
|
|
|
|
|
# We change only a string of all caps (2) either at the beginning of the |
516
|
|
|
|
|
|
|
# line or following regular punctuation (like quotes) or whitespace (1), |
517
|
|
|
|
|
|
|
# and followed by either similar punctuation, an em-dash, or the end of |
518
|
|
|
|
|
|
|
# the line (3). |
519
|
|
|
|
|
|
|
# |
520
|
|
|
|
|
|
|
# Allow the text we're changing to small caps to include double quotes, |
521
|
|
|
|
|
|
|
# commas, newlines, and periods as long as it doesn't otherwise interrupt |
522
|
|
|
|
|
|
|
# the string of small caps and still fits the criteria. This lets us turn |
523
|
|
|
|
|
|
|
# entire warranty disclaimers in man page output into small caps. |
524
|
540
|
50
|
|
|
|
725
|
if ($$self{MAGIC_SMALLCAPS}) { |
525
|
540
|
|
|
|
|
2813
|
s{ |
526
|
|
|
|
|
|
|
( ^ | [\s\(\"\'\`\[\{<>] | \\[ ] ) # (1) |
527
|
|
|
|
|
|
|
( [A-Z] [A-Z] (?: \s? [/A-Z+:\d_\$&] | \\- | \s? [.,\"] )* ) # (2) |
528
|
|
|
|
|
|
|
(?= [\s>\}\]\(\)\'\".?!,;] | \\*\(-- | \\[ ] | $ ) # (3) |
529
|
|
|
|
|
|
|
} { |
530
|
74
|
|
|
|
|
320
|
$1 . '\s-1' . $2 . '\s0' |
531
|
|
|
|
|
|
|
}egx; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
# Note that from this point forward, we have to adjust for \s-1 and \s-0 |
535
|
|
|
|
|
|
|
# strings inserted around things that we've made small-caps if later |
536
|
|
|
|
|
|
|
# transforms should work on those strings. |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
# Italicize functions in the form func(), including functions that are in |
539
|
|
|
|
|
|
|
# all capitals, but don't italize if there's anything between the parens. |
540
|
|
|
|
|
|
|
# The function must start with an alphabetic character or underscore and |
541
|
|
|
|
|
|
|
# then consist of word characters or colons. |
542
|
540
|
50
|
|
|
|
790
|
if ($$self{MAGIC_FUNC}) { |
543
|
540
|
|
|
|
|
477
|
s{ |
544
|
|
|
|
|
|
|
( \b | \\s-1 ) |
545
|
|
|
|
|
|
|
( [A-Za-z_] ([:\w] | \\s-?[01])+ \(\) ) |
546
|
|
|
|
|
|
|
} { |
547
|
2
|
|
|
|
|
14
|
$1 . '\f(IS' . $2 . '\f(IE' |
548
|
|
|
|
|
|
|
}egx; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
# Change references to manual pages to put the page name in italics but |
552
|
|
|
|
|
|
|
# the number in the regular font, with a thin space between the name and |
553
|
|
|
|
|
|
|
# the number. Only recognize func(n) where func starts with an alphabetic |
554
|
|
|
|
|
|
|
# character or underscore and contains only word characters, periods (for |
555
|
|
|
|
|
|
|
# configuration file man pages), or colons, and n is a single digit, |
556
|
|
|
|
|
|
|
# optionally followed by some number of lowercase letters. Note that this |
557
|
|
|
|
|
|
|
# does not recognize man page references like perl(l) or socket(3SOCKET). |
558
|
540
|
50
|
|
|
|
681
|
if ($$self{MAGIC_MANREF}) { |
559
|
540
|
|
|
|
|
592
|
s{ |
560
|
|
|
|
|
|
|
( \b | \\s-1 ) |
561
|
|
|
|
|
|
|
(?
|
562
|
|
|
|
|
|
|
( [A-Za-z_] (?:[.:\w] | \\- | \\s-?[01])+ ) |
563
|
|
|
|
|
|
|
( \( \d [a-z]* \) ) |
564
|
|
|
|
|
|
|
} { |
565
|
0
|
|
|
|
|
0
|
$1 . '\f(IS' . $2 . '\f(IE\|' . $3 |
566
|
|
|
|
|
|
|
}egx; |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
# Convert simple Perl variable references to a fixed-width font. Be |
570
|
|
|
|
|
|
|
# careful not to convert functions, though; there are too many subtleties |
571
|
|
|
|
|
|
|
# with them to want to perform this transformation. |
572
|
540
|
50
|
|
|
|
678
|
if ($$self{MAGIC_VARS}) { |
573
|
540
|
|
|
|
|
2146
|
s{ |
574
|
|
|
|
|
|
|
( ^ | \s+ ) |
575
|
|
|
|
|
|
|
( [\$\@%] [\w:]+ ) |
576
|
|
|
|
|
|
|
(?! \( ) |
577
|
|
|
|
|
|
|
} { |
578
|
3
|
|
|
|
|
14
|
$1 . '\f(FS' . $2 . '\f(FE' |
579
|
|
|
|
|
|
|
}egx; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
# Fix up double quotes. Unfortunately, we miss this transformation if the |
583
|
|
|
|
|
|
|
# quoted text contains any code with formatting codes and there's not much |
584
|
|
|
|
|
|
|
# we can effectively do about that, which makes it somewhat unclear if |
585
|
|
|
|
|
|
|
# this is really a good idea. |
586
|
540
|
|
|
|
|
578
|
s{ \" ([^\"]+) \" } { '\*(L"' . $1 . '\*(R"' }egx; |
|
47
|
|
|
|
|
128
|
|
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
# Make C++ into \*(C+, which is a squinched version. |
589
|
540
|
50
|
|
|
|
701
|
if ($$self{MAGIC_CPP}) { |
590
|
540
|
|
|
|
|
524
|
s{ \b C\+\+ } {\\*\(C+}gx; |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
# Done. |
594
|
540
|
|
|
|
|
330
|
DEBUG > 5 and print " Guesswork returning [$_]\n"; |
595
|
540
|
|
|
|
|
775
|
return $_; |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
############################################################################## |
599
|
|
|
|
|
|
|
# Output |
600
|
|
|
|
|
|
|
############################################################################## |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
# When building up the *roff code, we don't use real *roff fonts. Instead, we |
603
|
|
|
|
|
|
|
# embed font codes of the form \f([SE] where is one of B, I, or |
604
|
|
|
|
|
|
|
# F, S stands for start, and E stands for end. This method turns these into |
605
|
|
|
|
|
|
|
# the right start and end codes. |
606
|
|
|
|
|
|
|
# |
607
|
|
|
|
|
|
|
# We add this level of complexity because the old pod2man didn't get code like |
608
|
|
|
|
|
|
|
# B else> right; after I<> it switched back to normal text rather |
609
|
|
|
|
|
|
|
# than bold. We take care of this by using variables that state whether bold, |
610
|
|
|
|
|
|
|
# italic, or fixed are turned on as a combined pointer to our current font |
611
|
|
|
|
|
|
|
# sequence, and set each to the number of current nestings of start tags for |
612
|
|
|
|
|
|
|
# that font. |
613
|
|
|
|
|
|
|
# |
614
|
|
|
|
|
|
|
# \fP changes to the previous font, but only one previous font is kept. We |
615
|
|
|
|
|
|
|
# don't know what the outside level font is; normally it's R, but if we're |
616
|
|
|
|
|
|
|
# inside a heading it could be something else. So arrange things so that the |
617
|
|
|
|
|
|
|
# outside font is always the "previous" font and end with \fP instead of \fR. |
618
|
|
|
|
|
|
|
# Idea from Zack Weinberg. |
619
|
|
|
|
|
|
|
sub mapfonts { |
620
|
78
|
|
|
78
|
0
|
77
|
my ($self, $text) = @_; |
621
|
78
|
|
|
|
|
87
|
my ($fixed, $bold, $italic) = (0, 0, 0); |
622
|
78
|
|
|
|
|
198
|
my %magic = (F => \$fixed, B => \$bold, I => \$italic); |
623
|
78
|
|
|
|
|
79
|
my $last = '\fR'; |
624
|
78
|
|
|
|
|
108
|
$text =~ s< |
625
|
|
|
|
|
|
|
\\f\((.)(.) |
626
|
|
|
|
|
|
|
> < |
627
|
28
|
|
|
|
|
29
|
my $sequence = ''; |
628
|
28
|
|
|
|
|
20
|
my $f; |
629
|
28
|
100
|
|
|
|
44
|
if ($last ne '\fR') { $sequence = '\fP' } |
|
14
|
|
|
|
|
13
|
|
630
|
28
|
100
|
|
|
|
20
|
${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; |
|
28
|
|
|
|
|
70
|
|
631
|
28
|
|
100
|
|
|
129
|
$f = $$self{FONTS}{ ($fixed && 1) . ($bold && 1) . ($italic && 1) }; |
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
632
|
28
|
50
|
|
|
|
33
|
if ($f eq $last) { |
633
|
0
|
|
|
|
|
0
|
''; |
634
|
|
|
|
|
|
|
} else { |
635
|
28
|
100
|
|
|
|
39
|
if ($f ne '\fR') { $sequence .= $f } |
|
14
|
|
|
|
|
15
|
|
636
|
28
|
|
|
|
|
18
|
$last = $f; |
637
|
28
|
|
|
|
|
63
|
$sequence; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
>gxe; |
640
|
78
|
|
|
|
|
196
|
return $text; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
# Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU |
644
|
|
|
|
|
|
|
# groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather |
645
|
|
|
|
|
|
|
# than R, presumably because \f(CW doesn't actually do a font change. To work |
646
|
|
|
|
|
|
|
# around this, use a separate textmapfonts for text blocks where the default |
647
|
|
|
|
|
|
|
# font is always R and only use the smart mapfonts for headings. |
648
|
|
|
|
|
|
|
sub textmapfonts { |
649
|
346
|
|
|
346
|
0
|
350
|
my ($self, $text) = @_; |
650
|
346
|
|
|
|
|
295
|
my ($fixed, $bold, $italic) = (0, 0, 0); |
651
|
346
|
|
|
|
|
720
|
my %magic = (F => \$fixed, B => \$bold, I => \$italic); |
652
|
346
|
|
|
|
|
535
|
$text =~ s< |
653
|
|
|
|
|
|
|
\\f\((.)(.) |
654
|
|
|
|
|
|
|
> < |
655
|
236
|
100
|
|
|
|
141
|
${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; |
|
236
|
|
|
|
|
463
|
|
656
|
236
|
|
100
|
|
|
1230
|
$$self{FONTS}{ ($fixed && 1) . ($bold && 1) . ($italic && 1) }; |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
657
|
|
|
|
|
|
|
>gxe; |
658
|
346
|
|
|
|
|
682
|
return $text; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
# Given a command and a single argument that may or may not contain double |
662
|
|
|
|
|
|
|
# quotes, handle double-quote formatting for it. If there are no double |
663
|
|
|
|
|
|
|
# quotes, just return the command followed by the argument in double quotes. |
664
|
|
|
|
|
|
|
# If there are double quotes, use an if statement to test for nroff, and for |
665
|
|
|
|
|
|
|
# nroff output the command followed by the argument in double quotes with |
666
|
|
|
|
|
|
|
# embedded double quotes doubled. For other formatters, remap paired double |
667
|
|
|
|
|
|
|
# quotes to LQUOTE and RQUOTE. |
668
|
|
|
|
|
|
|
sub switchquotes { |
669
|
152
|
|
|
152
|
0
|
171
|
my ($self, $command, $text, $extra) = @_; |
670
|
152
|
|
|
|
|
167
|
$text =~ s/\\\*\([LR]\"/\"/g; |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
# We also have to deal with \*C` and \*C', which are used to add the |
673
|
|
|
|
|
|
|
# quotes around C<> text, since they may expand to " and if they do this |
674
|
|
|
|
|
|
|
# confuses the .SH macros and the like no end. Expand them ourselves. |
675
|
|
|
|
|
|
|
# Also separate troff from nroff if there are any fixed-width fonts in use |
676
|
|
|
|
|
|
|
# to work around problems with Solaris nroff. |
677
|
152
|
|
66
|
|
|
368
|
my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/); |
678
|
152
|
|
|
|
|
146
|
my $fixedpat = join '|', @{ $$self{FONTS} }{'100', '101', '110', '111'}; |
|
152
|
|
|
|
|
349
|
|
679
|
152
|
|
|
|
|
391
|
$fixedpat =~ s/\\/\\\\/g; |
680
|
152
|
|
|
|
|
303
|
$fixedpat =~ s/\(/\\\(/g; |
681
|
152
|
100
|
100
|
|
|
983
|
if ($text =~ m/\"/ || $text =~ m/$fixedpat/) { |
682
|
20
|
|
|
|
|
39
|
$text =~ s/\"/\"\"/g; |
683
|
20
|
|
|
|
|
20
|
my $nroff = $text; |
684
|
20
|
|
|
|
|
22
|
my $troff = $text; |
685
|
20
|
|
|
|
|
51
|
$troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g; |
686
|
20
|
100
|
66
|
|
|
95
|
if ($c_is_quote and $text =~ m/\\\*\(C[\'\`]/) { |
687
|
13
|
|
|
|
|
46
|
$nroff =~ s/\\\*\(C\`/$$self{LQUOTE}/g; |
688
|
13
|
|
|
|
|
39
|
$nroff =~ s/\\\*\(C\'/$$self{RQUOTE}/g; |
689
|
13
|
|
|
|
|
43
|
$troff =~ s/\\\*\(C[\'\`]//g; |
690
|
|
|
|
|
|
|
} |
691
|
20
|
100
|
|
|
|
64
|
$nroff = qq("$nroff") . ($extra ? " $extra" : ''); |
692
|
20
|
100
|
|
|
|
44
|
$troff = qq("$troff") . ($extra ? " $extra" : ''); |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
# Work around the Solaris nroff bug where \f(CW\fP leaves the font set |
695
|
|
|
|
|
|
|
# to Roman rather than the actual previous font when used in headings. |
696
|
|
|
|
|
|
|
# troff output may still be broken, but at least we can fix nroff by |
697
|
|
|
|
|
|
|
# just switching the font changes to the non-fixed versions. |
698
|
20
|
|
|
|
|
48
|
my $font_end = "(?:\\f[PR]|\Q$$self{FONTS}{100}\E)"; |
699
|
20
|
|
|
|
|
157
|
$nroff =~ s/\Q$$self{FONTS}{100}\E(.*?)\\f([PR])/$1/g; |
700
|
20
|
|
|
|
|
126
|
$nroff =~ s/\Q$$self{FONTS}{101}\E(.*?)$font_end/\\fI$1\\fP/g; |
701
|
20
|
|
|
|
|
95
|
$nroff =~ s/\Q$$self{FONTS}{110}\E(.*?)$font_end/\\fB$1\\fP/g; |
702
|
20
|
|
|
|
|
80
|
$nroff =~ s/\Q$$self{FONTS}{111}\E(.*?)$font_end/\\f\(BI$1\\fP/g; |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
# Now finally output the command. Bother with .ie only if the nroff |
705
|
|
|
|
|
|
|
# and troff output aren't the same. |
706
|
20
|
100
|
|
|
|
34
|
if ($nroff ne $troff) { |
707
|
16
|
|
|
|
|
77
|
return ".ie n $command $nroff\n.el $command $troff\n"; |
708
|
|
|
|
|
|
|
} else { |
709
|
4
|
|
|
|
|
17
|
return "$command $nroff\n"; |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
} else { |
712
|
132
|
100
|
|
|
|
273
|
$text = qq("$text") . ($extra ? " $extra" : ''); |
713
|
132
|
|
|
|
|
375
|
return "$command $text\n"; |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
# Protect leading quotes and periods against interpretation as commands. Also |
718
|
|
|
|
|
|
|
# protect anything starting with a backslash, since it could expand or hide |
719
|
|
|
|
|
|
|
# something that *roff would interpret as a command. This is overkill, but |
720
|
|
|
|
|
|
|
# it's much simpler than trying to parse *roff here. |
721
|
|
|
|
|
|
|
sub protect { |
722
|
264
|
|
|
264
|
0
|
250
|
my ($self, $text) = @_; |
723
|
264
|
|
|
|
|
479
|
$text =~ s/^([.\'\\])/\\&$1/mg; |
724
|
264
|
|
|
|
|
446
|
return $text; |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
# Make vertical whitespace if NEEDSPACE is set, appropriate to the indentation |
728
|
|
|
|
|
|
|
# level the situation. This function is needed since in *roff one has to |
729
|
|
|
|
|
|
|
# create vertical whitespace after paragraphs and between some things, but |
730
|
|
|
|
|
|
|
# other macros create their own whitespace. Also close out a sequence of |
731
|
|
|
|
|
|
|
# repeated =items, since calling makespace means we're about to begin the item |
732
|
|
|
|
|
|
|
# body. |
733
|
|
|
|
|
|
|
sub makespace { |
734
|
285
|
|
|
285
|
|
230
|
my ($self) = @_; |
735
|
285
|
100
|
|
|
|
474
|
$self->output (".PD\n") if $$self{ITEMS} > 1; |
736
|
285
|
|
|
|
|
223
|
$$self{ITEMS} = 0; |
737
|
|
|
|
|
|
|
$self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n") |
738
|
285
|
100
|
|
|
|
637
|
if $$self{NEEDSPACE}; |
|
|
100
|
|
|
|
|
|
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
# Output any pending index entries, and optionally an index entry given as an |
742
|
|
|
|
|
|
|
# argument. Support multiple index entries in X<> separated by slashes, and |
743
|
|
|
|
|
|
|
# strip special escapes from index entries. |
744
|
|
|
|
|
|
|
sub outindex { |
745
|
391
|
|
|
391
|
0
|
366
|
my ($self, $section, $index) = @_; |
746
|
391
|
|
|
|
|
289
|
my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} }; |
|
5
|
|
|
|
|
22
|
|
|
391
|
|
|
|
|
552
|
|
747
|
391
|
100
|
100
|
|
|
1226
|
return unless ($section || @entries); |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
# We're about to output all pending entries, so clear our pending queue. |
750
|
118
|
|
|
|
|
132
|
$$self{INDEX} = []; |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
# Build the output. Regular index entries are marked Xref, and headings |
753
|
|
|
|
|
|
|
# pass in their own section. Undo some *roff formatting on headings. |
754
|
118
|
|
|
|
|
101
|
my @output; |
755
|
118
|
100
|
|
|
|
171
|
if (@entries) { |
756
|
5
|
|
|
|
|
14
|
push @output, [ 'Xref', join (' ', @entries) ]; |
757
|
|
|
|
|
|
|
} |
758
|
118
|
100
|
|
|
|
188
|
if ($section) { |
759
|
113
|
|
|
|
|
124
|
$index =~ s/\\-/-/g; |
760
|
113
|
|
|
|
|
214
|
$index =~ s/\\(?:s-?\d|.\(..|.)//g; |
761
|
113
|
|
|
|
|
176
|
push @output, [ $section, $index ]; |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
# Print out the .IX commands. |
765
|
118
|
|
|
|
|
157
|
for (@output) { |
766
|
118
|
|
|
|
|
151
|
my ($type, $entry) = @$_; |
767
|
118
|
|
|
|
|
339
|
$entry =~ s/\s+/ /g; |
768
|
118
|
|
|
|
|
120
|
$entry =~ s/\"/\"\"/g; |
769
|
118
|
|
|
|
|
100
|
$entry =~ s/\\/\\\\/g; |
770
|
118
|
|
|
|
|
292
|
$self->output (".IX $type " . '"' . $entry . '"' . "\n"); |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
} |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
# Output some text, without any additional changes. |
775
|
|
|
|
|
|
|
sub output { |
776
|
1213
|
|
|
1213
|
0
|
1293
|
my ($self, @text) = @_; |
777
|
1213
|
100
|
|
|
|
1677
|
if ($$self{ENCODE}) { |
778
|
18
|
|
|
|
|
14
|
print { $$self{output_fh} } Encode::encode ('UTF-8', join ('', @text)); |
|
18
|
|
|
|
|
55
|
|
779
|
|
|
|
|
|
|
} else { |
780
|
1195
|
|
|
|
|
733
|
print { $$self{output_fh} } @text; |
|
1195
|
|
|
|
|
2763
|
|
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
} |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
############################################################################## |
785
|
|
|
|
|
|
|
# Document initialization |
786
|
|
|
|
|
|
|
############################################################################## |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
# Handle the start of the document. Here we handle empty documents, as well |
789
|
|
|
|
|
|
|
# as setting up our basic macros in a preamble and building the page title. |
790
|
|
|
|
|
|
|
sub start_document { |
791
|
63
|
|
|
63
|
0
|
59
|
my ($self, $attrs) = @_; |
792
|
63
|
100
|
66
|
|
|
163
|
if ($$attrs{contentless} && !$$self{ALWAYS_EMIT_SOMETHING}) { |
793
|
1
|
|
|
|
|
2
|
DEBUG and print "Document is contentless\n"; |
794
|
1
|
|
|
|
|
2
|
$$self{CONTENTLESS} = 1; |
795
|
|
|
|
|
|
|
} else { |
796
|
62
|
|
|
|
|
71
|
delete $$self{CONTENTLESS}; |
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
# When UTF-8 output is set, check whether our output file handle already |
800
|
|
|
|
|
|
|
# has a PerlIO encoding layer set. If it does not, we'll need to encode |
801
|
|
|
|
|
|
|
# our output before printing it (handled in the output() sub). Wrap the |
802
|
|
|
|
|
|
|
# check in an eval to handle versions of Perl without PerlIO. |
803
|
63
|
|
|
|
|
69
|
$$self{ENCODE} = 0; |
804
|
63
|
100
|
|
|
|
107
|
if ($$self{utf8}) { |
805
|
4
|
|
|
|
|
10
|
$$self{ENCODE} = 1; |
806
|
4
|
|
|
|
|
6
|
eval { |
807
|
4
|
|
|
|
|
13
|
my @options = (output => 1, details => 1); |
808
|
4
|
|
|
|
|
32
|
my $flag = (PerlIO::get_layers ($$self{output_fh}, @options))[-1]; |
809
|
4
|
100
|
|
|
|
26
|
if ($flag & PerlIO::F_UTF8 ()) { |
810
|
2
|
|
|
|
|
7
|
$$self{ENCODE} = 0; |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
# Determine information for the preamble and then output it unless the |
816
|
|
|
|
|
|
|
# document was content-free. |
817
|
63
|
100
|
|
|
|
114
|
if (!$$self{CONTENTLESS}) { |
818
|
62
|
|
|
|
|
55
|
my ($name, $section); |
819
|
62
|
100
|
|
|
|
98
|
if (defined $$self{name}) { |
820
|
20
|
|
|
|
|
24
|
$name = $$self{name}; |
821
|
20
|
|
100
|
|
|
70
|
$section = $$self{section} || 1; |
822
|
|
|
|
|
|
|
} else { |
823
|
42
|
|
|
|
|
64
|
($name, $section) = $self->devise_title; |
824
|
|
|
|
|
|
|
} |
825
|
62
|
100
|
|
|
|
195
|
my $date = defined($$self{date}) ? $$self{date} : $self->devise_date; |
826
|
62
|
50
|
50
|
|
|
169
|
$self->preamble ($name, $section, $date) |
827
|
|
|
|
|
|
|
unless $self->bare_output or DEBUG > 9; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
# Initialize a few per-document variables. |
831
|
63
|
|
|
|
|
78
|
$$self{INDENT} = 0; # Current indentation level. |
832
|
63
|
|
|
|
|
82
|
$$self{INDENTS} = []; # Stack of indentations. |
833
|
63
|
|
|
|
|
99
|
$$self{INDEX} = []; # Index keys waiting to be printed. |
834
|
63
|
|
|
|
|
73
|
$$self{IN_NAME} = 0; # Whether processing the NAME section. |
835
|
63
|
|
|
|
|
54
|
$$self{ITEMS} = 0; # The number of consecutive =items. |
836
|
63
|
|
|
|
|
66
|
$$self{ITEMTYPES} = []; # Stack of =item types, one per list. |
837
|
63
|
|
|
|
|
64
|
$$self{SHIFTWAIT} = 0; # Whether there is a shift waiting. |
838
|
63
|
|
|
|
|
58
|
$$self{SHIFTS} = []; # Stack of .RS shifts. |
839
|
63
|
|
|
|
|
178
|
$$self{PENDING} = [[]]; # Pending output. |
840
|
|
|
|
|
|
|
} |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
# Handle the end of the document. This handles dying on POD errors, since |
843
|
|
|
|
|
|
|
# Pod::Parser currently doesn't. Otherwise, does nothing but print out a |
844
|
|
|
|
|
|
|
# final comment at the end of the document under debugging. |
845
|
|
|
|
|
|
|
sub end_document { |
846
|
63
|
|
|
63
|
0
|
62
|
my ($self) = @_; |
847
|
63
|
100
|
66
|
|
|
153
|
if ($$self{complain_die} && $self->errors_seen) { |
848
|
1
|
|
|
|
|
264
|
croak ("POD document had syntax errors"); |
849
|
|
|
|
|
|
|
} |
850
|
62
|
50
|
|
|
|
144
|
return if $self->bare_output; |
851
|
62
|
100
|
66
|
|
|
427
|
return if ($$self{CONTENTLESS} && !$$self{ALWAYS_EMIT_SOMETHING}); |
852
|
61
|
|
|
|
|
102
|
$self->output (q(.\" [End document]) . "\n") if DEBUG; |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
# Try to figure out the name and section from the file name and return them as |
856
|
|
|
|
|
|
|
# a list, returning an empty name and section 1 if we can't find any better |
857
|
|
|
|
|
|
|
# information. Uses File::Basename and File::Spec as necessary. |
858
|
|
|
|
|
|
|
sub devise_title { |
859
|
44
|
|
|
44
|
0
|
1114
|
my ($self) = @_; |
860
|
44
|
|
100
|
|
|
95
|
my $name = $self->source_filename || ''; |
861
|
44
|
|
50
|
|
|
355
|
my $section = $$self{section} || 1; |
862
|
44
|
100
|
66
|
|
|
214
|
$section = 3 if (!$$self{section} && $name =~ /\.pm\z/i); |
863
|
44
|
|
|
|
|
138
|
$name =~ s/\.p(od|[lm])\z//i; |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
# If Pod::Parser gave us an IO::File reference as the source file name, |
866
|
|
|
|
|
|
|
# convert that to the empty string as well. Then, if we don't have a |
867
|
|
|
|
|
|
|
# valid name, convert it to STDIN. |
868
|
|
|
|
|
|
|
# |
869
|
|
|
|
|
|
|
# In podlators 4.00 through 4.07, this also produced a warning, but that |
870
|
|
|
|
|
|
|
# was surprising to a lot of programs that had expected to be able to pipe |
871
|
|
|
|
|
|
|
# POD through pod2man without specifying the name. In the name of |
872
|
|
|
|
|
|
|
# backward compatibility, just quietly set STDIN as the page title. |
873
|
44
|
100
|
|
|
|
84
|
if ($name =~ /^IO::File(?:=\w+)\(0x[\da-f]+\)$/i) { |
874
|
2
|
|
|
|
|
3
|
$name = ''; |
875
|
|
|
|
|
|
|
} |
876
|
44
|
100
|
|
|
|
67
|
if ($name eq '') { |
877
|
5
|
|
|
|
|
6
|
$name = 'STDIN'; |
878
|
|
|
|
|
|
|
} |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
# If the section isn't 3, then the name defaults to just the basename of |
881
|
|
|
|
|
|
|
# the file. |
882
|
44
|
100
|
|
|
|
81
|
if ($section !~ /^3/) { |
883
|
43
|
|
|
|
|
197
|
require File::Basename; |
884
|
43
|
|
|
|
|
1017
|
$name = uc File::Basename::basename ($name); |
885
|
|
|
|
|
|
|
} else { |
886
|
1
|
|
|
|
|
6
|
require File::Spec; |
887
|
1
|
|
|
|
|
24
|
my ($volume, $dirs, $file) = File::Spec->splitpath ($name); |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
# Otherwise, assume we're dealing with a module. We want to figure |
890
|
|
|
|
|
|
|
# out the full module name from the path to the file, but we don't |
891
|
|
|
|
|
|
|
# want to include too much of the path into the module name. Lose |
892
|
|
|
|
|
|
|
# anything up to the first of: |
893
|
|
|
|
|
|
|
# |
894
|
|
|
|
|
|
|
# */lib/*perl*/ standard or site_perl module |
895
|
|
|
|
|
|
|
# */*perl*/lib/ from -Dprefix=/opt/perl |
896
|
|
|
|
|
|
|
# */*perl*/ random module hierarchy |
897
|
|
|
|
|
|
|
# |
898
|
|
|
|
|
|
|
# Also strip off a leading site, site_perl, or vendor_perl component, |
899
|
|
|
|
|
|
|
# any OS-specific component, and any version number component, and |
900
|
|
|
|
|
|
|
# strip off an initial component of "lib" or "blib/lib" since that's |
901
|
|
|
|
|
|
|
# what ExtUtils::MakeMaker creates. |
902
|
|
|
|
|
|
|
# |
903
|
|
|
|
|
|
|
# splitdir requires at least File::Spec 0.8. |
904
|
1
|
|
|
|
|
11
|
my @dirs = File::Spec->splitdir ($dirs); |
905
|
1
|
50
|
|
|
|
6
|
if (@dirs) { |
906
|
0
|
|
|
|
|
0
|
my $cut = 0; |
907
|
0
|
|
|
|
|
0
|
my $i; |
908
|
0
|
|
|
|
|
0
|
for ($i = 0; $i < @dirs; $i++) { |
909
|
0
|
0
|
|
|
|
0
|
if ($dirs[$i] =~ /perl/) { |
910
|
0
|
|
|
|
|
0
|
$cut = $i + 1; |
911
|
0
|
0
|
0
|
|
|
0
|
$cut++ if ($dirs[$i + 1] && $dirs[$i + 1] eq 'lib'); |
912
|
0
|
|
|
|
|
0
|
last; |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
} |
915
|
0
|
0
|
|
|
|
0
|
if ($cut > 0) { |
916
|
0
|
|
|
|
|
0
|
splice (@dirs, 0, $cut); |
917
|
0
|
0
|
|
|
|
0
|
shift @dirs if ($dirs[0] =~ /^(site|vendor)(_perl)?$/); |
918
|
0
|
0
|
|
|
|
0
|
shift @dirs if ($dirs[0] =~ /^[\d.]+$/); |
919
|
0
|
0
|
|
|
|
0
|
shift @dirs if ($dirs[0] =~ /^(.*-$^O|$^O-.*|$^O)$/); |
920
|
|
|
|
|
|
|
} |
921
|
0
|
0
|
|
|
|
0
|
shift @dirs if $dirs[0] eq 'lib'; |
922
|
0
|
0
|
0
|
|
|
0
|
splice (@dirs, 0, 2) if ($dirs[0] eq 'blib' && $dirs[1] eq 'lib'); |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
# Remove empty directories when building the module name; they |
926
|
|
|
|
|
|
|
# occur too easily on Unix by doubling slashes. |
927
|
1
|
0
|
|
|
|
4
|
$name = join ('::', (grep { $_ ? $_ : () } @dirs), $file); |
|
0
|
|
|
|
|
0
|
|
928
|
|
|
|
|
|
|
} |
929
|
44
|
|
|
|
|
95
|
return ($name, $section); |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
# Determine the modification date and return that, properly formatted in ISO |
933
|
|
|
|
|
|
|
# format. |
934
|
|
|
|
|
|
|
# |
935
|
|
|
|
|
|
|
# If POD_MAN_DATE is set, that overrides anything else. This can be used for |
936
|
|
|
|
|
|
|
# reproducible generation of the same file even if the input file timestamps |
937
|
|
|
|
|
|
|
# are unpredictable or the POD coms from standard input. |
938
|
|
|
|
|
|
|
# |
939
|
|
|
|
|
|
|
# Otherwise, if SOURCE_DATE_EPOCH is set and can be parsed as seconds since |
940
|
|
|
|
|
|
|
# the UNIX epoch, base the timestamp on that. See |
941
|
|
|
|
|
|
|
# |
942
|
|
|
|
|
|
|
# |
943
|
|
|
|
|
|
|
# Otherwise, use the modification date of the input if we can stat it. Be |
944
|
|
|
|
|
|
|
# aware that Pod::Simple returns the stringification of the file handle as |
945
|
|
|
|
|
|
|
# source_filename for input from a file handle, so we'll stat some random ref |
946
|
|
|
|
|
|
|
# string in that case. If that fails, instead use the current time. |
947
|
|
|
|
|
|
|
# |
948
|
|
|
|
|
|
|
# $self - Pod::Man object, used to get the source file |
949
|
|
|
|
|
|
|
# |
950
|
|
|
|
|
|
|
# Returns: YYYY-MM-DD date suitable for the left-hand footer |
951
|
|
|
|
|
|
|
sub devise_date { |
952
|
64
|
|
|
64
|
0
|
71
|
my ($self) = @_; |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
# If POD_MAN_DATE is set, always use it. |
955
|
64
|
100
|
|
|
|
126
|
if (defined($ENV{POD_MAN_DATE})) { |
956
|
3
|
|
|
|
|
10
|
return $ENV{POD_MAN_DATE}; |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
# If SOURCE_DATE_EPOCH is set and can be parsed, use that. |
960
|
61
|
|
|
|
|
52
|
my $time; |
961
|
61
|
100
|
100
|
|
|
137
|
if (defined($ENV{SOURCE_DATE_EPOCH}) && $ENV{SOURCE_DATE_EPOCH} !~ /\D/) { |
962
|
1
|
|
|
|
|
2
|
$time = $ENV{SOURCE_DATE_EPOCH}; |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
# Otherwise, get the input filename and try to stat it. If that fails, |
966
|
|
|
|
|
|
|
# use the current time. |
967
|
61
|
100
|
|
|
|
105
|
if (!defined $time) { |
968
|
60
|
|
|
|
|
125
|
my $input = $self->source_filename; |
969
|
60
|
100
|
|
|
|
296
|
if ($input) { |
970
|
43
|
|
66
|
|
|
508
|
$time = (stat($input))[9] || time(); |
971
|
|
|
|
|
|
|
} else { |
972
|
17
|
|
|
|
|
33
|
$time = time(); |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
} |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
# Can't use POSIX::strftime(), which uses Fcntl, because MakeMaker uses |
977
|
|
|
|
|
|
|
# this and it has to work in the core which can't load dynamic libraries. |
978
|
|
|
|
|
|
|
# Use gmtime instead of localtime so that the generated man page does not |
979
|
|
|
|
|
|
|
# depend on the local time zone setting and is more reproducible |
980
|
61
|
|
|
|
|
344
|
my ($year, $month, $day) = (gmtime($time))[5,4,3]; |
981
|
61
|
|
|
|
|
469
|
return sprintf("%04d-%02d-%02d", $year + 1900, $month + 1, $day); |
982
|
|
|
|
|
|
|
} |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
# Print out the preamble and the title. The meaning of the arguments to .TH |
985
|
|
|
|
|
|
|
# unfortunately vary by system; some systems consider the fourth argument to |
986
|
|
|
|
|
|
|
# be a "source" and others use it as a version number. Generally it's just |
987
|
|
|
|
|
|
|
# presented as the left-side footer, though, so it doesn't matter too much if |
988
|
|
|
|
|
|
|
# a particular system gives it another interpretation. |
989
|
|
|
|
|
|
|
# |
990
|
|
|
|
|
|
|
# The order of date and release used to be reversed in older versions of this |
991
|
|
|
|
|
|
|
# module, but this order is correct for both Solaris and Linux. |
992
|
|
|
|
|
|
|
sub preamble { |
993
|
62
|
|
|
62
|
0
|
493
|
my ($self, $name, $section, $date) = @_; |
994
|
62
|
|
|
|
|
125
|
my $preamble = $self->preamble_template (!$$self{utf8}); |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
# Build the index line and make sure that it will be syntactically valid. |
997
|
62
|
|
|
|
|
87
|
my $index = "$name $section"; |
998
|
62
|
|
|
|
|
83
|
$index =~ s/\"/\"\"/g; |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
# If name or section contain spaces, quote them (section really never |
1001
|
|
|
|
|
|
|
# should, but we may as well be cautious). |
1002
|
62
|
|
|
|
|
97
|
for ($name, $section) { |
1003
|
124
|
50
|
|
|
|
252
|
if (/\s/) { |
1004
|
0
|
|
|
|
|
0
|
s/\"/\"\"/g; |
1005
|
0
|
|
|
|
|
0
|
$_ = '"' . $_ . '"'; |
1006
|
|
|
|
|
|
|
} |
1007
|
|
|
|
|
|
|
} |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
# Double quotes in date, since it will be quoted. |
1010
|
62
|
|
|
|
|
69
|
$date =~ s/\"/\"\"/g; |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
# Substitute into the preamble the configuration options. |
1013
|
62
|
|
|
|
|
405
|
$preamble =~ s/\@CFONT\@/$$self{fixed}/; |
1014
|
62
|
|
|
|
|
313
|
$preamble =~ s/\@LQUOTE\@/$$self{LQUOTE}/; |
1015
|
62
|
|
|
|
|
315
|
$preamble =~ s/\@RQUOTE\@/$$self{RQUOTE}/; |
1016
|
62
|
|
|
|
|
77
|
chomp $preamble; |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
# Get the version information. |
1019
|
62
|
|
|
|
|
167
|
my $version = $self->version_report; |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
# Finally output everything. |
1022
|
62
|
|
|
|
|
1370
|
$self->output (<<"----END OF HEADER----"); |
1023
|
|
|
|
|
|
|
.\\" Automatically generated by $version |
1024
|
|
|
|
|
|
|
.\\" |
1025
|
|
|
|
|
|
|
.\\" Standard preamble: |
1026
|
|
|
|
|
|
|
.\\" ======================================================================== |
1027
|
|
|
|
|
|
|
$preamble |
1028
|
|
|
|
|
|
|
.\\" ======================================================================== |
1029
|
|
|
|
|
|
|
.\\" |
1030
|
|
|
|
|
|
|
.IX Title "$index" |
1031
|
|
|
|
|
|
|
.TH $name $section "$date" "$$self{release}" "$$self{center}" |
1032
|
|
|
|
|
|
|
.\\" For nroff, turn off justification. Always turn off hyphenation; it makes |
1033
|
|
|
|
|
|
|
.\\" way too many mistakes in technical documents. |
1034
|
|
|
|
|
|
|
.if n .ad l |
1035
|
|
|
|
|
|
|
.nh |
1036
|
|
|
|
|
|
|
----END OF HEADER---- |
1037
|
62
|
|
|
|
|
341
|
$self->output (".\\\" [End of preamble]\n") if DEBUG; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
############################################################################## |
1041
|
|
|
|
|
|
|
# Text blocks |
1042
|
|
|
|
|
|
|
############################################################################## |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
# Handle a basic block of text. The only tricky part of this is if this is |
1045
|
|
|
|
|
|
|
# the first paragraph of text after an =over, in which case we have to change |
1046
|
|
|
|
|
|
|
# indentations for *roff. |
1047
|
|
|
|
|
|
|
sub cmd_para { |
1048
|
244
|
|
|
244
|
0
|
253
|
my ($self, $attrs, $text) = @_; |
1049
|
244
|
|
|
|
|
213
|
my $line = $$attrs{start_line}; |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
# Output the paragraph. We also have to handle =over without =item. If |
1052
|
|
|
|
|
|
|
# there's an =over without =item, SHIFTWAIT will be set, and we need to |
1053
|
|
|
|
|
|
|
# handle creation of the indent here. Add the shift to SHIFTS so that it |
1054
|
|
|
|
|
|
|
# will be cleaned up on =back. |
1055
|
244
|
|
|
|
|
340
|
$self->makespace; |
1056
|
244
|
100
|
|
|
|
891
|
if ($$self{SHIFTWAIT}) { |
1057
|
4
|
|
|
|
|
10
|
$self->output (".RS $$self{INDENT}\n"); |
1058
|
4
|
|
|
|
|
15
|
push (@{ $$self{SHIFTS} }, $$self{INDENT}); |
|
4
|
|
|
|
|
7
|
|
1059
|
4
|
|
|
|
|
6
|
$$self{SHIFTWAIT} = 0; |
1060
|
|
|
|
|
|
|
} |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
# Add the line number for debugging, but not in the NAME section just in |
1063
|
|
|
|
|
|
|
# case the comment would confuse apropos. |
1064
|
|
|
|
|
|
|
$self->output (".\\\" [At source line $line]\n") |
1065
|
244
|
50
|
50
|
|
|
812
|
if defined ($line) && DEBUG && !$$self{IN_NAME}; |
|
|
|
33
|
|
|
|
|
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
# Force exactly one newline at the end and strip unwanted trailing |
1068
|
|
|
|
|
|
|
# whitespace at the end, but leave "\ " backslashed space from an S< > at |
1069
|
|
|
|
|
|
|
# the end of a line. Reverse the text first, to avoid having to scan the |
1070
|
|
|
|
|
|
|
# entire paragraph. |
1071
|
244
|
|
|
|
|
337
|
$text = reverse $text; |
1072
|
244
|
|
|
|
|
760
|
$text =~ s/\A\s*?(?= \\|\S|\z)/\n/; |
1073
|
244
|
|
|
|
|
314
|
$text = reverse $text; |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
# Output the paragraph. |
1076
|
244
|
|
|
|
|
370
|
$self->output ($self->protect ($self->textmapfonts ($text))); |
1077
|
244
|
|
|
|
|
1169
|
$self->outindex; |
1078
|
244
|
|
|
|
|
238
|
$$self{NEEDSPACE} = 1; |
1079
|
244
|
|
|
|
|
266
|
return ''; |
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
# Handle a verbatim paragraph. Put a null token at the beginning of each line |
1083
|
|
|
|
|
|
|
# to protect against commands and wrap in .Vb/.Ve (which we define in our |
1084
|
|
|
|
|
|
|
# prelude). |
1085
|
|
|
|
|
|
|
sub cmd_verbatim { |
1086
|
13
|
|
|
13
|
0
|
17
|
my ($self, $attrs, $text) = @_; |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
# Ignore an empty verbatim paragraph. |
1089
|
13
|
50
|
|
|
|
48
|
return unless $text =~ /\S/; |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
# Force exactly one newline at the end and strip unwanted trailing |
1092
|
|
|
|
|
|
|
# whitespace at the end. Reverse the text first, to avoid having to scan |
1093
|
|
|
|
|
|
|
# the entire paragraph. |
1094
|
13
|
|
|
|
|
27
|
$text = reverse $text; |
1095
|
13
|
|
|
|
|
36
|
$text =~ s/\A\s*/\n/; |
1096
|
13
|
|
|
|
|
23
|
$text = reverse $text; |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
# Get a count of the number of lines before the first blank line, which |
1099
|
|
|
|
|
|
|
# we'll pass to .Vb as its parameter. This tells *roff to keep that many |
1100
|
|
|
|
|
|
|
# lines together. We don't want to tell *roff to keep huge blocks |
1101
|
|
|
|
|
|
|
# together. |
1102
|
13
|
|
|
|
|
44
|
my @lines = split (/\n/, $text); |
1103
|
13
|
|
|
|
|
15
|
my $unbroken = 0; |
1104
|
13
|
|
|
|
|
20
|
for (@lines) { |
1105
|
61
|
100
|
|
|
|
102
|
last if /^\s*$/; |
1106
|
57
|
|
|
|
|
46
|
$unbroken++; |
1107
|
|
|
|
|
|
|
} |
1108
|
13
|
50
|
33
|
|
|
36
|
$unbroken = 10 if ($unbroken > 12 && !$$self{MAGIC_VNOPAGEBREAK_LIMIT}); |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
# Prepend a null token to each line. |
1111
|
13
|
|
|
|
|
67
|
$text =~ s/^/\\&/gm; |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
# Output the results. |
1114
|
13
|
|
|
|
|
30
|
$self->makespace; |
1115
|
13
|
|
|
|
|
102
|
$self->output (".Vb $unbroken\n$text.Ve\n"); |
1116
|
13
|
|
|
|
|
76
|
$$self{NEEDSPACE} = 1; |
1117
|
13
|
|
|
|
|
23
|
return ''; |
1118
|
|
|
|
|
|
|
} |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
# Handle literal text (produced by =for and similar constructs). Just output |
1121
|
|
|
|
|
|
|
# it with the minimum of changes. |
1122
|
|
|
|
|
|
|
sub cmd_data { |
1123
|
4
|
|
|
4
|
0
|
3
|
my ($self, $attrs, $text) = @_; |
1124
|
4
|
|
|
|
|
10
|
$text =~ s/^\n+//; |
1125
|
4
|
|
|
|
|
13
|
$text =~ s/\n{0,2}$/\n/; |
1126
|
4
|
|
|
|
|
6
|
$self->output ($text); |
1127
|
4
|
|
|
|
|
4
|
return ''; |
1128
|
|
|
|
|
|
|
} |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
############################################################################## |
1131
|
|
|
|
|
|
|
# Headings |
1132
|
|
|
|
|
|
|
############################################################################## |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
# Common code for all headings. This is called before the actual heading is |
1135
|
|
|
|
|
|
|
# output. It returns the cleaned up heading text (putting the heading all on |
1136
|
|
|
|
|
|
|
# one line) and may do other things, like closing bad =item blocks. |
1137
|
|
|
|
|
|
|
sub heading_common { |
1138
|
86
|
|
|
86
|
0
|
83
|
my ($self, $text, $line) = @_; |
1139
|
86
|
|
|
|
|
170
|
$text =~ s/\s+$//; |
1140
|
86
|
|
|
|
|
79
|
$text =~ s/\s*\n\s*/ /g; |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
# This should never happen; it means that we have a heading after =item |
1143
|
|
|
|
|
|
|
# without an intervening =back. But just in case, handle it anyway. |
1144
|
86
|
50
|
|
|
|
174
|
if ($$self{ITEMS} > 1) { |
1145
|
0
|
|
|
|
|
0
|
$$self{ITEMS} = 0; |
1146
|
0
|
|
|
|
|
0
|
$self->output (".PD\n"); |
1147
|
|
|
|
|
|
|
} |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
# Output the current source line. |
1150
|
86
|
50
|
50
|
|
|
283
|
$self->output ( ".\\\" [At source line $line]\n" ) |
1151
|
|
|
|
|
|
|
if defined ($line) && DEBUG; |
1152
|
86
|
|
|
|
|
145
|
return $text; |
1153
|
|
|
|
|
|
|
} |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
# First level heading. We can't output .IX in the NAME section due to a bug |
1156
|
|
|
|
|
|
|
# in some versions of catman, so don't output a .IX for that section. .SH |
1157
|
|
|
|
|
|
|
# already uses small caps, so remove \s0 and \s-1. Maintain IN_NAME as |
1158
|
|
|
|
|
|
|
# appropriate. |
1159
|
|
|
|
|
|
|
sub cmd_head1 { |
1160
|
73
|
|
|
73
|
0
|
75
|
my ($self, $attrs, $text) = @_; |
1161
|
73
|
|
|
|
|
265
|
$text =~ s/\\s-?\d//g; |
1162
|
73
|
|
|
|
|
163
|
$text = $self->heading_common ($text, $$attrs{start_line}); |
1163
|
73
|
|
66
|
|
|
239
|
my $isname = ($text eq 'NAME' || $text =~ /\(NAME\)/); |
1164
|
73
|
|
|
|
|
141
|
$self->output ($self->switchquotes ('.SH', $self->mapfonts ($text))); |
1165
|
73
|
100
|
|
|
|
486
|
$self->outindex ('Header', $text) unless $isname; |
1166
|
73
|
|
|
|
|
279
|
$$self{NEEDSPACE} = 0; |
1167
|
73
|
|
|
|
|
79
|
$$self{IN_NAME} = $isname; |
1168
|
73
|
|
|
|
|
80
|
return ''; |
1169
|
|
|
|
|
|
|
} |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
# Second level heading. |
1172
|
|
|
|
|
|
|
sub cmd_head2 { |
1173
|
5
|
|
|
5
|
0
|
9
|
my ($self, $attrs, $text) = @_; |
1174
|
5
|
|
|
|
|
11
|
$text = $self->heading_common ($text, $$attrs{start_line}); |
1175
|
5
|
|
|
|
|
12
|
$self->output ($self->switchquotes ('.SS', $self->mapfonts ($text))); |
1176
|
5
|
|
|
|
|
28
|
$self->outindex ('Subsection', $text); |
1177
|
5
|
|
|
|
|
23
|
$$self{NEEDSPACE} = 0; |
1178
|
5
|
|
|
|
|
39
|
return ''; |
1179
|
|
|
|
|
|
|
} |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
# Third level heading. *roff doesn't have this concept, so just put the |
1182
|
|
|
|
|
|
|
# heading in italics as a normal paragraph. |
1183
|
|
|
|
|
|
|
sub cmd_head3 { |
1184
|
4
|
|
|
4
|
0
|
5
|
my ($self, $attrs, $text) = @_; |
1185
|
4
|
|
|
|
|
11
|
$text = $self->heading_common ($text, $$attrs{start_line}); |
1186
|
4
|
|
|
|
|
10
|
$self->makespace; |
1187
|
4
|
|
|
|
|
19
|
$self->output ($self->textmapfonts ('\f(IS' . $text . '\f(IE') . "\n"); |
1188
|
4
|
|
|
|
|
28
|
$self->outindex ('Subsection', $text); |
1189
|
4
|
|
|
|
|
22
|
$$self{NEEDSPACE} = 1; |
1190
|
4
|
|
|
|
|
6
|
return ''; |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
# Fourth level heading. *roff doesn't have this concept, so just put the |
1194
|
|
|
|
|
|
|
# heading as a normal paragraph. |
1195
|
|
|
|
|
|
|
sub cmd_head4 { |
1196
|
4
|
|
|
4
|
0
|
6
|
my ($self, $attrs, $text) = @_; |
1197
|
4
|
|
|
|
|
10
|
$text = $self->heading_common ($text, $$attrs{start_line}); |
1198
|
4
|
|
|
|
|
10
|
$self->makespace; |
1199
|
4
|
|
|
|
|
24
|
$self->output ($self->textmapfonts ($text) . "\n"); |
1200
|
4
|
|
|
|
|
23
|
$self->outindex ('Subsection', $text); |
1201
|
4
|
|
|
|
|
22
|
$$self{NEEDSPACE} = 1; |
1202
|
4
|
|
|
|
|
6
|
return ''; |
1203
|
|
|
|
|
|
|
} |
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
############################################################################## |
1206
|
|
|
|
|
|
|
# Formatting codes |
1207
|
|
|
|
|
|
|
############################################################################## |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
# All of the formatting codes that aren't handled internally by the parser, |
1210
|
|
|
|
|
|
|
# other than L<> and X<>. |
1211
|
17
|
100
|
|
17
|
0
|
55
|
sub cmd_b { return $_[0]->{IN_NAME} ? $_[2] : '\f(BS' . $_[2] . '\f(BE' } |
1212
|
31
|
100
|
|
31
|
0
|
86
|
sub cmd_i { return $_[0]->{IN_NAME} ? $_[2] : '\f(IS' . $_[2] . '\f(IE' } |
1213
|
7
|
100
|
|
7
|
0
|
24
|
sub cmd_f { return $_[0]->{IN_NAME} ? $_[2] : '\f(IS' . $_[2] . '\f(IE' } |
1214
|
73
|
|
|
73
|
0
|
101
|
sub cmd_c { return $_[0]->quote_literal ($_[2]) } |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
# Index entries are just added to the pending entries. |
1217
|
|
|
|
|
|
|
sub cmd_x { |
1218
|
5
|
|
|
5
|
0
|
9
|
my ($self, $attrs, $text) = @_; |
1219
|
5
|
|
|
|
|
5
|
push (@{ $$self{INDEX} }, $text); |
|
5
|
|
|
|
|
15
|
|
1220
|
5
|
|
|
|
|
9
|
return ''; |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
# Links reduce to the text that we're given, wrapped in angle brackets if it's |
1224
|
|
|
|
|
|
|
# a URL, followed by the URL. We take an option to suppress the URL if anchor |
1225
|
|
|
|
|
|
|
# text is given. We need to format the "to" value of the link before |
1226
|
|
|
|
|
|
|
# comparing it to the text since we may escape hyphens. |
1227
|
|
|
|
|
|
|
sub cmd_l { |
1228
|
58
|
|
|
58
|
0
|
59
|
my ($self, $attrs, $text) = @_; |
1229
|
58
|
100
|
|
|
|
86
|
if ($$attrs{type} eq 'url') { |
1230
|
4
|
|
|
|
|
5
|
my $to = $$attrs{to}; |
1231
|
4
|
50
|
|
|
|
8
|
if (defined $to) { |
1232
|
4
|
|
|
|
|
8
|
my $tag = $$self{PENDING}[-1]; |
1233
|
4
|
|
|
|
|
8
|
$to = $self->format_text ($$tag[1], $to); |
1234
|
|
|
|
|
|
|
} |
1235
|
4
|
100
|
66
|
|
|
18
|
if (not defined ($to) or $to eq $text) { |
|
|
100
|
|
|
|
|
|
1236
|
1
|
|
|
|
|
4
|
return "<$text>"; |
1237
|
|
|
|
|
|
|
} elsif ($$self{nourls}) { |
1238
|
1
|
|
|
|
|
12
|
return $text; |
1239
|
|
|
|
|
|
|
} else { |
1240
|
2
|
|
|
|
|
23
|
return "$text <$$attrs{to}>"; |
1241
|
|
|
|
|
|
|
} |
1242
|
|
|
|
|
|
|
} else { |
1243
|
54
|
|
|
|
|
123
|
return $text; |
1244
|
|
|
|
|
|
|
} |
1245
|
|
|
|
|
|
|
} |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
############################################################################## |
1248
|
|
|
|
|
|
|
# List handling |
1249
|
|
|
|
|
|
|
############################################################################## |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
# Handle the beginning of an =over block. Takes the type of the block as the |
1252
|
|
|
|
|
|
|
# first argument, and then the attr hash. This is called by the handlers for |
1253
|
|
|
|
|
|
|
# the four different types of lists (bullet, number, text, and block). |
1254
|
|
|
|
|
|
|
sub over_common_start { |
1255
|
42
|
|
|
42
|
0
|
42
|
my ($self, $type, $attrs) = @_; |
1256
|
42
|
|
|
|
|
41
|
my $line = $$attrs{start_line}; |
1257
|
42
|
|
|
|
|
40
|
my $indent = $$attrs{indent}; |
1258
|
42
|
|
|
|
|
31
|
DEBUG > 3 and print " Starting =over $type (line $line, indent ", |
1259
|
|
|
|
|
|
|
($indent || '?'), "\n"; |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
# Find the indentation level. |
1262
|
42
|
50
|
33
|
|
|
219
|
unless (defined ($indent) && $indent =~ /^[-+]?\d{1,4}\s*$/) { |
1263
|
0
|
|
|
|
|
0
|
$indent = $$self{indent}; |
1264
|
|
|
|
|
|
|
} |
1265
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
# If we've gotten multiple indentations in a row, we need to emit the |
1267
|
|
|
|
|
|
|
# pending indentation for the last level that we saw and haven't acted on |
1268
|
|
|
|
|
|
|
# yet. SHIFTS is the stack of indentations that we've actually emitted |
1269
|
|
|
|
|
|
|
# code for. |
1270
|
42
|
100
|
|
|
|
34
|
if (@{ $$self{SHIFTS} } < @{ $$self{INDENTS} }) { |
|
42
|
|
|
|
|
53
|
|
|
42
|
|
|
|
|
76
|
|
1271
|
7
|
|
|
|
|
16
|
$self->output (".RS $$self{INDENT}\n"); |
1272
|
7
|
|
|
|
|
31
|
push (@{ $$self{SHIFTS} }, $$self{INDENT}); |
|
7
|
|
|
|
|
14
|
|
1273
|
|
|
|
|
|
|
} |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
# Now, do record-keeping. INDENTS is a stack of indentations that we've |
1276
|
|
|
|
|
|
|
# seen so far, and INDENT is the current level of indentation. ITEMTYPES |
1277
|
|
|
|
|
|
|
# is a stack of list types that we've seen. |
1278
|
42
|
|
|
|
|
37
|
push (@{ $$self{INDENTS} }, $$self{INDENT}); |
|
42
|
|
|
|
|
67
|
|
1279
|
42
|
|
|
|
|
30
|
push (@{ $$self{ITEMTYPES} }, $type); |
|
42
|
|
|
|
|
52
|
|
1280
|
42
|
|
|
|
|
120
|
$$self{INDENT} = $indent + 0; |
1281
|
42
|
|
|
|
|
85
|
$$self{SHIFTWAIT} = 1; |
1282
|
|
|
|
|
|
|
} |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
# End an =over block. Takes no options other than the class pointer. |
1285
|
|
|
|
|
|
|
# Normally, once we close a block and therefore remove something from INDENTS, |
1286
|
|
|
|
|
|
|
# INDENTS will now be longer than SHIFTS, indicating that we also need to emit |
1287
|
|
|
|
|
|
|
# *roff code to close the indent. This isn't *always* true, depending on the |
1288
|
|
|
|
|
|
|
# circumstance. If we're still inside an indentation, we need to emit another |
1289
|
|
|
|
|
|
|
# .RE and then a new .RS to unconfuse *roff. |
1290
|
|
|
|
|
|
|
sub over_common_end { |
1291
|
42
|
|
|
42
|
0
|
40
|
my ($self) = @_; |
1292
|
42
|
|
|
|
|
32
|
DEBUG > 3 and print " Ending =over\n"; |
1293
|
42
|
|
|
|
|
27
|
$$self{INDENT} = pop @{ $$self{INDENTS} }; |
|
42
|
|
|
|
|
70
|
|
1294
|
42
|
|
|
|
|
30
|
pop @{ $$self{ITEMTYPES} }; |
|
42
|
|
|
|
|
46
|
|
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
# If we emitted code for that indentation, end it. |
1297
|
42
|
100
|
|
|
|
27
|
if (@{ $$self{SHIFTS} } > @{ $$self{INDENTS} }) { |
|
42
|
|
|
|
|
41
|
|
|
42
|
|
|
|
|
82
|
|
1298
|
9
|
|
|
|
|
14
|
$self->output (".RE\n"); |
1299
|
9
|
|
|
|
|
40
|
pop @{ $$self{SHIFTS} }; |
|
9
|
|
|
|
|
13
|
|
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
# If we're still in an indentation, *roff will have now lost track of the |
1303
|
|
|
|
|
|
|
# right depth of that indentation, so fix that. |
1304
|
42
|
100
|
|
|
|
37
|
if (@{ $$self{INDENTS} } > 0) { |
|
42
|
|
|
|
|
79
|
|
1305
|
9
|
|
|
|
|
15
|
$self->output (".RE\n"); |
1306
|
9
|
|
|
|
|
86
|
$self->output (".RS $$self{INDENT}\n"); |
1307
|
|
|
|
|
|
|
} |
1308
|
42
|
|
|
|
|
65
|
$$self{NEEDSPACE} = 1; |
1309
|
42
|
|
|
|
|
95
|
$$self{SHIFTWAIT} = 0; |
1310
|
|
|
|
|
|
|
} |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
# Dispatch the start and end calls as appropriate. |
1313
|
6
|
|
|
6
|
0
|
8
|
sub start_over_bullet { my $s = shift; $s->over_common_start ('bullet', @_) } |
|
6
|
|
|
|
|
15
|
|
1314
|
4
|
|
|
4
|
0
|
6
|
sub start_over_number { my $s = shift; $s->over_common_start ('number', @_) } |
|
4
|
|
|
|
|
8
|
|
1315
|
26
|
|
|
26
|
0
|
26
|
sub start_over_text { my $s = shift; $s->over_common_start ('text', @_) } |
|
26
|
|
|
|
|
57
|
|
1316
|
6
|
|
|
6
|
0
|
7
|
sub start_over_block { my $s = shift; $s->over_common_start ('block', @_) } |
|
6
|
|
|
|
|
10
|
|
1317
|
6
|
|
|
6
|
0
|
20
|
sub end_over_bullet { $_[0]->over_common_end } |
1318
|
4
|
|
|
4
|
0
|
9
|
sub end_over_number { $_[0]->over_common_end } |
1319
|
26
|
|
|
26
|
0
|
46
|
sub end_over_text { $_[0]->over_common_end } |
1320
|
6
|
|
|
6
|
0
|
11
|
sub end_over_block { $_[0]->over_common_end } |
1321
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
# The common handler for all item commands. Takes the type of the item, the |
1323
|
|
|
|
|
|
|
# attributes, and then the text of the item. |
1324
|
|
|
|
|
|
|
# |
1325
|
|
|
|
|
|
|
# Emit an index entry for anything that's interesting, but don't emit index |
1326
|
|
|
|
|
|
|
# entries for things like bullets and numbers. Newlines in an item title are |
1327
|
|
|
|
|
|
|
# turned into spaces since *roff can't handle them embedded. |
1328
|
|
|
|
|
|
|
sub item_common { |
1329
|
74
|
|
|
74
|
0
|
75
|
my ($self, $type, $attrs, $text) = @_; |
1330
|
74
|
|
|
|
|
71
|
my $line = $$attrs{start_line}; |
1331
|
74
|
|
|
|
|
42
|
DEBUG > 3 and print " $type item (line $line): $text\n"; |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
# Clean up the text. We want to end up with two variables, one ($text) |
1334
|
|
|
|
|
|
|
# which contains any body text after taking out the item portion, and |
1335
|
|
|
|
|
|
|
# another ($item) which contains the actual item text. |
1336
|
74
|
|
|
|
|
133
|
$text =~ s/\s+$//; |
1337
|
74
|
|
|
|
|
50
|
my ($item, $index); |
1338
|
74
|
100
|
|
|
|
142
|
if ($type eq 'bullet') { |
|
|
100
|
|
|
|
|
|
1339
|
12
|
|
|
|
|
10
|
$item = "\\\(bu"; |
1340
|
12
|
|
|
|
|
67
|
$text =~ s/\n*$/\n/; |
1341
|
|
|
|
|
|
|
} elsif ($type eq 'number') { |
1342
|
8
|
|
|
|
|
10
|
$item = $$attrs{number} . '.'; |
1343
|
|
|
|
|
|
|
} else { |
1344
|
54
|
|
|
|
|
43
|
$item = $text; |
1345
|
54
|
|
|
|
|
61
|
$item =~ s/\s*\n\s*/ /g; |
1346
|
54
|
|
|
|
|
45
|
$text = ''; |
1347
|
54
|
100
|
|
|
|
126
|
$index = $item if ($item =~ /\w/); |
1348
|
|
|
|
|
|
|
} |
1349
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
# Take care of the indentation. If shifts and indents are equal, close |
1351
|
|
|
|
|
|
|
# the top shift, since we're about to create an indentation with .IP. |
1352
|
|
|
|
|
|
|
# Also output .PD 0 to turn off spacing between items if this item is |
1353
|
|
|
|
|
|
|
# directly following another one. We only have to do that once for a |
1354
|
|
|
|
|
|
|
# whole chain of items so do it for the second item in the change. Note |
1355
|
|
|
|
|
|
|
# that makespace is what undoes this. |
1356
|
74
|
100
|
|
|
|
67
|
if (@{ $$self{SHIFTS} } == @{ $$self{INDENTS} }) { |
|
74
|
|
|
|
|
79
|
|
|
74
|
|
|
|
|
118
|
|
1357
|
2
|
|
|
|
|
5
|
$self->output (".RE\n"); |
1358
|
2
|
|
|
|
|
9
|
pop @{ $$self{SHIFTS} }; |
|
2
|
|
|
|
|
4
|
|
1359
|
|
|
|
|
|
|
} |
1360
|
74
|
100
|
|
|
|
117
|
$self->output (".PD 0\n") if ($$self{ITEMS} == 1); |
1361
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
# Now, output the item tag itself. |
1363
|
74
|
|
|
|
|
131
|
$item = $self->textmapfonts ($item); |
1364
|
74
|
|
|
|
|
152
|
$self->output ($self->switchquotes ('.IP', $item, $$self{INDENT})); |
1365
|
74
|
|
|
|
|
389
|
$$self{NEEDSPACE} = 0; |
1366
|
74
|
|
|
|
|
56
|
$$self{ITEMS}++; |
1367
|
74
|
|
|
|
|
59
|
$$self{SHIFTWAIT} = 0; |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
# If body text for this item was included, go ahead and output that now. |
1370
|
74
|
100
|
|
|
|
104
|
if ($text) { |
1371
|
20
|
|
|
|
|
103
|
$text =~ s/\s*$/\n/; |
1372
|
20
|
|
|
|
|
28
|
$self->makespace; |
1373
|
20
|
|
|
|
|
28
|
$self->output ($self->protect ($self->textmapfonts ($text))); |
1374
|
20
|
|
|
|
|
73
|
$$self{NEEDSPACE} = 1; |
1375
|
|
|
|
|
|
|
} |
1376
|
74
|
100
|
|
|
|
131
|
$self->outindex ($index ? ('Item', $index) : ()); |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
# Dispatch the item commands to the appropriate place. |
1380
|
12
|
|
|
12
|
0
|
12
|
sub cmd_item_bullet { my $self = shift; $self->item_common ('bullet', @_) } |
|
12
|
|
|
|
|
23
|
|
1381
|
8
|
|
|
8
|
0
|
10
|
sub cmd_item_number { my $self = shift; $self->item_common ('number', @_) } |
|
8
|
|
|
|
|
14
|
|
1382
|
54
|
|
|
54
|
0
|
49
|
sub cmd_item_text { my $self = shift; $self->item_common ('text', @_) } |
|
54
|
|
|
|
|
91
|
|
1383
|
0
|
|
|
0
|
0
|
0
|
sub cmd_item_block { my $self = shift; $self->item_common ('block', @_) } |
|
0
|
|
|
|
|
0
|
|
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
############################################################################## |
1386
|
|
|
|
|
|
|
# Backward compatibility |
1387
|
|
|
|
|
|
|
############################################################################## |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
# Reset the underlying Pod::Simple object between calls to parse_from_file so |
1390
|
|
|
|
|
|
|
# that the same object can be reused to convert multiple pages. |
1391
|
|
|
|
|
|
|
sub parse_from_file { |
1392
|
41
|
|
|
41
|
1
|
33095
|
my $self = shift; |
1393
|
41
|
|
|
|
|
127
|
$self->reinit; |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
# Fake the old cutting option to Pod::Parser. This fiddings with internal |
1396
|
|
|
|
|
|
|
# Pod::Simple state and is quite ugly; we need a better approach. |
1397
|
41
|
100
|
|
|
|
751
|
if (ref ($_[0]) eq 'HASH') { |
1398
|
1
|
|
|
|
|
2
|
my $opts = shift @_; |
1399
|
1
|
50
|
33
|
|
|
12
|
if (defined ($$opts{-cutting}) && !$$opts{-cutting}) { |
1400
|
1
|
|
|
|
|
2
|
$$self{in_pod} = 1; |
1401
|
1
|
|
|
|
|
3
|
$$self{last_was_blank} = 1; |
1402
|
|
|
|
|
|
|
} |
1403
|
|
|
|
|
|
|
} |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
# Do the work. |
1406
|
41
|
|
|
|
|
129
|
my $retval = $self->SUPER::parse_from_file (@_); |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
# Flush output, since Pod::Simple doesn't do this. Ideally we should also |
1409
|
|
|
|
|
|
|
# close the file descriptor if we had to open one, but we can't easily |
1410
|
|
|
|
|
|
|
# figure this out. |
1411
|
41
|
|
|
|
|
777
|
my $fh = $self->output_fh (); |
1412
|
41
|
|
|
|
|
221
|
my $oldfh = select $fh; |
1413
|
41
|
|
|
|
|
58
|
my $oldflush = $|; |
1414
|
41
|
|
|
|
|
917
|
$| = 1; |
1415
|
41
|
|
|
|
|
60
|
print $fh ''; |
1416
|
41
|
|
|
|
|
63
|
$| = $oldflush; |
1417
|
41
|
|
|
|
|
96
|
select $oldfh; |
1418
|
41
|
|
|
|
|
75
|
return $retval; |
1419
|
|
|
|
|
|
|
} |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
# Pod::Simple failed to provide this backward compatibility function, so |
1422
|
|
|
|
|
|
|
# implement it ourselves. File handles are one of the inputs that |
1423
|
|
|
|
|
|
|
# parse_from_file supports. |
1424
|
|
|
|
|
|
|
sub parse_from_filehandle { |
1425
|
1
|
|
|
1
|
0
|
4
|
my $self = shift; |
1426
|
1
|
|
|
|
|
3
|
return $self->parse_from_file (@_); |
1427
|
|
|
|
|
|
|
} |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
# Pod::Simple's parse_file doesn't set output_fh. Wrap the call and do so |
1430
|
|
|
|
|
|
|
# ourself unless it was already set by the caller, since our documentation has |
1431
|
|
|
|
|
|
|
# always said that this should work. |
1432
|
|
|
|
|
|
|
sub parse_file { |
1433
|
43
|
|
|
43
|
1
|
4091
|
my ($self, $in) = @_; |
1434
|
43
|
50
|
|
|
|
88
|
unless (defined $$self{output_fh}) { |
1435
|
0
|
|
|
|
|
0
|
$self->output_fh (\*STDOUT); |
1436
|
|
|
|
|
|
|
} |
1437
|
43
|
|
|
|
|
91
|
return $self->SUPER::parse_file ($in); |
1438
|
|
|
|
|
|
|
} |
1439
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
# Do the same for parse_lines, just to be polite. Pod::Simple's man page |
1441
|
|
|
|
|
|
|
# implies that the caller is responsible for setting this, but I don't see any |
1442
|
|
|
|
|
|
|
# reason not to set a default. |
1443
|
|
|
|
|
|
|
sub parse_lines { |
1444
|
197
|
|
|
197
|
1
|
1167381
|
my ($self, @lines) = @_; |
1445
|
197
|
50
|
|
|
|
390
|
unless (defined $$self{output_fh}) { |
1446
|
0
|
|
|
|
|
0
|
$self->output_fh (\*STDOUT); |
1447
|
|
|
|
|
|
|
} |
1448
|
197
|
|
|
|
|
429
|
return $self->SUPER::parse_lines (@lines); |
1449
|
|
|
|
|
|
|
} |
1450
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
# Likewise for parse_string_document. |
1452
|
|
|
|
|
|
|
sub parse_string_document { |
1453
|
21
|
|
|
21
|
1
|
17001
|
my ($self, $doc) = @_; |
1454
|
21
|
50
|
|
|
|
47
|
unless (defined $$self{output_fh}) { |
1455
|
0
|
|
|
|
|
0
|
$self->output_fh (\*STDOUT); |
1456
|
|
|
|
|
|
|
} |
1457
|
21
|
|
|
|
|
70
|
return $self->SUPER::parse_string_document ($doc); |
1458
|
|
|
|
|
|
|
} |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
############################################################################## |
1461
|
|
|
|
|
|
|
# Translation tables |
1462
|
|
|
|
|
|
|
############################################################################## |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
# The following table is adapted from Tom Christiansen's pod2man. It assumes |
1465
|
|
|
|
|
|
|
# that the standard preamble has already been printed, since that's what |
1466
|
|
|
|
|
|
|
# defines all of the accent marks. We really want to do something better than |
1467
|
|
|
|
|
|
|
# this when *roff actually supports other character sets itself, since these |
1468
|
|
|
|
|
|
|
# results are pretty poor. |
1469
|
|
|
|
|
|
|
# |
1470
|
|
|
|
|
|
|
# This only works in an ASCII world. What to do in a non-ASCII world is very |
1471
|
|
|
|
|
|
|
# unclear -- hopefully we can assume UTF-8 and just leave well enough alone. |
1472
|
|
|
|
|
|
|
@ESCAPES{0xA0 .. 0xFF} = ( |
1473
|
|
|
|
|
|
|
"\\ ", undef, undef, undef, undef, undef, undef, undef, |
1474
|
|
|
|
|
|
|
undef, undef, undef, undef, undef, "\\%", undef, undef, |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
undef, undef, undef, undef, undef, undef, undef, undef, |
1477
|
|
|
|
|
|
|
undef, undef, undef, undef, undef, undef, undef, undef, |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
"A\\*`", "A\\*'", "A\\*^", "A\\*~", "A\\*:", "A\\*o", "\\*(Ae", "C\\*,", |
1480
|
|
|
|
|
|
|
"E\\*`", "E\\*'", "E\\*^", "E\\*:", "I\\*`", "I\\*'", "I\\*^", "I\\*:", |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
"\\*(D-", "N\\*~", "O\\*`", "O\\*'", "O\\*^", "O\\*~", "O\\*:", undef, |
1483
|
|
|
|
|
|
|
"O\\*/", "U\\*`", "U\\*'", "U\\*^", "U\\*:", "Y\\*'", "\\*(Th", "\\*8", |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
"a\\*`", "a\\*'", "a\\*^", "a\\*~", "a\\*:", "a\\*o", "\\*(ae", "c\\*,", |
1486
|
|
|
|
|
|
|
"e\\*`", "e\\*'", "e\\*^", "e\\*:", "i\\*`", "i\\*'", "i\\*^", "i\\*:", |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
"\\*(d-", "n\\*~", "o\\*`", "o\\*'", "o\\*^", "o\\*~", "o\\*:", undef, |
1489
|
|
|
|
|
|
|
"o\\*/" , "u\\*`", "u\\*'", "u\\*^", "u\\*:", "y\\*'", "\\*(th", "y\\*:", |
1490
|
|
|
|
|
|
|
) if ASCII; |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
############################################################################## |
1493
|
|
|
|
|
|
|
# Premable |
1494
|
|
|
|
|
|
|
############################################################################## |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
# The following is the static preamble which starts all *roff output we |
1497
|
|
|
|
|
|
|
# generate. Most is static except for the font to use as a fixed-width font, |
1498
|
|
|
|
|
|
|
# which is designed by @CFONT@, and the left and right quotes to use for C<> |
1499
|
|
|
|
|
|
|
# text, designated by @LQOUTE@ and @RQUOTE@. However, the second part, which |
1500
|
|
|
|
|
|
|
# defines the accent marks, is only used if $escapes is set to true. |
1501
|
|
|
|
|
|
|
sub preamble_template { |
1502
|
62
|
|
|
62
|
0
|
67
|
my ($self, $accents) = @_; |
1503
|
62
|
|
|
|
|
54
|
my $preamble = <<'----END OF PREAMBLE----'; |
1504
|
|
|
|
|
|
|
.de Sp \" Vertical space (when we can't use .PP) |
1505
|
|
|
|
|
|
|
.if t .sp .5v |
1506
|
|
|
|
|
|
|
.if n .sp |
1507
|
|
|
|
|
|
|
.. |
1508
|
|
|
|
|
|
|
.de Vb \" Begin verbatim text |
1509
|
|
|
|
|
|
|
.ft @CFONT@ |
1510
|
|
|
|
|
|
|
.nf |
1511
|
|
|
|
|
|
|
.ne \\$1 |
1512
|
|
|
|
|
|
|
.. |
1513
|
|
|
|
|
|
|
.de Ve \" End verbatim text |
1514
|
|
|
|
|
|
|
.ft R |
1515
|
|
|
|
|
|
|
.fi |
1516
|
|
|
|
|
|
|
.. |
1517
|
|
|
|
|
|
|
.\" Set up some character translations and predefined strings. \*(-- will |
1518
|
|
|
|
|
|
|
.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left |
1519
|
|
|
|
|
|
|
.\" double quote, and \*(R" will give a right double quote. \*(C+ will |
1520
|
|
|
|
|
|
|
.\" give a nicer C++. Capital omega is used to do unbreakable dashes and |
1521
|
|
|
|
|
|
|
.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, |
1522
|
|
|
|
|
|
|
.\" nothing in troff, for use with C<>. |
1523
|
|
|
|
|
|
|
.tr \(*W- |
1524
|
|
|
|
|
|
|
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' |
1525
|
|
|
|
|
|
|
.ie n \{\ |
1526
|
|
|
|
|
|
|
. ds -- \(*W- |
1527
|
|
|
|
|
|
|
. ds PI pi |
1528
|
|
|
|
|
|
|
. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch |
1529
|
|
|
|
|
|
|
. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch |
1530
|
|
|
|
|
|
|
. ds L" "" |
1531
|
|
|
|
|
|
|
. ds R" "" |
1532
|
|
|
|
|
|
|
. ds C` @LQUOTE@ |
1533
|
|
|
|
|
|
|
. ds C' @RQUOTE@ |
1534
|
|
|
|
|
|
|
'br\} |
1535
|
|
|
|
|
|
|
.el\{\ |
1536
|
|
|
|
|
|
|
. ds -- \|\(em\| |
1537
|
|
|
|
|
|
|
. ds PI \(*p |
1538
|
|
|
|
|
|
|
. ds L" `` |
1539
|
|
|
|
|
|
|
. ds R" '' |
1540
|
|
|
|
|
|
|
. ds C` |
1541
|
|
|
|
|
|
|
. ds C' |
1542
|
|
|
|
|
|
|
'br\} |
1543
|
|
|
|
|
|
|
.\" |
1544
|
|
|
|
|
|
|
.\" Escape single quotes in literal strings from groff's Unicode transform. |
1545
|
|
|
|
|
|
|
.ie \n(.g .ds Aq \(aq |
1546
|
|
|
|
|
|
|
.el .ds Aq ' |
1547
|
|
|
|
|
|
|
.\" |
1548
|
|
|
|
|
|
|
.\" If the F register is >0, we'll generate index entries on stderr for |
1549
|
|
|
|
|
|
|
.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index |
1550
|
|
|
|
|
|
|
.\" entries marked with X<> in POD. Of course, you'll have to process the |
1551
|
|
|
|
|
|
|
.\" output yourself in some meaningful fashion. |
1552
|
|
|
|
|
|
|
.\" |
1553
|
|
|
|
|
|
|
.\" Avoid warning from groff about undefined register 'F'. |
1554
|
|
|
|
|
|
|
.de IX |
1555
|
|
|
|
|
|
|
.. |
1556
|
|
|
|
|
|
|
.if !\nF .nr F 0 |
1557
|
|
|
|
|
|
|
.if \nF>0 \{\ |
1558
|
|
|
|
|
|
|
. de IX |
1559
|
|
|
|
|
|
|
. tm Index:\\$1\t\\n%\t"\\$2" |
1560
|
|
|
|
|
|
|
.. |
1561
|
|
|
|
|
|
|
. if !\nF==2 \{\ |
1562
|
|
|
|
|
|
|
. nr % 0 |
1563
|
|
|
|
|
|
|
. nr F 2 |
1564
|
|
|
|
|
|
|
. \} |
1565
|
|
|
|
|
|
|
.\} |
1566
|
|
|
|
|
|
|
----END OF PREAMBLE---- |
1567
|
|
|
|
|
|
|
#'# for cperl-mode |
1568
|
|
|
|
|
|
|
|
1569
|
62
|
100
|
|
|
|
102
|
if ($accents) { |
1570
|
58
|
|
|
|
|
200
|
$preamble .= <<'----END OF PREAMBLE----' |
1571
|
|
|
|
|
|
|
.\" |
1572
|
|
|
|
|
|
|
.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). |
1573
|
|
|
|
|
|
|
.\" Fear. Run. Save yourself. No user-serviceable parts. |
1574
|
|
|
|
|
|
|
. \" fudge factors for nroff and troff |
1575
|
|
|
|
|
|
|
.if n \{\ |
1576
|
|
|
|
|
|
|
. ds #H 0 |
1577
|
|
|
|
|
|
|
. ds #V .8m |
1578
|
|
|
|
|
|
|
. ds #F .3m |
1579
|
|
|
|
|
|
|
. ds #[ \f1 |
1580
|
|
|
|
|
|
|
. ds #] \fP |
1581
|
|
|
|
|
|
|
.\} |
1582
|
|
|
|
|
|
|
.if t \{\ |
1583
|
|
|
|
|
|
|
. ds #H ((1u-(\\\\n(.fu%2u))*.13m) |
1584
|
|
|
|
|
|
|
. ds #V .6m |
1585
|
|
|
|
|
|
|
. ds #F 0 |
1586
|
|
|
|
|
|
|
. ds #[ \& |
1587
|
|
|
|
|
|
|
. ds #] \& |
1588
|
|
|
|
|
|
|
.\} |
1589
|
|
|
|
|
|
|
. \" simple accents for nroff and troff |
1590
|
|
|
|
|
|
|
.if n \{\ |
1591
|
|
|
|
|
|
|
. ds ' \& |
1592
|
|
|
|
|
|
|
. ds ` \& |
1593
|
|
|
|
|
|
|
. ds ^ \& |
1594
|
|
|
|
|
|
|
. ds , \& |
1595
|
|
|
|
|
|
|
. ds ~ ~ |
1596
|
|
|
|
|
|
|
. ds / |
1597
|
|
|
|
|
|
|
.\} |
1598
|
|
|
|
|
|
|
.if t \{\ |
1599
|
|
|
|
|
|
|
. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" |
1600
|
|
|
|
|
|
|
. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' |
1601
|
|
|
|
|
|
|
. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' |
1602
|
|
|
|
|
|
|
. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' |
1603
|
|
|
|
|
|
|
. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' |
1604
|
|
|
|
|
|
|
. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' |
1605
|
|
|
|
|
|
|
.\} |
1606
|
|
|
|
|
|
|
. \" troff and (daisy-wheel) nroff accents |
1607
|
|
|
|
|
|
|
.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' |
1608
|
|
|
|
|
|
|
.ds 8 \h'\*(#H'\(*b\h'-\*(#H' |
1609
|
|
|
|
|
|
|
.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] |
1610
|
|
|
|
|
|
|
.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' |
1611
|
|
|
|
|
|
|
.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' |
1612
|
|
|
|
|
|
|
.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] |
1613
|
|
|
|
|
|
|
.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] |
1614
|
|
|
|
|
|
|
.ds ae a\h'-(\w'a'u*4/10)'e |
1615
|
|
|
|
|
|
|
.ds Ae A\h'-(\w'A'u*4/10)'E |
1616
|
|
|
|
|
|
|
. \" corrections for vroff |
1617
|
|
|
|
|
|
|
.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' |
1618
|
|
|
|
|
|
|
.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' |
1619
|
|
|
|
|
|
|
. \" for low resolution devices (crt and lpr) |
1620
|
|
|
|
|
|
|
.if \n(.H>23 .if \n(.V>19 \ |
1621
|
|
|
|
|
|
|
\{\ |
1622
|
|
|
|
|
|
|
. ds : e |
1623
|
|
|
|
|
|
|
. ds 8 ss |
1624
|
|
|
|
|
|
|
. ds o a |
1625
|
|
|
|
|
|
|
. ds d- d\h'-1'\(ga |
1626
|
|
|
|
|
|
|
. ds D- D\h'-1'\(hy |
1627
|
|
|
|
|
|
|
. ds th \o'bp' |
1628
|
|
|
|
|
|
|
. ds Th \o'LP' |
1629
|
|
|
|
|
|
|
. ds ae ae |
1630
|
|
|
|
|
|
|
. ds Ae AE |
1631
|
|
|
|
|
|
|
.\} |
1632
|
|
|
|
|
|
|
.rm #[ #] #H #V #F C |
1633
|
|
|
|
|
|
|
----END OF PREAMBLE---- |
1634
|
|
|
|
|
|
|
#`# for cperl-mode |
1635
|
|
|
|
|
|
|
} |
1636
|
62
|
|
|
|
|
88
|
return $preamble; |
1637
|
|
|
|
|
|
|
} |
1638
|
|
|
|
|
|
|
|
1639
|
|
|
|
|
|
|
############################################################################## |
1640
|
|
|
|
|
|
|
# Module return value and documentation |
1641
|
|
|
|
|
|
|
############################################################################## |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
1; |
1644
|
|
|
|
|
|
|
__END__ |