File Coverage

blib/lib/Pod/LaTeX.pm
Criterion Covered Total %
statement 278 340 81.7
branch 120 186 64.5
condition 14 33 42.4
subroutine 35 36 97.2
pod 23 24 95.8
total 470 619 75.9


line stmt bran cond sub pod time code
1             package Pod::LaTeX;
2              
3             =head1 NAME
4              
5             Pod::LaTeX - Convert Pod data to formatted Latex
6              
7             =head1 SYNOPSIS
8              
9             use Pod::LaTeX;
10             my $parser = Pod::LaTeX->new ( );
11              
12             $parser->parse_from_filehandle;
13              
14             $parser->parse_from_file ('file.pod', 'file.tex');
15              
16             =head1 DESCRIPTION
17              
18             C is a module to convert documentation in the Pod format
19             into Latex. The L|pod2latex> X command uses
20             this module for translation.
21              
22             C is a derived class from L.
23              
24             =cut
25              
26              
27 3     3   66496 use strict;
  3         8  
  3         179  
28             require Pod::ParseUtils;
29 3     3   17 use base qw/ Pod::Select /;
  3         7  
  3         3281  
30              
31 3     3   11219 use if $] > 5.017, 'deprecate';
  3         40  
  3         23  
32              
33             # use Data::Dumper; # for debugging
34 3     3   5505 use Carp;
  3         5  
  3         257  
35              
36 3     3   17 use vars qw/ $VERSION %HTML_Escapes @LatexSections /;
  3         7  
  3         17751  
37              
38             $VERSION = '0.61';
39              
40             # Definitions of =headN -> latex mapping
41             @LatexSections = (qw/
42             chapter
43             section
44             subsection
45             subsubsection
46             paragraph
47             subparagraph
48             /);
49              
50             # Standard escape sequences converted to Latex.
51             # The Unicode name of each character is given in the comments.
52             # Complete LaTeX set added by Peter Acklam.
53              
54             %HTML_Escapes = (
55             'sol' => '\textfractionsolidus{}', # xxx - or should it be just '/'
56             'verbar' => '|',
57              
58             # The stuff below is based on the information available at
59             # http://www.w3.org/TR/html401/sgml/entities.html
60              
61             # All characters in the range 0xA0-0xFF of the ISO 8859-1 character set.
62             # Several of these characters require the `textcomp' LaTeX package.
63             'nbsp' => q|~|, # 0xA0 - no-break space = non-breaking space
64             'iexcl' => q|\textexclamdown{}|, # 0xA1 - inverted exclamation mark
65             'cent' => q|\textcent{}|, # 0xA2 - cent sign
66             'pound' => q|\textsterling{}|, # 0xA3 - pound sign
67             'curren' => q|\textcurrency{}|, # 0xA4 - currency sign
68             'yen' => q|\textyen{}|, # 0xA5 - yen sign = yuan sign
69             'brvbar' => q|\textbrokenbar{}|, # 0xA6 - broken bar = broken vertical bar
70             'sect' => q|\textsection{}|, # 0xA7 - section sign
71             'uml' => q|\textasciidieresis{}|, # 0xA8 - diaeresis = spacing diaeresis
72             'copy' => q|\textcopyright{}|, # 0xA9 - copyright sign
73             'ordf' => q|\textordfeminine{}|, # 0xAA - feminine ordinal indicator
74             'laquo' => q|\guillemotleft{}|, # 0xAB - left-pointing double angle quotation mark = left pointing guillemet
75             'not' => q|\textlnot{}|, # 0xAC - not sign
76             'shy' => q|\-|, # 0xAD - soft hyphen = discretionary hyphen
77             'reg' => q|\textregistered{}|, # 0xAE - registered sign = registered trade mark sign
78             'macr' => q|\textasciimacron{}|, # 0xAF - macron = spacing macron = overline = APL overbar
79             'deg' => q|\textdegree{}|, # 0xB0 - degree sign
80             'plusmn' => q|\textpm{}|, # 0xB1 - plus-minus sign = plus-or-minus sign
81             'sup2' => q|\texttwosuperior{}|, # 0xB2 - superscript two = superscript digit two = squared
82             'sup3' => q|\textthreesuperior{}|, # 0xB3 - superscript three = superscript digit three = cubed
83             'acute' => q|\textasciiacute{}|, # 0xB4 - acute accent = spacing acute
84             'micro' => q|\textmu{}|, # 0xB5 - micro sign
85             'para' => q|\textparagraph{}|, # 0xB6 - pilcrow sign = paragraph sign
86             'middot' => q|\textperiodcentered{}|, # 0xB7 - middle dot = Georgian comma = Greek middle dot
87             'cedil' => q|\c{}|, # 0xB8 - cedilla = spacing cedilla
88             'sup1' => q|\textonesuperior{}|, # 0xB9 - superscript one = superscript digit one
89             'ordm' => q|\textordmasculine{}|, # 0xBA - masculine ordinal indicator
90             'raquo' => q|\guillemotright{}|, # 0xBB - right-pointing double angle quotation mark = right pointing guillemet
91             'frac14' => q|\textonequarter{}|, # 0xBC - vulgar fraction one quarter = fraction one quarter
92             'frac12' => q|\textonehalf{}|, # 0xBD - vulgar fraction one half = fraction one half
93             'frac34' => q|\textthreequarters{}|, # 0xBE - vulgar fraction three quarters = fraction three quarters
94             'iquest' => q|\textquestiondown{}|, # 0xBF - inverted question mark = turned question mark
95             'Agrave' => q|\`A|, # 0xC0 - latin capital letter A with grave = latin capital letter A grave
96             'Aacute' => q|\'A|, # 0xC1 - latin capital letter A with acute
97             'Acirc' => q|\^A|, # 0xC2 - latin capital letter A with circumflex
98             'Atilde' => q|\~A|, # 0xC3 - latin capital letter A with tilde
99             'Auml' => q|\"A|, # 0xC4 - latin capital letter A with diaeresis
100             'Aring' => q|\AA{}|, # 0xC5 - latin capital letter A with ring above = latin capital letter A ring
101             'AElig' => q|\AE{}|, # 0xC6 - latin capital letter AE = latin capital ligature AE
102             'Ccedil' => q|\c{C}|, # 0xC7 - latin capital letter C with cedilla
103             'Egrave' => q|\`E|, # 0xC8 - latin capital letter E with grave
104             'Eacute' => q|\'E|, # 0xC9 - latin capital letter E with acute
105             'Ecirc' => q|\^E|, # 0xCA - latin capital letter E with circumflex
106             'Euml' => q|\"E|, # 0xCB - latin capital letter E with diaeresis
107             'Igrave' => q|\`I|, # 0xCC - latin capital letter I with grave
108             'Iacute' => q|\'I|, # 0xCD - latin capital letter I with acute
109             'Icirc' => q|\^I|, # 0xCE - latin capital letter I with circumflex
110             'Iuml' => q|\"I|, # 0xCF - latin capital letter I with diaeresis
111             'ETH' => q|\DH{}|, # 0xD0 - latin capital letter ETH
112             'Ntilde' => q|\~N|, # 0xD1 - latin capital letter N with tilde
113             'Ograve' => q|\`O|, # 0xD2 - latin capital letter O with grave
114             'Oacute' => q|\'O|, # 0xD3 - latin capital letter O with acute
115             'Ocirc' => q|\^O|, # 0xD4 - latin capital letter O with circumflex
116             'Otilde' => q|\~O|, # 0xD5 - latin capital letter O with tilde
117             'Ouml' => q|\"O|, # 0xD6 - latin capital letter O with diaeresis
118             'times' => q|\texttimes{}|, # 0xD7 - multiplication sign
119             'Oslash' => q|\O{}|, # 0xD8 - latin capital letter O with stroke = latin capital letter O slash
120             'Ugrave' => q|\`U|, # 0xD9 - latin capital letter U with grave
121             'Uacute' => q|\'U|, # 0xDA - latin capital letter U with acute
122             'Ucirc' => q|\^U|, # 0xDB - latin capital letter U with circumflex
123             'Uuml' => q|\"U|, # 0xDC - latin capital letter U with diaeresis
124             'Yacute' => q|\'Y|, # 0xDD - latin capital letter Y with acute
125             'THORN' => q|\TH{}|, # 0xDE - latin capital letter THORN
126             'szlig' => q|\ss{}|, # 0xDF - latin small letter sharp s = ess-zed
127             'agrave' => q|\`a|, # 0xE0 - latin small letter a with grave = latin small letter a grave
128             'aacute' => q|\'a|, # 0xE1 - latin small letter a with acute
129             'acirc' => q|\^a|, # 0xE2 - latin small letter a with circumflex
130             'atilde' => q|\~a|, # 0xE3 - latin small letter a with tilde
131             'auml' => q|\"a|, # 0xE4 - latin small letter a with diaeresis
132             'aring' => q|\aa{}|, # 0xE5 - latin small letter a with ring above = latin small letter a ring
133             'aelig' => q|\ae{}|, # 0xE6 - latin small letter ae = latin small ligature ae
134             'ccedil' => q|\c{c}|, # 0xE7 - latin small letter c with cedilla
135             'egrave' => q|\`e|, # 0xE8 - latin small letter e with grave
136             'eacute' => q|\'e|, # 0xE9 - latin small letter e with acute
137             'ecirc' => q|\^e|, # 0xEA - latin small letter e with circumflex
138             'euml' => q|\"e|, # 0xEB - latin small letter e with diaeresis
139             'igrave' => q|\`i|, # 0xEC - latin small letter i with grave
140             'iacute' => q|\'i|, # 0xED - latin small letter i with acute
141             'icirc' => q|\^i|, # 0xEE - latin small letter i with circumflex
142             'iuml' => q|\"i|, # 0xEF - latin small letter i with diaeresis
143             'eth' => q|\dh{}|, # 0xF0 - latin small letter eth
144             'ntilde' => q|\~n|, # 0xF1 - latin small letter n with tilde
145             'ograve' => q|\`o|, # 0xF2 - latin small letter o with grave
146             'oacute' => q|\'o|, # 0xF3 - latin small letter o with acute
147             'ocirc' => q|\^o|, # 0xF4 - latin small letter o with circumflex
148             'otilde' => q|\~o|, # 0xF5 - latin small letter o with tilde
149             'ouml' => q|\"o|, # 0xF6 - latin small letter o with diaeresis
150             'divide' => q|\textdiv{}|, # 0xF7 - division sign
151             'oslash' => q|\o{}|, # 0xF8 - latin small letter o with stroke, = latin small letter o slash
152             'ugrave' => q|\`u|, # 0xF9 - latin small letter u with grave
153             'uacute' => q|\'u|, # 0xFA - latin small letter u with acute
154             'ucirc' => q|\^u|, # 0xFB - latin small letter u with circumflex
155             'uuml' => q|\"u|, # 0xFC - latin small letter u with diaeresis
156             'yacute' => q|\'y|, # 0xFD - latin small letter y with acute
157             'thorn' => q|\th{}|, # 0xFE - latin small letter thorn
158             'yuml' => q|\"y|, # 0xFF - latin small letter y with diaeresis
159              
160             # Latin Extended-B
161             'fnof' => q|\textflorin{}|, # latin small f with hook = function = florin
162              
163             # Greek
164             'Alpha' => q|$\mathrm{A}$|, # greek capital letter alpha
165             'Beta' => q|$\mathrm{B}$|, # greek capital letter beta
166             'Gamma' => q|$\Gamma$|, # greek capital letter gamma
167             'Delta' => q|$\Delta$|, # greek capital letter delta
168             'Epsilon' => q|$\mathrm{E}$|, # greek capital letter epsilon
169             'Zeta' => q|$\mathrm{Z}$|, # greek capital letter zeta
170             'Eta' => q|$\mathrm{H}$|, # greek capital letter eta
171             'Theta' => q|$\Theta$|, # greek capital letter theta
172             'Iota' => q|$\mathrm{I}$|, # greek capital letter iota
173             'Kappa' => q|$\mathrm{K}$|, # greek capital letter kappa
174             'Lambda' => q|$\Lambda$|, # greek capital letter lambda
175             'Mu' => q|$\mathrm{M}$|, # greek capital letter mu
176             'Nu' => q|$\mathrm{N}$|, # greek capital letter nu
177             'Xi' => q|$\Xi$|, # greek capital letter xi
178             'Omicron' => q|$\mathrm{O}$|, # greek capital letter omicron
179             'Pi' => q|$\Pi$|, # greek capital letter pi
180             'Rho' => q|$\mathrm{R}$|, # greek capital letter rho
181             'Sigma' => q|$\Sigma$|, # greek capital letter sigma
182             'Tau' => q|$\mathrm{T}$|, # greek capital letter tau
183             'Upsilon' => q|$\Upsilon$|, # greek capital letter upsilon
184             'Phi' => q|$\Phi$|, # greek capital letter phi
185             'Chi' => q|$\mathrm{X}$|, # greek capital letter chi
186             'Psi' => q|$\Psi$|, # greek capital letter psi
187             'Omega' => q|$\Omega$|, # greek capital letter omega
188              
189             'alpha' => q|$\alpha$|, # greek small letter alpha
190             'beta' => q|$\beta$|, # greek small letter beta
191             'gamma' => q|$\gamma$|, # greek small letter gamma
192             'delta' => q|$\delta$|, # greek small letter delta
193             'epsilon' => q|$\epsilon$|, # greek small letter epsilon
194             'zeta' => q|$\zeta$|, # greek small letter zeta
195             'eta' => q|$\eta$|, # greek small letter eta
196             'theta' => q|$\theta$|, # greek small letter theta
197             'iota' => q|$\iota$|, # greek small letter iota
198             'kappa' => q|$\kappa$|, # greek small letter kappa
199             'lambda' => q|$\lambda$|, # greek small letter lambda
200             'mu' => q|$\mu$|, # greek small letter mu
201             'nu' => q|$\nu$|, # greek small letter nu
202             'xi' => q|$\xi$|, # greek small letter xi
203             'omicron' => q|$o$|, # greek small letter omicron
204             'pi' => q|$\pi$|, # greek small letter pi
205             'rho' => q|$\rho$|, # greek small letter rho
206             # 'sigmaf' => q||, # greek small letter final sigma
207             'sigma' => q|$\sigma$|, # greek small letter sigma
208             'tau' => q|$\tau$|, # greek small letter tau
209             'upsilon' => q|$\upsilon$|, # greek small letter upsilon
210             'phi' => q|$\phi$|, # greek small letter phi
211             'chi' => q|$\chi$|, # greek small letter chi
212             'psi' => q|$\psi$|, # greek small letter psi
213             'omega' => q|$\omega$|, # greek small letter omega
214             # 'thetasym' => q||, # greek small letter theta symbol
215             # 'upsih' => q||, # greek upsilon with hook symbol
216             # 'piv' => q||, # greek pi symbol
217              
218             # General Punctuation
219             'bull' => q|\textbullet{}|, # bullet = black small circle
220             # bullet is NOT the same as bullet operator
221             'hellip' => q|\textellipsis{}|, # horizontal ellipsis = three dot leader
222             'prime' => q|\textquotesingle{}|, # prime = minutes = feet
223             'Prime' => q|\textquotedbl{}|, # double prime = seconds = inches
224             'oline' => q|\textasciimacron{}|, # overline = spacing overscore
225             'frasl' => q|\textfractionsolidus{}|, # fraction slash
226              
227             # Letterlike Symbols
228             'weierp' => q|$\wp$|, # script capital P = power set = Weierstrass p
229             'image' => q|$\Re$|, # blackletter capital I = imaginary part
230             'real' => q|$\Im$|, # blackletter capital R = real part symbol
231             'trade' => q|\texttrademark{}|, # trade mark sign
232             # 'alefsym' => q||, # alef symbol = first transfinite cardinal
233             # alef symbol is NOT the same as hebrew letter alef, although the same
234             # glyph could be used to depict both characters
235              
236             # Arrows
237             'larr' => q|\textleftarrow{}|, # leftwards arrow
238             'uarr' => q|\textuparrow{}|, # upwards arrow
239             'rarr' => q|\textrightarrow{}|, # rightwards arrow
240             'darr' => q|\textdownarrow{}|, # downwards arrow
241             'harr' => q|$\leftrightarrow$|, # left right arrow
242             # 'crarr' => q||, # downwards arrow with corner leftwards = carriage return
243             'lArr' => q|$\Leftarrow$|, # leftwards double arrow
244             # ISO 10646 does not say that lArr is the same as the 'is implied by'
245             # arrow but also does not have any other character for that function. So
246             # lArr can be used for 'is implied by' as ISOtech suggests
247             'uArr' => q|$\Uparrow$|, # upwards double arrow
248             'rArr' => q|$\Rightarrow$|, # rightwards double arrow
249             # ISO 10646 does not say this is the 'implies' character but does not
250             # have another character with this function so ? rArr can be used for
251             # 'implies' as ISOtech suggests
252             'dArr' => q|$\Downarrow$|, # downwards double arrow
253             'hArr' => q|$\Leftrightarrow$|, # left right double arrow
254              
255             # Mathematical Operators.
256             # Some of these require the `amssymb' package.
257             'forall' => q|$\forall$|, # for all
258             'part' => q|$\partial$|, # partial differential
259             'exist' => q|$\exists$|, # there exists
260             'empty' => q|$\emptyset$|, # empty set = null set = diameter
261             'nabla' => q|$\nabla$|, # nabla = backward difference
262             'isin' => q|$\in$|, # element of
263             'notin' => q|$\notin$|, # not an element of
264             'ni' => q|$\ni$|, # contains as member
265             'prod' => q|$\prod$|, # n-ary product = product sign
266             # prod is NOT the same character as 'greek capital letter pi' though the
267             # same glyph might be used for both
268             'sum' => q|$\sum$|, # n-ary summation
269             # sum is NOT the same character as 'greek capital letter sigma' though
270             # the same glyph might be used for both
271             'minus' => q|$-$|, # minus sign
272             'lowast' => q|$\ast$|, # asterisk operator
273             'radic' => q|$\surd$|, # square root = radical sign
274             'prop' => q|$\propto$|, # proportional to
275             'infin' => q|$\infty$|, # infinity
276             'ang' => q|$\angle$|, # angle
277             'and' => q|$\wedge$|, # logical and = wedge
278             'or' => q|$\vee$|, # logical or = vee
279             'cap' => q|$\cap$|, # intersection = cap
280             'cup' => q|$\cup$|, # union = cup
281             'int' => q|$\int$|, # integral
282             'there4' => q|$\therefore$|, # therefore
283             'sim' => q|$\sim$|, # tilde operator = varies with = similar to
284             # tilde operator is NOT the same character as the tilde
285             'cong' => q|$\cong$|, # approximately equal to
286             'asymp' => q|$\asymp$|, # almost equal to = asymptotic to
287             'ne' => q|$\neq$|, # not equal to
288             'equiv' => q|$\equiv$|, # identical to
289             'le' => q|$\leq$|, # less-than or equal to
290             'ge' => q|$\geq$|, # greater-than or equal to
291             'sub' => q|$\subset$|, # subset of
292             'sup' => q|$\supset$|, # superset of
293             # note that nsup, 'not a superset of' is not covered by the Symbol font
294             # encoding and is not included.
295             'nsub' => q|$\not\subset$|, # not a subset of
296             'sube' => q|$\subseteq$|, # subset of or equal to
297             'supe' => q|$\supseteq$|, # superset of or equal to
298             'oplus' => q|$\oplus$|, # circled plus = direct sum
299             'otimes' => q|$\otimes$|, # circled times = vector product
300             'perp' => q|$\perp$|, # up tack = orthogonal to = perpendicular
301             'sdot' => q|$\cdot$|, # dot operator
302             # dot operator is NOT the same character as middle dot
303              
304             # Miscellaneous Technical
305             'lceil' => q|$\lceil$|, # left ceiling = apl upstile
306             'rceil' => q|$\rceil$|, # right ceiling
307             'lfloor' => q|$\lfloor$|, # left floor = apl downstile
308             'rfloor' => q|$\rfloor$|, # right floor
309             'lang' => q|$\langle$|, # left-pointing angle bracket = bra
310             # lang is NOT the same character as 'less than' or 'single left-pointing
311             # angle quotation mark'
312             'rang' => q|$\rangle$|, # right-pointing angle bracket = ket
313             # rang is NOT the same character as 'greater than' or 'single
314             # right-pointing angle quotation mark'
315              
316             # Geometric Shapes
317             'loz' => q|$\lozenge$|, # lozenge
318              
319             # Miscellaneous Symbols
320             'spades' => q|$\spadesuit$|, # black spade suit
321             'clubs' => q|$\clubsuit$|, # black club suit = shamrock
322             'hearts' => q|$\heartsuit$|, # black heart suit = valentine
323             'diams' => q|$\diamondsuit$|, # black diamond suit
324              
325             # C0 Controls and Basic Latin
326             'quot' => q|"|, # quotation mark = APL quote ["]
327             'amp' => q|\&|, # ampersand
328             'lt' => q|<|, # less-than sign
329             'gt' => q|>|, # greater-than sign
330             'OElig' => q|\OE{}|, # latin capital ligature OE
331             'oelig' => q|\oe{}|, # latin small ligature oe
332             'Scaron' => q|\v{S}|, # latin capital letter S with caron
333             'scaron' => q|\v{s}|, # latin small letter s with caron
334             'Yuml' => q|\"Y|, # latin capital letter Y with diaeresis
335             'circ' => q|\textasciicircum{}|, # modifier letter circumflex accent
336             'tilde' => q|\textasciitilde{}|, # small tilde
337             'ensp' => q|\phantom{n}|, # en space
338             'emsp' => q|\hspace{1em}|, # em space
339             'thinsp' => q|\,|, # thin space
340             'zwnj' => q|{}|, # zero width non-joiner
341             # 'zwj' => q||, # zero width joiner
342             # 'lrm' => q||, # left-to-right mark
343             # 'rlm' => q||, # right-to-left mark
344             'ndash' => q|--|, # en dash
345             'mdash' => q|---|, # em dash
346             'lsquo' => q|\textquoteleft{}|, # left single quotation mark
347             'rsquo' => q|\textquoteright{}|, # right single quotation mark
348             'sbquo' => q|\quotesinglbase{}|, # single low-9 quotation mark
349             'ldquo' => q|\textquotedblleft{}|, # left double quotation mark
350             'rdquo' => q|\textquotedblright{}|, # right double quotation mark
351             'bdquo' => q|\quotedblbase{}|, # double low-9 quotation mark
352             'dagger' => q|\textdagger{}|, # dagger
353             'Dagger' => q|\textdaggerdbl{}|, # double dagger
354             'permil' => q|\textperthousand{}|, # per mille sign
355             'lsaquo' => q|\guilsinglleft{}|, # single left-pointing angle quotation mark
356             'rsaquo' => q|\guilsinglright{}|, # single right-pointing angle quotation mark
357             'euro' => q|\texteuro{}|, # euro sign
358             );
359              
360             =head1 OBJECT METHODS
361              
362             The following methods are provided in this module. Methods inherited
363             from C are not described in the public interface.
364              
365             =over 4
366              
367             =begin __PRIVATE__
368              
369             =item C
370              
371             Initialise the object. This method is subclassed from C.
372             The base class method is invoked. This method defines the default
373             behaviour of the object unless overridden by supplying arguments to
374             the constructor.
375              
376             Internal settings are defaulted as well as the public instance data.
377             Internal hash values are accessed directly (rather than through
378             a method) and start with an underscore.
379              
380             This method should not be invoked by the user directly.
381              
382             =end __PRIVATE__
383              
384             =cut
385              
386              
387              
388             # - An array for nested lists
389              
390             # Arguments have already been read by this point
391              
392             sub initialize {
393 2     2 1 472 my $self = shift;
394              
395             # print Dumper($self);
396              
397             # Internals
398 2         19 $self->{_Lists} = []; # For nested lists
399 2         5 $self->{_suppress_all_para} = 0; # For =begin blocks
400 2         6 $self->{_dont_modify_any_para}=0; # For =begin blocks
401 2         4 $self->{_CURRENT_HEAD1} = ''; # Name of current HEAD1 section
402              
403             # Options - only initialise if not already set
404              
405             # Cause the '=head1 NAME' field to be treated specially
406             # The contents of the NAME paragraph will be converted
407             # to a section title. All subsequent =head1 will be converted
408             # to =head2 and down. Will not affect =head1's prior to NAME
409             # Assumes: 'Module - purpose' format
410             # Also creates a purpose field
411             # The name is used for Labeling of the subsequent subsections
412 2 50       9 $self->{ReplaceNAMEwithSection} = 0
413             unless exists $self->{ReplaceNAMEwithSection};
414 2 50       12 $self->{AddPreamble} = 1 # make full latex document
415             unless exists $self->{AddPreamble};
416 2 50       9 $self->{StartWithNewPage} = 0 # Start new page for pod section
417             unless exists $self->{StartWithNewPage};
418 2 50       15 $self->{TableOfContents} = 0 # Add table of contents
419             unless exists $self->{TableOfContents}; # only relevant if AddPreamble=1
420 2 50       9 $self->{AddPostamble} = 1 # Add closing latex code at end
421             unless exists $self->{AddPostamble}; # effectively end{document} and index
422 2 50       8 $self->{MakeIndex} = 1 # Add index (only relevant AddPostamble
423             unless exists $self->{MakeIndex}; # and AddPreamble)
424              
425 2 50       8 $self->{UniqueLabels} = 1 # Use label unique for each pod
426             unless exists $self->{UniqueLabels}; # either based on the filename
427             # or supplied
428              
429             # Control the level of =head1. default is \section
430             #
431 2 50       9 $self->{Head1Level} = 1 # Offset in latex sections
432             unless exists $self->{Head1Level}; # 0 is chapter, 2 is subsection
433              
434             # Control at which level numbering of sections is turned off
435             # ie subsection becomes subsection*
436             # The numbering is relative to the latex sectioning commands
437             # and is independent of Pod heading level
438             # default is to number \section but not \subsection
439 2 50       8 $self->{LevelNoNum} = 2
440             unless exists $self->{LevelNoNum};
441              
442             # Label to be used as prefix to all internal section names
443             # If not defined will attempt to derive it from the filename
444             # This can not happen when running parse_from_filehandle though
445             # hence the ability to set the label externally
446             # The label could then be Pod::Parser_DESCRIPTION or somesuch
447              
448 2 50       9 $self->{Label} = undef # label to be used as prefix
449             unless exists $self->{Label}; # to all internal section names
450              
451             # These allow the caller to add arbitrary latex code to
452             # start and end of document. AddPreamble and AddPostamble are ignored
453             # if these are set.
454             # Also MakeIndex and TableOfContents are also ignored.
455 2 50       13 $self->{UserPreamble} = undef # User supplied start (AddPreamble =1)
456             unless exists $self->{Label};
457 2 50       8 $self->{UserPostamble} = undef # Use supplied end (AddPostamble=1)
458             unless exists $self->{Label};
459              
460             # Run base initialize
461 2         23 $self->SUPER::initialize;
462              
463             }
464              
465             =back
466              
467             =head2 Data Accessors
468              
469             The following methods are provided for accessing instance data. These
470             methods should be used for accessing configuration parameters rather
471             than assuming the object is a hash.
472              
473             Default values can be supplied by using these names as keys to a hash
474             of arguments when using the C constructor.
475              
476             =over 4
477              
478             =item B
479              
480             Logical to control whether a C preamble is to be written.
481             If true, a valid C preamble is written before the pod data is written.
482             This is similar to:
483              
484             \documentclass{article}
485             \usepackage[T1]{fontenc}
486             \usepackage{textcomp}
487             \begin{document}
488              
489             but will be more complicated if table of contents and indexing are required.
490             Can be used to set or retrieve the current value.
491              
492             $add = $parser->AddPreamble();
493             $parser->AddPreamble(1);
494              
495             If used in conjunction with C a full latex document will
496             be written that could be immediately processed by C.
497              
498             For some pod escapes it may be necessary to include the amsmath
499             package. This is not yet added to the preamble automatically.
500              
501             =cut
502              
503             sub AddPreamble {
504 3     3 1 11 my $self = shift;
505 3 100       9 if (@_) {
506 1         2 $self->{AddPreamble} = shift;
507             }
508 3         11 return $self->{AddPreamble};
509             }
510              
511             =item B
512              
513             Logical to control whether a standard C ending is written to the output
514             file after the document has been processed.
515             In its simplest form this is simply:
516              
517             \end{document}
518              
519             but can be more complicated if a index is required.
520             Can be used to set or retrieve the current value.
521              
522             $add = $parser->AddPostamble();
523             $parser->AddPostamble(1);
524              
525             If used in conjunction with C a full latex document will
526             be written that could be immediately processed by C.
527              
528             =cut
529              
530             sub AddPostamble {
531 3     3 1 9 my $self = shift;
532 3 100       11 if (@_) {
533 1         2 $self->{AddPostamble} = shift;
534             }
535 3         11 return $self->{AddPostamble};
536             }
537              
538             =item B
539              
540             The C sectioning level that should be used to correspond to
541             a pod C<=head1> directive. This can be used, for example, to turn
542             a C<=head1> into a C C. This should hold a number
543             corresponding to the required position in an array containing the
544             following elements:
545              
546             [0] chapter
547             [1] section
548             [2] subsection
549             [3] subsubsection
550             [4] paragraph
551             [5] subparagraph
552              
553             Can be used to set or retrieve the current value:
554              
555             $parser->Head1Level(2);
556             $sect = $parser->Head1Level;
557              
558             Setting this number too high can result in sections that may not be reproducible
559             in the expected way. For example, setting this to 4 would imply that C<=head3>
560             do not have a corresponding C section (C<=head1> would correspond to
561             a C).
562              
563             A check is made to ensure that the supplied value is an integer in the
564             range 0 to 5.
565              
566             Default is for a value of 1 (i.e. a C
).
567              
568             =cut
569              
570             sub Head1Level {
571 7     7 1 846 my $self = shift;
572 7 100       19 if (@_) {
573 1         3 my $arg = shift;
574 1 50 33     13 if ($arg =~ /^\d$/ && $arg <= $#LatexSections) {
575 1         3 $self->{Head1Level} = $arg;
576             } else {
577 0         0 carp "Head1Level supplied ($arg) must be integer in range 0 to ".$#LatexSections . "- Ignoring\n";
578             }
579             }
580 7         21 return $self->{Head1Level};
581             }
582              
583             =item B
584              
585             This is the label that is prefixed to all C label and index
586             entries to make them unique. In general, pods have similarly titled
587             sections (NAME, DESCRIPTION etc) and a C label will be multiply
588             defined if more than one pod document is to be included in a single
589             C file. To overcome this, this label is prefixed to a label
590             whenever a label is required (joined with an underscore) or to an
591             index entry (joined by an exclamation mark which is the normal index
592             separator). For example, C<\label{text}> becomes C<\label{Label_text}>.
593              
594             Can be used to set or retrieve the current value:
595              
596             $label = $parser->Label;
597             $parser->Label($label);
598              
599             This label is only used if C is true.
600             Its value is set automatically from the C field
601             if C is true. If this is not the case
602             it must be set manually before starting the parse.
603              
604             Default value is C.
605              
606             =cut
607              
608             sub Label {
609 12     12 1 14 my $self = shift;
610 12 50       26 if (@_) {
611 0         0 $self->{Label} = shift;
612             }
613 12         46 return $self->{Label};
614             }
615              
616             =item B
617              
618             Control the point at which C section numbering is turned off.
619             For example, this can be used to make sure that C sections
620             are numbered but subsections are not.
621              
622             Can be used to set or retrieve the current value:
623              
624             $lev = $parser->LevelNoNum;
625             $parser->LevelNoNum(2);
626              
627             The argument must be an integer between 0 and 5 and is the same as the
628             number described in C method description. The number has
629             nothing to do with the pod heading number, only the C sectioning.
630              
631             Default is 2. (i.e. C subsections are written as C
632             but sections are numbered).
633              
634             =cut
635              
636             sub LevelNoNum {
637 6     6 1 8 my $self = shift;
638 6 50       16 if (@_) {
639 0         0 $self->{LevelNoNum} = shift;
640             }
641 6         18 return $self->{LevelNoNum};
642             }
643              
644             =item B
645              
646             Controls whether C commands for creating an index are to be inserted
647             into the preamble and postamble
648              
649             $makeindex = $parser->MakeIndex;
650             $parser->MakeIndex(0);
651              
652             Irrelevant if both C and C are false (or equivalently,
653             C and C are set).
654              
655             Default is for an index to be created.
656              
657             =cut
658              
659             sub MakeIndex {
660 2     2 1 4 my $self = shift;
661 2 50       29 if (@_) {
662 0         0 $self->{MakeIndex} = shift;
663             }
664 2         9 return $self->{MakeIndex};
665             }
666              
667             =item B
668              
669             This controls whether the C section in the pod is to be translated
670             literally or converted to a slightly modified output where the section
671             name is the pod name rather than "NAME".
672              
673             If true, the pod segment
674              
675             =head1 NAME
676              
677             pod::name - purpose
678              
679             =head1 SYNOPSIS
680              
681             is converted to the C
682              
683             \section{pod::name\label{pod_name}\index{pod::name}}
684              
685             Purpose
686              
687             \subsection*{SYNOPSIS\label{pod_name_SYNOPSIS}%
688             \index{pod::name!SYNOPSIS}}
689              
690             (dependent on the value of C and C). Note that
691             subsequent C directives translate to subsections rather than
692             sections and that the labels and index now include the pod name (dependent
693             on the value of C).
694              
695             The C
696             of C
697              
698             $mod = $parser->ReplaceNAMEwithSection;
699             $parser->ReplaceNAMEwithSection(0);
700              
701             Default is to translate the pod literally.
702              
703             =cut
704              
705             sub ReplaceNAMEwithSection {
706 0     0 1 0 my $self = shift;
707 0 0       0 if (@_) {
708 0         0 $self->{ReplaceNAMEwithSection} = shift;
709             }
710 0         0 return $self->{ReplaceNAMEwithSection};
711             }
712              
713             =item B
714              
715             If true, each pod translation will begin with a C
716             C<\clearpage>.
717              
718             $parser->StartWithNewPage(1);
719             $newpage = $parser->StartWithNewPage;
720              
721             Default is false.
722              
723             =cut
724              
725             sub StartWithNewPage {
726 2     2 1 4 my $self = shift;
727 2 50       11 if (@_) {
728 0         0 $self->{StartWithNewPage} = shift;
729             }
730 2         262 return $self->{StartWithNewPage};
731             }
732              
733             =item B
734              
735             If true, a table of contents will be created.
736             Irrelevant if C is false or C
737             is set.
738              
739             $toc = $parser->TableOfContents;
740             $parser->TableOfContents(1);
741              
742             Default is false.
743              
744             =cut
745              
746             sub TableOfContents {
747 2     2 1 7 my $self = shift;
748 2 100       13 if (@_) {
749 1         2 $self->{TableOfContents} = shift;
750             }
751 2         14 return $self->{TableOfContents};
752             }
753              
754             =item B
755              
756             If true, the translator will attempt to make sure that
757             each C label or index entry will be uniquely identified
758             by prefixing the contents of C
759             multiple documents to be combined without clashing
760             common labels such as C and C
761              
762             $parser->UniqueLabels(1);
763             $unq = $parser->UniqueLabels;
764              
765             Default is true.
766              
767             =cut
768              
769             sub UniqueLabels {
770 12     12 1 15 my $self = shift;
771 12 50       28 if (@_) {
772 0         0 $self->{UniqueLabels} = shift;
773             }
774 12         84 return $self->{UniqueLabels};
775             }
776              
777             =item B
778              
779             User supplied C preamble. Added before the pod translation
780             data.
781              
782             If set, the contents will be prepended to the output file before the translated
783             data regardless of the value of C.
784             C and C will also be ignored.
785              
786             =cut
787              
788             sub UserPreamble {
789 3     3 1 5 my $self = shift;
790 3 50       9 if (@_) {
791 0         0 $self->{UserPreamble} = shift;
792             }
793 3         12 return $self->{UserPreamble};
794             }
795              
796             =item B
797              
798             User supplied C postamble. Added after the pod translation
799             data.
800              
801             If set, the contents will be prepended to the output file after the translated
802             data regardless of the value of C.
803             C will also be ignored.
804              
805             =cut
806              
807             sub UserPostamble {
808 3     3 1 5 my $self = shift;
809 3 50       10 if (@_) {
810 0         0 $self->{UserPostamble} = shift;
811             }
812 3         11 return $self->{UserPostamble};
813             }
814              
815             =begin __PRIVATE__
816              
817             =item B
818              
819             Contains details of the currently active lists.
820             The array contains C objects. A new C
821             object is created each time a list is encountered and it is
822             pushed onto this stack. When the list context ends, it
823             is popped from the stack. The array will be empty if no
824             lists are active.
825              
826             Returns array of list information in list context
827             Returns array ref in scalar context
828              
829             =cut
830              
831              
832              
833             sub lists {
834 76     76 0 87 my $self = shift;
835 76 50       137 return @{ $self->{_Lists} } if wantarray();
  0         0  
836 76         527 return $self->{_Lists};
837             }
838              
839             =end __PRIVATE__
840              
841             =back
842              
843             =begin __PRIVATE__
844              
845             =head2 Subclassed methods
846              
847             The following methods override methods provided in the C
848             base class. See C and C for more information
849             on what these methods require.
850              
851             =over 4
852              
853             =cut
854              
855             ######### END ACCESSORS ###################
856              
857             # Opening pod
858              
859             =item B
860              
861             Writes the C preamble if requested. Only writes something
862             if AddPreamble is true. Writes a standard header unless a UserPreamble
863             is defined.
864              
865             =cut
866              
867             sub begin_pod {
868 2     2 1 1200 my $self = shift;
869              
870             # Get the pod identification
871             # This should really come from the '=head1 NAME' paragraph
872              
873 2         22 my $infile = $self->input_file;
874 2         6 my $class = ref($self);
875 2         57 my $date = gmtime(time);
876              
877             # Comment message to say where this came from
878 2         9 my $comment = << "__TEX_COMMENT__";
879             %% Latex generated from POD in document $infile
880             %% Using the perl module $class
881             %% Converted on $date
882             __TEX_COMMENT__
883              
884             # Write the preamble
885             # If the caller has supplied one then we just use that
886              
887 2         6 my $preamble = '';
888              
889 2 50       5 if ($self->AddPreamble) {
890              
891 2 100       8 if (defined $self->UserPreamble) {
892              
893 1         3 $preamble = $self->UserPreamble;
894              
895             # Add the description of where this came from
896 1         5 $preamble .= "\n$comment\n%% Preamble supplied by user.\n\n";
897              
898             } else {
899              
900             # Write our own preamble
901              
902             # Code to initialise index making
903             # Use an array so that we can prepend comment if required
904 1         3 my @makeidx = (
905             '\usepackage{makeidx}',
906             '\makeindex',
907             );
908              
909 1 50       4 unless ($self->MakeIndex) {
910 0         0 foreach (@makeidx) {
911 0         0 $_ = '%% ' . $_;
912             }
913             }
914 1         5 my $makeindex = join("\n",@makeidx) . "\n";
915              
916             # Table of contents
917 1         2 my $tableofcontents = '\tableofcontents';
918              
919 1 50       4 $tableofcontents = '%% ' . $tableofcontents
920             unless $self->TableOfContents;
921              
922             # Roll our own
923 1         7 $preamble = << "__TEX_HEADER__";
924             \\documentclass{article}
925             \\usepackage[T1]{fontenc}
926             \\usepackage{textcomp}
927              
928             $comment
929              
930             $makeindex
931              
932             \\begin{document}
933              
934             $tableofcontents
935              
936             __TEX_HEADER__
937              
938             }
939             }
940              
941             # Write the header (blank if none)
942 2         9 $self->_output($preamble);
943              
944             # Start on new page if requested
945 2 50       8 $self->_output("\\clearpage\n") if $self->StartWithNewPage;
946              
947             }
948              
949              
950             =item B
951              
952             Write the closing C code. Only writes something if AddPostamble
953             is true. Writes a standard header unless a UserPostamble is defined.
954              
955             =cut
956              
957             sub end_pod {
958 2     2 1 4 my $self = shift;
959              
960             # End string
961 2         6 my $end = '';
962              
963             # Use the user version of the postamble if defined
964 2 50       17 if ($self->AddPostamble) {
965              
966 2 100       9 if (defined $self->UserPostamble) {
967 1         4 $end = $self->UserPostamble;
968              
969             } else {
970              
971             # Check for index
972 1         10 my $makeindex = '\printindex';
973              
974 1 50       5 $makeindex = '%% '. $makeindex unless $self->MakeIndex;
975              
976 1         3 $end = "$makeindex\n\n\\end{document}\n";
977             }
978             }
979              
980 2         13 $self->_output($end);
981              
982             }
983              
984             =item B
985              
986             Process basic pod commands.
987              
988             =cut
989              
990             sub command {
991 32     32 1 350 my $self = shift;
992 32         51 my ($command, $paragraph, $line_num, $parobj) = @_;
993              
994             # return if we dont care
995 32 50       82 return if $command eq 'pod';
996              
997             # Store a copy of the raw text in case we are in a =for
998             # block and need to preserve the existing latex
999 32         40 my $rawpara = $paragraph;
1000              
1001             # Do the latex escapes
1002 32         60 $paragraph = $self->_replace_special_chars($paragraph);
1003              
1004             # Interpolate pod sequences in paragraph
1005 32         1828 $paragraph = $self->interpolate($paragraph, $line_num);
1006 32         139 $paragraph =~ s/\s+$//;
1007              
1008             # Replace characters that can only be done after
1009             # interpolation of interior sequences
1010 32         72 $paragraph = $self->_replace_special_chars_late($paragraph);
1011              
1012             # Now run the command
1013 32 100       155 if ($command eq 'over') {
    100          
    100          
    100          
    50          
    50          
    50          
    50          
    50          
    100          
    100          
    50          
    0          
1014              
1015 4         15 $self->begin_list($paragraph, $line_num);
1016              
1017             } elsif ($command eq 'item') {
1018              
1019 14         37 $self->add_item($paragraph, $line_num);
1020              
1021             } elsif ($command eq 'back') {
1022              
1023 4         12 $self->end_list($line_num);
1024              
1025             } elsif ($command eq 'head1') {
1026              
1027             # Store the name of the section
1028 6         13 $self->{_CURRENT_HEAD1} = $paragraph;
1029              
1030             # Print it
1031 6         19 $self->head(1, $paragraph, $parobj);
1032              
1033             } elsif ($command eq 'head2') {
1034              
1035 0         0 $self->head(2, $paragraph, $parobj);
1036              
1037             } elsif ($command eq 'head3') {
1038              
1039 0         0 $self->head(3, $paragraph, $parobj);
1040              
1041             } elsif ($command eq 'head4') {
1042              
1043 0         0 $self->head(4, $paragraph, $parobj);
1044              
1045             } elsif ($command eq 'head5') {
1046              
1047 0         0 $self->head(5, $paragraph, $parobj);
1048              
1049             } elsif ($command eq 'head6') {
1050              
1051 0         0 $self->head(6, $paragraph, $parobj);
1052              
1053             } elsif ($command eq 'begin') {
1054              
1055             # pass through if latex
1056 1 50       6 if ($paragraph =~ /^latex/i) {
1057             # Make sure that subsequent paragraphs are not modfied before printing
1058 1         52 $self->{_dont_modify_any_para} = 1;
1059              
1060             } else {
1061             # Suppress all subsequent paragraphs unless
1062             # it is explicitly intended for latex
1063 0         0 $self->{_suppress_all_para} = 1;
1064             }
1065              
1066             } elsif ($command eq 'for') {
1067              
1068             # =for latex
1069             # some latex
1070              
1071             # With =for we will get the text for the full paragraph
1072             # as well as the format name.
1073             # We do not get an additional paragraph later on. The next
1074             # paragraph is not governed by the =for
1075              
1076             # The first line contains the format and the rest is the
1077             # raw code.
1078 2         6 my ($format, $chunk) = split(/\n/, $rawpara, 2);
1079              
1080             # If we have got some latex code print it out immediately
1081             # unmodified. Else do nothing.
1082 2 100       61 if ($format =~ /^latex/i) {
1083             # Make sure that next paragraph is not modfied before printing
1084 1         4 $self->_output( $chunk );
1085              
1086             }
1087              
1088             } elsif ($command eq 'end') {
1089              
1090             # Reset suppression
1091 1         4 $self->{_suppress_all_para} = 0;
1092 1         59 $self->{_dont_modify_any_para} = 0;
1093              
1094             } elsif ($command eq 'pod') {
1095              
1096             # Do nothing
1097              
1098             } else {
1099 0         0 carp "Command $command not recognised at line $line_num\n";
1100             }
1101              
1102             }
1103              
1104             =item B
1105              
1106             Verbatim text
1107              
1108             =cut
1109              
1110             sub verbatim {
1111 3     3 1 5 my $self = shift;
1112 3         4 my ($paragraph, $line_num, $parobj) = @_;
1113              
1114             # Expand paragraph unless in =begin block
1115 3 50       8 if ($self->{_dont_modify_any_para}) {
1116             # Just print as is
1117 0         0 $self->_output($paragraph);
1118              
1119             } else {
1120              
1121 3 100       64 return if $paragraph =~ /^\s+$/;
1122              
1123             # Clean trailing space
1124 2         9 $paragraph =~ s/\s+$//;
1125              
1126             # Clean tabs. Routine taken from Tabs.pm
1127             # by David Muir Sharnoff muir@idiom.com,
1128             # slightly modified by hsmyers@sdragons.com 10/22/01
1129 2         6 my @l = split("\n",$paragraph);
1130 2         5 foreach (@l) {
1131 3         89 1 while s/(^|\n)([^\t\n]*)(\t+)/
1132 1         11 $1. $2 . (" " x
1133             (8 * length($3)
1134             - (length($2) % 8)))
1135             /sex;
1136             }
1137 2         5 $paragraph = join("\n",@l);
1138             # End of change.
1139              
1140              
1141              
1142 2         7 $self->_output('\begin{verbatim}' . "\n$paragraph\n". '\end{verbatim}'."\n");
1143             }
1144             }
1145              
1146             =item B
1147              
1148             Plain text paragraph.
1149              
1150             =cut
1151              
1152             sub textblock {
1153 29     29 1 1018 my $self = shift;
1154 29         46 my ($paragraph, $line_num, $parobj) = @_;
1155              
1156             # print Dumper($self);
1157              
1158             # Expand paragraph unless in =begin block
1159 29 100       72 if ($self->{_dont_modify_any_para}) {
1160             # Just print as is
1161 3         8 $self->_output($paragraph);
1162              
1163 3         140 return;
1164             }
1165              
1166              
1167             # Escape latex special characters
1168 26         51 $paragraph = $self->_replace_special_chars($paragraph);
1169              
1170             # Interpolate interior sequences
1171 26         1863 my $expansion = $self->interpolate($paragraph, $line_num);
1172 26         164 $expansion =~ s/\s+$//;
1173              
1174             # Escape special characters that can not be done earlier
1175 26         67 $expansion = $self->_replace_special_chars_late($expansion);
1176              
1177             # If we are replacing 'head1 NAME' with a section
1178             # we need to look in the paragraph and rewrite things
1179             # Need to make sure this is called only on the first paragraph
1180             # following 'head1 NAME' and not on subsequent paragraphs that may be
1181             # present.
1182 26 50 33     110 if ($self->{_CURRENT_HEAD1} =~ /^NAME/i && $self->ReplaceNAMEwithSection()) {
1183              
1184             # Strip white space from start and end
1185 0         0 $paragraph =~ s/^\s+//;
1186 0         0 $paragraph =~ s/\s$//;
1187              
1188             # Split the string into 2 parts
1189 0         0 my ($name, $purpose) = split(/\s+-\s+/, $expansion,2);
1190              
1191             # Now prevent this from triggering until a new head1 NAME is set
1192 0         0 $self->{_CURRENT_HEAD1} = '_NAME';
1193              
1194             # Might want to clear the Label() before doing this (CHECK)
1195              
1196             # Print the heading
1197 0         0 $self->head(1, $name, $parobj);
1198              
1199             # Set the labeling in case we want unique names later
1200 0         0 $self->Label( $self->_create_label( $name, 1 ) );
1201              
1202             # Raise the Head1Level by one so that subsequent =head1 appear
1203             # as subsections of the main name section unless we are already
1204             # at maximum [Head1Level() could check this itself - CHECK]
1205 0 0       0 $self->Head1Level( $self->Head1Level() + 1)
1206             unless $self->Head1Level == $#LatexSections;
1207              
1208             # Now write out the new latex paragraph
1209 0         0 $purpose = ucfirst($purpose);
1210 0         0 $self->_output("\n\n$purpose\n\n");
1211              
1212             } else {
1213             # Just write the output
1214 26         138 $self->_output("\n\n$expansion\n\n");
1215             }
1216              
1217             }
1218              
1219             =item B
1220              
1221             Interior sequence expansion
1222              
1223             =cut
1224              
1225             sub interior_sequence {
1226 24     24 1 555 my $self = shift;
1227              
1228 24         40 my ($seq_command, $seq_argument, $pod_seq) = @_;
1229              
1230 24 100       136 if ($seq_command eq 'B') {
    100          
    100          
    50          
    100          
    50          
    50          
    100          
    100          
    50          
    0          
1231 1         43 return "\\textbf{$seq_argument}";
1232              
1233             } elsif ($seq_command eq 'I') {
1234 2         132 return "\\textit{$seq_argument}";
1235              
1236             } elsif ($seq_command eq 'E') {
1237              
1238             # If it is simply a number
1239 7 50       34 if ($seq_argument =~ /^\d+$/) {
    50          
1240 0         0 return chr($seq_argument);
1241             # Look up escape in hash table
1242             } elsif (exists $HTML_Escapes{$seq_argument}) {
1243 7         520 return $HTML_Escapes{$seq_argument};
1244              
1245             } else {
1246 0         0 my ($file, $line) = $pod_seq->file_line();
1247 0         0 warn "Escape sequence $seq_argument not recognised at line $line of file $file\n";
1248 0         0 return;
1249             }
1250              
1251             } elsif ($seq_command eq 'Z') {
1252              
1253             # Zero width space
1254 0         0 return '{}';
1255              
1256             } elsif ($seq_command eq 'C') {
1257 5         326 return "\\texttt{$seq_argument}";
1258              
1259             } elsif ($seq_command eq 'F') {
1260 0         0 return "\\emph{$seq_argument}";
1261              
1262             } elsif ($seq_command eq 'S') {
1263             # non breakable spaces
1264 0         0 my $nbsp = '~';
1265              
1266 0         0 $seq_argument =~ s/\s/$nbsp/g;
1267 0         0 return $seq_argument;
1268              
1269             } elsif ($seq_command eq 'L') {
1270 4         19 my $link = new Pod::Hyperlink($seq_argument);
1271              
1272             # undef on failure
1273 4 50       2103 unless (defined $link) {
1274 0         0 carp $@;
1275 0         0 return;
1276             }
1277              
1278             # Handle internal links differently
1279 4         15 my $type = $link->type;
1280 4         29 my $page = $link->page;
1281              
1282 4 50 66     39 if ($type eq 'section' && $page eq '') {
1283             # Use internal latex reference
1284 0         0 my $node = $link->node;
1285              
1286             # Convert to a label
1287 0         0 $node = $self->_create_label($node);
1288              
1289 0         0 return "\\S\\ref{$node}";
1290              
1291             } else {
1292             # Use default markup for external references
1293             # (although Starlink would use \xlabel)
1294 4         15 my $markup = $link->markup;
1295 4         43 my ($file, $line) = $pod_seq->file_line();
1296              
1297 4         11 return $self->interpolate($link->markup, $line);
1298             }
1299              
1300              
1301              
1302             } elsif ($seq_command eq 'P') {
1303             # Special markup for Pod::Hyperlink
1304             # Replace :: with / - but not sure if I want to do this
1305             # any more.
1306 2         5 my $link = $seq_argument;
1307 2         9 $link =~ s|::|/|g;
1308              
1309 2         5 my $ref = "\\emph{$seq_argument}";
1310 2         180 return $ref;
1311              
1312             } elsif ($seq_command eq 'Q') {
1313             # Special markup for Pod::Hyperlink
1314 3         334 return "\\textsf{$seq_argument}";
1315              
1316             } elsif ($seq_command eq 'X') {
1317             # Index entries
1318              
1319             # use \index command
1320             # I will let '!' go through for now
1321             # not sure how sub categories are handled in X<>
1322 0         0 my $index = $self->_create_index($seq_argument);
1323 0         0 return "\\index{$index}\n";
1324              
1325             } else {
1326 0         0 carp "Unknown sequence $seq_command<$seq_argument>";
1327             }
1328              
1329             }
1330              
1331             =back
1332              
1333             =head2 List Methods
1334              
1335             Methods used to handle lists.
1336              
1337             =over 4
1338              
1339             =item B
1340              
1341             Called when a new list is found (via the C directive).
1342             Creates a new C object and stores it on the
1343             list stack.
1344              
1345             $parser->begin_list($indent, $line_num);
1346              
1347             =cut
1348              
1349             sub begin_list {
1350 4     4 1 5 my $self = shift;
1351 4         5 my $indent = shift;
1352 4         6 my $line_num = shift;
1353              
1354             # Indicate that a list should be started for the next item
1355             # need to do this to work out the type of list
1356 4         12 push ( @{$self->lists}, new Pod::List(-indent => $indent,
  4         15  
1357             -start => $line_num,
1358             -file => $self->input_file,
1359             )
1360             );
1361              
1362             }
1363              
1364             =item B
1365              
1366             Called when the end of a list is found (the C directive).
1367             Pops the C object off the stack of lists and writes
1368             the C code required to close a list.
1369              
1370             $parser->end_list($line_num);
1371              
1372             =cut
1373              
1374             sub end_list {
1375 4     4 1 6 my $self = shift;
1376 4         5 my $line_num = shift;
1377              
1378 4 50       8 unless (defined $self->lists->[-1]) {
1379 0         0 my $file = $self->input_file;
1380 0         0 warn "No list is active at line $line_num (file=$file). Missing =over?\n";
1381 0         0 return;
1382             }
1383              
1384             # What to write depends on list type
1385 4         15 my $type = $self->lists->[-1]->type;
1386              
1387             # Don't write anything if the list type is not set
1388             # iomplying that a list was created but no entries were
1389             # placed in it (eg because of a =begin/=end combination)
1390 4 50 33     45 $self->_output("\\end{$type}\n")
1391             if (defined $type && length($type) > 0);
1392            
1393             # Clear list
1394 4         7 pop(@{ $self->lists});
  4         8  
1395              
1396             }
1397              
1398             =item B
1399              
1400             Add items to the list. The first time an item is encountered
1401             (determined from the state of the current C object)
1402             the type of list is determined (ordered, unnumbered or description)
1403             and the relevant latex code issued.
1404              
1405             $parser->add_item($paragraph, $line_num);
1406              
1407             =cut
1408              
1409             sub add_item {
1410 14     14 1 15 my $self = shift;
1411 14         17 my $paragraph = shift;
1412 14         15 my $line_num = shift;
1413              
1414 14 50       25 unless (defined $self->lists->[-1]) {
1415 0         0 my $file = $self->input_file;
1416 0         0 warn "List has already ended by line $line_num of file $file. Missing =over?\n";
1417             # Replace special chars
1418             # $paragraph = $self->_replace_special_chars($paragraph);
1419 0         0 $self->_output("$paragraph\n\n");
1420 0         0 return;
1421             }
1422              
1423             # If paragraphs printing is turned off via =begin/=end or whatever
1424             # simply return immediately
1425 14 50       29 return if $self->{_suppress_all_para};
1426              
1427             # Check to see whether we are starting a new lists
1428 14 100       30 if (scalar($self->lists->[-1]->item) == 0) {
1429              
1430             # Examine the paragraph to determine what type of list
1431             # we have
1432 4         36 $paragraph =~ s/\s+$//;
1433 4         9 $paragraph =~ s/^\s+//;
1434              
1435 4         6 my $type;
1436 4 100       16 if (substr($paragraph, 0,1) eq '*') {
    100          
1437 2         8 $type = 'itemize';
1438             } elsif ($paragraph =~ /^\d/) {
1439 1         3 $type = 'enumerate';
1440             } else {
1441 1         3 $type = 'description';
1442             }
1443 4         9 $self->lists->[-1]->type($type);
1444              
1445 4         28 $self->_output("\\begin{$type}\n");
1446              
1447             }
1448              
1449 14         88 my $type = $self->lists->[-1]->type;
1450              
1451 14 100       74 if ($type eq 'description') {
1452             # Handle long items - long items do not wrap
1453             # If the string is longer than 40 characters we split
1454             # it into a real item header and some bold text.
1455 5         8 my $maxlen = 40;
1456 5         16 my ($hunk1, $hunk2) = $self->_split_delimited( $paragraph, $maxlen );
1457              
1458             # Print the first hunk
1459 5         23 $self->_output("\n\\item[{$hunk1}] ");
1460              
1461             # and the second hunk if it is defined
1462 5 100       13 if ($hunk2) {
1463 2         9 $self->_output("\\textbf{$hunk2}");
1464             } else {
1465             # Not there so make sure we have a new line
1466 3         7 $self->_output("\\mbox{}");
1467             }
1468              
1469             } else {
1470             # If the item was '* Something' or '\d+ something' we still need to write
1471             # out the something. Also allow 1) and 1.
1472 9         12 my $extra_info = $paragraph;
1473 9         32 $extra_info =~ s/^(\*|\d+[\.\)]?)\s*//;
1474 9         24 $self->_output("\n\\item $extra_info");
1475             }
1476              
1477             # Store the item name in the object. Required so that
1478             # we can tell if the list is new or not
1479 14         35 $self->lists->[-1]->item($paragraph);
1480              
1481             }
1482              
1483             =back
1484              
1485             =head2 Methods for headings
1486              
1487             =over 4
1488              
1489             =item B
1490              
1491             Print a heading of the required level.
1492              
1493             $parser->head($level, $paragraph, $parobj);
1494              
1495             The first argument is the pod heading level. The second argument
1496             is the contents of the heading. The 3rd argument is a Pod::Paragraph
1497             object so that the line number can be extracted.
1498              
1499             =cut
1500              
1501             sub head {
1502 6     6 1 11 my $self = shift;
1503 6         7 my $num = shift;
1504 6         7 my $paragraph = shift;
1505 6         9 my $parobj = shift;
1506              
1507             # If we are replace 'head1 NAME' with a section
1508             # we return immediately if we get it
1509             return
1510 6 50 33     42 if ($self->{_CURRENT_HEAD1} =~ /^NAME/i && $self->ReplaceNAMEwithSection());
1511              
1512             # Create a label
1513 6         21 my $label = $self->_create_label($paragraph);
1514              
1515             # Create an index entry
1516 6         27 my $index = $self->_create_index($paragraph);
1517              
1518             # Work out position in the above array taking into account
1519             # that =head1 is equivalent to $self->Head1Level
1520              
1521 6         18 my $level = $self->Head1Level() - 1 + $num;
1522              
1523             # Warn if heading to large
1524 6 50       20 if ($num > $#LatexSections) {
1525 0         0 my $line = $parobj->file_line;
1526 0         0 my $file = $self->input_file;
1527 0         0 warn "Heading level too large ($level) for LaTeX at line $line of file $file\n";
1528 0         0 $level = $#LatexSections;
1529             }
1530              
1531             # Check to see whether section should be unnumbered
1532 6 50       17 my $star = ($level >= $self->LevelNoNum ? '*' : '');
1533              
1534             # Section
1535 6         29 $self->_output("\\" .$LatexSections[$level] .$star ."{$paragraph\\label{".$label ."}\\index{".$index."}}\n");
1536              
1537             }
1538              
1539              
1540             =back
1541              
1542             =end __PRIVATE__
1543              
1544             =begin __PRIVATE__
1545              
1546             =head2 Internal methods
1547              
1548             Internal routines are described in this section. They do not form part of the
1549             public interface. All private methods start with an underscore.
1550              
1551             =over 4
1552              
1553             =item B<_output>
1554              
1555             Output text to the output filehandle. This method must be always be called
1556             to output parsed text.
1557              
1558             $parser->_output($text);
1559              
1560             Does not write anything if a =begin is active that should be
1561             ignored.
1562              
1563             =cut
1564              
1565             sub _output {
1566 69     69   103 my $self = shift;
1567 69         84 my $text = shift;
1568              
1569 69 50       163 print { $self->output_handle } $text
  69         2567  
1570             unless $self->{_suppress_all_para};
1571              
1572             }
1573              
1574              
1575             =item B<_replace_special_chars>
1576              
1577             Subroutine to replace characters that are special in C
1578             with the escaped forms
1579              
1580             $escaped = $parser->_replace_special_chars($paragraph);
1581              
1582             Need to call this routine before interior_sequences are munged but not
1583             if verbatim. It must be called before interpolation of interior
1584             sequences so that curly brackets and special latex characters inserted
1585             during interpolation are not themselves escaped. This means that < and
1586             > can not be modified here since the text still contains interior
1587             sequences.
1588              
1589             Special characters and the C equivalents are:
1590              
1591             } \}
1592             { \{
1593             _ \_
1594             $ \$
1595             % \%
1596             & \&
1597             \ $\backslash$
1598             ^ \^{}
1599             ~ \~{}
1600             # \#
1601              
1602             =cut
1603              
1604             sub _replace_special_chars {
1605 58     58   65 my $self = shift;
1606 58         61 my $paragraph = shift;
1607              
1608             # Replace a \ with $\backslash$
1609             # This is made more complicated because the dollars will be escaped
1610             # by the subsequent replacement. Easiest to add \backslash
1611             # now and then add the dollars
1612 58         86 $paragraph =~ s/\\/\\backslash/g;
1613              
1614             # Must be done after escape of \ since this command adds latex escapes
1615             # Replace characters that can be escaped
1616 58         107 $paragraph =~ s/([\$\#&%_{}])/\\$1/g;
1617              
1618             # Replace ^ characters with \^{} so that $^F works okay
1619 58         75 $paragraph =~ s/(\^)/\\$1\{\}/g;
1620              
1621             # Replace tilde (~) with \texttt{\~{}}
1622 58         64 $paragraph =~ s/~/\\texttt\{\\~\{\}\}/g;
1623              
1624             # Now add the dollars around each \backslash
1625 58         73 $paragraph =~ s/(\\backslash)/\$$1\$/g;
1626              
1627             # Convert ------ to -{}-{}-{}-{}-{}-
1628 58         63 $paragraph =~ s/-(?=-)/-{}/g;
1629              
1630 58         123 return $paragraph;
1631             }
1632              
1633             =item B<_replace_special_chars_late>
1634              
1635             Replace special characters that can not be replaced before interior
1636             sequence interpolation. See C<_replace_special_chars> for a routine
1637             to replace special characters prior to interpolation of interior
1638             sequences.
1639              
1640             Does the following transformation:
1641              
1642             < $<$
1643             > $>$
1644             | $|$
1645              
1646              
1647             =cut
1648              
1649             sub _replace_special_chars_late {
1650 58     58   72 my $self = shift;
1651 58         75 my $paragraph = shift;
1652              
1653             # < and >
1654 58         152 $paragraph =~ s/(<|>)/\$$1\$/g;
1655              
1656             # Replace | with $|$
1657 58         82 $paragraph =~ s'\|'$|$'g;
1658              
1659              
1660 58         117 return $paragraph;
1661             }
1662              
1663              
1664             =item B<_create_label>
1665              
1666             Return a string that can be used as an internal reference
1667             in a C document (i.e. accepted by the C<\label> command)
1668              
1669             $label = $parser->_create_label($string)
1670              
1671             If UniqueLabels is true returns a label prefixed by Label()
1672             This can be suppressed with an optional second argument.
1673              
1674             $label = $parser->_create_label($string, $suppress);
1675              
1676             If a second argument is supplied (of any value including undef)
1677             the Label() is never prefixed. This means that this routine can
1678             be called to create a Label() without prefixing a previous setting.
1679              
1680             =cut
1681              
1682             sub _create_label {
1683 6     6   6 my $self = shift;
1684 6         10 my $paragraph = shift;
1685 6 50       16 my $suppress = (@_ ? 1 : 0 );
1686              
1687             # Remove latex commands
1688 6         23 $paragraph = $self->_clean_latex_commands($paragraph);
1689              
1690             # Remove non alphanumerics from the label and replace with underscores
1691             # want to protect '-' though so use negated character classes
1692 6         15 $paragraph =~ s/[^-:\w]/_/g;
1693              
1694             # Multiple underscores will look unsightly so remove repeats
1695             # This will also have the advantage of tidying up the end and
1696             # start of string
1697 6         13 $paragraph =~ s/_+/_/g;
1698              
1699             # If required need to make sure that the label is unique
1700             # since it is possible to have multiple pods in a single
1701             # document
1702 6 50 33     31 if (!$suppress && $self->UniqueLabels() && defined $self->Label) {
      33        
1703 0         0 $paragraph = $self->Label() .'_'. $paragraph;
1704             }
1705              
1706 6         12 return $paragraph;
1707             }
1708              
1709              
1710             =item B<_create_index>
1711              
1712             Similar to C<_create_label> except an index entry is created.
1713             If C is true, the index entry is prefixed by
1714             the current C
1715              
1716             $ind = $parser->_create_index($paragraph);
1717              
1718             An exclamation mark is used by C to generate
1719             sub-entries in an index.
1720              
1721             =cut
1722              
1723             sub _create_index {
1724 6     6   9 my $self = shift;
1725 6         14 my $paragraph = shift;
1726 6 50       19 my $suppress = (@_ ? 1 : 0 );
1727              
1728             # Remove latex commands
1729 6         13 $paragraph = $self->_clean_latex_commands($paragraph);
1730              
1731             # If required need to make sure that the index entry is unique
1732             # since it is possible to have multiple pods in a single
1733             # document
1734 6 50 33     32 if (!$suppress && $self->UniqueLabels() && defined $self->Label) {
      33        
1735 0         0 $paragraph = $self->Label() .'!'. $paragraph;
1736             }
1737              
1738             # Need to replace _ with space
1739 6         9 $paragraph =~ s/_/ /g;
1740              
1741 6         13 return $paragraph;
1742              
1743             }
1744              
1745             =item B<_clean_latex_commands>
1746              
1747             Removes latex commands from text. The latex command is assumed to be of the
1748             form C<\command{ text }>. "C" is retained
1749              
1750             $clean = $parser->_clean_latex_commands($text);
1751              
1752             =cut
1753              
1754             sub _clean_latex_commands {
1755 12     12   17 my $self = shift;
1756 12         17 my $paragraph = shift;
1757              
1758             # Remove latex commands of the form \text{ }
1759             # and replace with the contents of the { }
1760             # need to make this non-greedy so that it can handle
1761             # "\text{a} and \text2{b}"
1762             # without converting it to
1763             # "a} and \text2{b"
1764             # This match will still get into trouble if \} is present
1765             # This is not vital since the subsequent replacement of non-alphanumeric
1766             # characters will tidy it up anyway
1767 12         17 $paragraph =~ s/\\\w+{(.*?)}/$1/g;
1768              
1769 12         25 return $paragraph
1770             }
1771              
1772             =item B<_split_delimited>
1773              
1774             Split the supplied string into two parts at approximately the
1775             specified word boundary. Special care is made to make sure that it
1776             does not split in the middle of some curly brackets.
1777              
1778             e.g. "this text is \textbf{very bold}" would not be split into
1779             "this text is \textbf{very" and " bold".
1780              
1781             ($hunk1, $hunk2) = $self->_split_delimited( $para, $length);
1782              
1783             The length indicates the maximum length of hunk1.
1784              
1785             =cut
1786              
1787             # initially Supplied by hsmyers@sdragons.com
1788             # 10/25/01, utility to split \hbox
1789             # busting lines. Reformatted by TimJ to match module style.
1790             sub _split_delimited {
1791 5     5   7 my $self = shift;
1792 5         9 my $input = shift;
1793 5         6 my $limit = shift;
1794              
1795             # Return immediately if already small
1796 5 100       18 return ($input, '') if length($input) < $limit;
1797              
1798 2         3 my @output;
1799 2         5 my $s = '';
1800 2         3 my $t = '';
1801 2         3 my $depth = 0;
1802 2         2 my $token;
1803              
1804 2         4 $input =~ s/\n/ /gm;
1805 2         5 $input .= ' ';
1806 2         21 foreach ( split ( //, $input ) ) {
1807 126         129 $token .= $_;
1808 126 100 100     518 if (/\{/) {
    100          
    100          
1809 1         2 $depth++;
1810             } elsif ( /}/ ) {
1811 1         2 $depth--;
1812             } elsif ( / / and $depth == 0) {
1813 20 50 33     100 push @output, $token if ( $token and $token ne ' ' );
1814 20         33 $token = '';
1815             }
1816             }
1817              
1818 2         16 foreach (@output) {
1819 20 100       33 if (length($s) < $limit) {
1820 14         20 $s .= $_;
1821             } else {
1822 6         16 $t .= $_;
1823             }
1824             }
1825              
1826             # Tidy up
1827 2         14 $s =~ s/\s+$//;
1828 2         8 $t =~ s/\s+$//;
1829 2         10 return ($s,$t);
1830             }
1831              
1832             =back
1833              
1834             =end __PRIVATE__
1835              
1836             =head1 NOTES
1837              
1838             Compatible with C only. Can not be used with C v2.09
1839             or earlier.
1840              
1841             A subclass of C so that specific pod sections can be
1842             converted to C by using the C
1843              
1844             Some HTML escapes are missing and many have not been tested.
1845              
1846             =head1 SEE ALSO
1847              
1848             L, L, L, L.
1849              
1850             =head1 AUTHORS
1851              
1852             Tim Jenness Etjenness@cpan.orgE
1853              
1854             Bug fixes and improvements have been received from: Simon Cozens
1855             Esimon@cozens.netE, Mark A. Hershberger
1856             Emah@everybody.orgE, Marcel Grunauer
1857             Emarcel@codewerk.comE, Hugh S Myers
1858             Ehsmyers@sdragons.comE, Peter J Acklam
1859             Ejacklam@math.uio.noE, Sudhi Herle Esudhi@herle.netE,
1860             Ariel Scolnicov Eariels@compugen.co.ilE,
1861             Adriano Rodrigues Ferreira Eferreira@triang.com.brE,
1862             R. de Vries Er.de.vries@dutchspace.nlE and
1863             Dave Mitchell Edavem@iabyn.comE.
1864              
1865             =head1 COPYRIGHT
1866              
1867             Copyright (C) 2011 Tim Jenness.
1868             Copyright (C) 2000-2004 Tim Jenness. All Rights Reserved.
1869              
1870             This program is free software; you can redistribute it and/or modify
1871             it under the same terms as Perl itself.
1872              
1873             =begin __PRIVATE__
1874              
1875             =head1 REVISION
1876              
1877             $Id$
1878              
1879             =end __PRIVATE__
1880              
1881             =cut
1882              
1883             1;