Update podlators to version 4.03
[perl.git] / cpan / podlators / lib / Pod / Text.pm
1 # Pod::Text -- Convert POD data to formatted text.
2 #
3 # This module converts POD to formatted text.  It replaces the old Pod::Text
4 # module that came with versions of Perl prior to 5.6.0 and attempts to match
5 # its output except for some specific circumstances where other decisions
6 # seemed to produce better output.  It uses Pod::Parser and is designed to be
7 # very easy to subclass.
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 # Copyright 1999, 2000, 2001, 2002, 2004, 2006, 2008, 2009, 2012, 2013, 2014,
15 #     2015 Russ Allbery <rra@cpan.org>
16 #
17 # This program is free software; you may redistribute it and/or modify it
18 # under the same terms as Perl itself.
19
20 ##############################################################################
21 # Modules and declarations
22 ##############################################################################
23
24 package Pod::Text;
25
26 use 5.006;
27 use strict;
28 use warnings;
29
30 use vars qw(@ISA @EXPORT %ESCAPES $VERSION);
31
32 use Carp qw(carp croak);
33 use Encode qw(encode);
34 use Exporter ();
35 use Pod::Simple ();
36
37 @ISA = qw(Pod::Simple Exporter);
38
39 # We have to export pod2text for backward compatibility.
40 @EXPORT = qw(pod2text);
41
42 $VERSION = '4.03';
43
44 ##############################################################################
45 # Initialization
46 ##############################################################################
47
48 # This function handles code blocks.  It's registered as a callback to
49 # Pod::Simple and therefore doesn't work as a regular method call, but all it
50 # does is call output_code with the line.
51 sub handle_code {
52     my ($line, $number, $parser) = @_;
53     $parser->output_code ($line . "\n");
54 }
55
56 # Initialize the object and set various Pod::Simple options that we need.
57 # Here, we also process any additional options passed to the constructor or
58 # set up defaults if none were given.  Note that all internal object keys are
59 # in all-caps, reserving all lower-case object keys for Pod::Simple and user
60 # arguments.
61 sub new {
62     my $class = shift;
63     my $self = $class->SUPER::new;
64
65     # Tell Pod::Simple to handle S<> by automatically inserting &nbsp;.
66     $self->nbsp_for_S (1);
67
68     # Tell Pod::Simple to keep whitespace whenever possible.
69     if ($self->can ('preserve_whitespace')) {
70         $self->preserve_whitespace (1);
71     } else {
72         $self->fullstop_space_harden (1);
73     }
74
75     # The =for and =begin targets that we accept.
76     $self->accept_targets (qw/text TEXT/);
77
78     # Ensure that contiguous blocks of code are merged together.  Otherwise,
79     # some of the guesswork heuristics don't work right.
80     $self->merge_text (1);
81
82     # Pod::Simple doesn't do anything useful with our arguments, but we want
83     # to put them in our object as hash keys and values.  This could cause
84     # problems if we ever clash with Pod::Simple's own internal class
85     # variables.
86     my %opts = @_;
87     my @opts = map { ("opt_$_", $opts{$_}) } keys %opts;
88     %$self = (%$self, @opts);
89
90     # Send errors to stderr if requested.
91     if ($$self{opt_stderr} and not $$self{opt_errors}) {
92         $$self{opt_errors} = 'stderr';
93     }
94     delete $$self{opt_stderr};
95
96     # Validate the errors parameter and act on it.
97     if (not defined $$self{opt_errors}) {
98         $$self{opt_errors} = 'pod';
99     }
100     if ($$self{opt_errors} eq 'stderr' || $$self{opt_errors} eq 'die') {
101         $self->no_errata_section (1);
102         $self->complain_stderr (1);
103         if ($$self{opt_errors} eq 'die') {
104             $$self{complain_die} = 1;
105         }
106     } elsif ($$self{opt_errors} eq 'pod') {
107         $self->no_errata_section (0);
108         $self->complain_stderr (0);
109     } elsif ($$self{opt_errors} eq 'none') {
110         $self->no_whining (1);
111     } else {
112         croak (qq(Invalid errors setting: "$$self{errors}"));
113     }
114     delete $$self{errors};
115
116     # Initialize various things from our parameters.
117     $$self{opt_alt}      = 0  unless defined $$self{opt_alt};
118     $$self{opt_indent}   = 4  unless defined $$self{opt_indent};
119     $$self{opt_margin}   = 0  unless defined $$self{opt_margin};
120     $$self{opt_loose}    = 0  unless defined $$self{opt_loose};
121     $$self{opt_sentence} = 0  unless defined $$self{opt_sentence};
122     $$self{opt_width}    = 76 unless defined $$self{opt_width};
123
124     # Figure out what quotes we'll be using for C<> text.
125     $$self{opt_quotes} ||= '"';
126     if ($$self{opt_quotes} eq 'none') {
127         $$self{LQUOTE} = $$self{RQUOTE} = '';
128     } elsif (length ($$self{opt_quotes}) == 1) {
129         $$self{LQUOTE} = $$self{RQUOTE} = $$self{opt_quotes};
130     } elsif (length ($$self{opt_quotes}) % 2 == 0) {
131         my $length = length ($$self{opt_quotes}) / 2;
132         $$self{LQUOTE} = substr ($$self{opt_quotes}, 0, $length);
133         $$self{RQUOTE} = substr ($$self{opt_quotes}, $length);
134     } else {
135         croak qq(Invalid quote specification "$$self{opt_quotes}");
136     }
137
138     # If requested, do something with the non-POD text.
139     $self->code_handler (\&handle_code) if $$self{opt_code};
140
141     # Return the created object.
142     return $self;
143 }
144
145 ##############################################################################
146 # Core parsing
147 ##############################################################################
148
149 # This is the glue that connects the code below with Pod::Simple itself.  The
150 # goal is to convert the event stream coming from the POD parser into method
151 # calls to handlers once the complete content of a tag has been seen.  Each
152 # paragraph or POD command will have textual content associated with it, and
153 # as soon as all of a paragraph or POD command has been seen, that content
154 # will be passed in to the corresponding method for handling that type of
155 # object.  The exceptions are handlers for lists, which have opening tag
156 # handlers and closing tag handlers that will be called right away.
157 #
158 # The internal hash key PENDING is used to store the contents of a tag until
159 # all of it has been seen.  It holds a stack of open tags, each one
160 # represented by a tuple of the attributes hash for the tag and the contents
161 # of the tag.
162
163 # Add a block of text to the contents of the current node, formatting it
164 # according to the current formatting instructions as we do.
165 sub _handle_text {
166     my ($self, $text) = @_;
167     my $tag = $$self{PENDING}[-1];
168     $$tag[1] .= $text;
169 }
170
171 # Given an element name, get the corresponding method name.
172 sub method_for_element {
173     my ($self, $element) = @_;
174     $element =~ tr/-/_/;
175     $element =~ tr/A-Z/a-z/;
176     $element =~ tr/_a-z0-9//cd;
177     return $element;
178 }
179
180 # Handle the start of a new element.  If cmd_element is defined, assume that
181 # we need to collect the entire tree for this element before passing it to the
182 # element method, and create a new tree into which we'll collect blocks of
183 # text and nested elements.  Otherwise, if start_element is defined, call it.
184 sub _handle_element_start {
185     my ($self, $element, $attrs) = @_;
186     my $method = $self->method_for_element ($element);
187
188     # If we have a command handler, we need to accumulate the contents of the
189     # tag before calling it.
190     if ($self->can ("cmd_$method")) {
191         push (@{ $$self{PENDING} }, [ $attrs, '' ]);
192     } elsif ($self->can ("start_$method")) {
193         my $method = 'start_' . $method;
194         $self->$method ($attrs, '');
195     }
196 }
197
198 # Handle the end of an element.  If we had a cmd_ method for this element,
199 # this is where we pass along the text that we've accumulated.  Otherwise, if
200 # we have an end_ method for the element, call that.
201 sub _handle_element_end {
202     my ($self, $element) = @_;
203     my $method = $self->method_for_element ($element);
204
205     # If we have a command handler, pull off the pending text and pass it to
206     # the handler along with the saved attribute hash.
207     if ($self->can ("cmd_$method")) {
208         my $tag = pop @{ $$self{PENDING} };
209         my $method = 'cmd_' . $method;
210         my $text = $self->$method (@$tag);
211         if (defined $text) {
212             if (@{ $$self{PENDING} } > 1) {
213                 $$self{PENDING}[-1][1] .= $text;
214             } else {
215                 $self->output ($text);
216             }
217         }
218     } elsif ($self->can ("end_$method")) {
219         my $method = 'end_' . $method;
220         $self->$method ();
221     }
222 }
223
224 ##############################################################################
225 # Output formatting
226 ##############################################################################
227
228 # Wrap a line, indenting by the current left margin.  We can't use Text::Wrap
229 # because it plays games with tabs.  We can't use formline, even though we'd
230 # really like to, because it screws up non-printing characters.  So we have to
231 # do the wrapping ourselves.
232 sub wrap {
233     my $self = shift;
234     local $_ = shift;
235     my $output = '';
236     my $spaces = ' ' x $$self{MARGIN};
237     my $width = $$self{opt_width} - $$self{MARGIN};
238     while (length > $width) {
239         if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//) {
240             $output .= $spaces . $1 . "\n";
241         } else {
242             last;
243         }
244     }
245     $output .= $spaces . $_;
246     $output =~ s/\s+$/\n\n/;
247     return $output;
248 }
249
250 # Reformat a paragraph of text for the current margin.  Takes the text to
251 # reformat and returns the formatted text.
252 sub reformat {
253     my $self = shift;
254     local $_ = shift;
255
256     # If we're trying to preserve two spaces after sentences, do some munging
257     # to support that.  Otherwise, smash all repeated whitespace.
258     if ($$self{opt_sentence}) {
259         s/ +$//mg;
260         s/\.\n/. \n/g;
261         s/\n/ /g;
262         s/   +/  /g;
263     } else {
264         s/\s+/ /g;
265     }
266     return $self->wrap ($_);
267 }
268
269 # Output text to the output device.  Replace non-breaking spaces with spaces
270 # and soft hyphens with nothing, and then try to fix the output encoding if
271 # necessary to match the input encoding unless UTF-8 output is forced.  This
272 # preserves the traditional pass-through behavior of Pod::Text.
273 sub output {
274     my ($self, @text) = @_;
275     my $text = join ('', @text);
276     $text =~ tr/\240\255/ /d;
277     unless ($$self{opt_utf8}) {
278         my $encoding = $$self{encoding} || '';
279         if ($encoding && $encoding ne $$self{ENCODING}) {
280             $$self{ENCODING} = $encoding;
281             eval { binmode ($$self{output_fh}, ":encoding($encoding)") };
282         }
283     }
284     if ($$self{ENCODE}) {
285         print { $$self{output_fh} } encode ('UTF-8', $text);
286     } else {
287         print { $$self{output_fh} } $text;
288     }
289 }
290
291 # Output a block of code (something that isn't part of the POD text).  Called
292 # by preprocess_paragraph only if we were given the code option.  Exists here
293 # only so that it can be overridden by subclasses.
294 sub output_code { $_[0]->output ($_[1]) }
295
296 ##############################################################################
297 # Document initialization
298 ##############################################################################
299
300 # Set up various things that have to be initialized on a per-document basis.
301 sub start_document {
302     my ($self, $attrs) = @_;
303     if ($$attrs{contentless} && !$$self{ALWAYS_EMIT_SOMETHING}) {
304         $$self{CONTENTLESS} = 1;
305     } else {
306         delete $$self{CONTENTLESS};
307     }
308     my $margin = $$self{opt_indent} + $$self{opt_margin};
309
310     # Initialize a few per-document variables.
311     $$self{INDENTS} = [];       # Stack of indentations.
312     $$self{MARGIN}  = $margin;  # Default left margin.
313     $$self{PENDING} = [[]];     # Pending output.
314
315     # We have to redo encoding handling for each document.
316     $$self{ENCODING} = '';
317
318     # When UTF-8 output is set, check whether our output file handle already
319     # has a PerlIO encoding layer set.  If it does not, we'll need to encode
320     # our output before printing it (handled in the output() sub).  Wrap the
321     # check in an eval to handle versions of Perl without PerlIO.
322     $$self{ENCODE} = 0;
323     if ($$self{opt_utf8}) {
324         $$self{ENCODE} = 1;
325         eval {
326             my @options = (output => 1, details => 1);
327             my $flag = (PerlIO::get_layers ($$self{output_fh}, @options))[-1];
328             if ($flag & PerlIO::F_UTF8 ()) {
329                 $$self{ENCODE} = 0;
330                 $$self{ENCODING} = 'UTF-8';
331             }
332         };
333     }
334
335     return '';
336 }
337
338 # Handle the end of the document.  The only thing we do is handle dying on POD
339 # errors, since Pod::Parser currently doesn't.
340 sub end_document {
341     my ($self) = @_;
342     if ($$self{complain_die} && $self->errors_seen) {
343         croak ("POD document had syntax errors");
344     }
345 }
346
347 ##############################################################################
348 # Text blocks
349 ##############################################################################
350
351 # Intended for subclasses to override, this method returns text with any
352 # non-printing formatting codes stripped out so that length() correctly
353 # returns the length of the text.  For basic Pod::Text, it does nothing.
354 sub strip_format {
355     my ($self, $string) = @_;
356     return $string;
357 }
358
359 # This method is called whenever an =item command is complete (in other words,
360 # we've seen its associated paragraph or know for certain that it doesn't have
361 # one).  It gets the paragraph associated with the item as an argument.  If
362 # that argument is empty, just output the item tag; if it contains a newline,
363 # output the item tag followed by the newline.  Otherwise, see if there's
364 # enough room for us to output the item tag in the margin of the text or if we
365 # have to put it on a separate line.
366 sub item {
367     my ($self, $text) = @_;
368     my $tag = $$self{ITEM};
369     unless (defined $tag) {
370         carp "Item called without tag";
371         return;
372     }
373     undef $$self{ITEM};
374
375     # Calculate the indentation and margin.  $fits is set to true if the tag
376     # will fit into the margin of the paragraph given our indentation level.
377     my $indent = $$self{INDENTS}[-1];
378     $indent = $$self{opt_indent} unless defined $indent;
379     my $margin = ' ' x $$self{opt_margin};
380     my $tag_length = length ($self->strip_format ($tag));
381     my $fits = ($$self{MARGIN} - $indent >= $tag_length + 1);
382
383     # If the tag doesn't fit, or if we have no associated text, print out the
384     # tag separately.  Otherwise, put the tag in the margin of the paragraph.
385     if (!$text || $text =~ /^\s+$/ || !$fits) {
386         my $realindent = $$self{MARGIN};
387         $$self{MARGIN} = $indent;
388         my $output = $self->reformat ($tag);
389         $output =~ s/^$margin /$margin:/ if ($$self{opt_alt} && $indent > 0);
390         $output =~ s/\n*$/\n/;
391
392         # If the text is just whitespace, we have an empty item paragraph;
393         # this can result from =over/=item/=back without any intermixed
394         # paragraphs.  Insert some whitespace to keep the =item from merging
395         # into the next paragraph.
396         $output .= "\n" if $text && $text =~ /^\s*$/;
397
398         $self->output ($output);
399         $$self{MARGIN} = $realindent;
400         $self->output ($self->reformat ($text)) if ($text && $text =~ /\S/);
401     } else {
402         my $space = ' ' x $indent;
403         $space =~ s/^$margin /$margin:/ if $$self{opt_alt};
404         $text = $self->reformat ($text);
405         $text =~ s/^$margin /$margin:/ if ($$self{opt_alt} && $indent > 0);
406         my $tagspace = ' ' x $tag_length;
407         $text =~ s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item";
408         $self->output ($text);
409     }
410 }
411
412 # Handle a basic block of text.  The only tricky thing here is that if there
413 # is a pending item tag, we need to format this as an item paragraph.
414 sub cmd_para {
415     my ($self, $attrs, $text) = @_;
416     $text =~ s/\s+$/\n/;
417     if (defined $$self{ITEM}) {
418         $self->item ($text . "\n");
419     } else {
420         $self->output ($self->reformat ($text . "\n"));
421     }
422     return '';
423 }
424
425 # Handle a verbatim paragraph.  Just print it out, but indent it according to
426 # our margin.
427 sub cmd_verbatim {
428     my ($self, $attrs, $text) = @_;
429     $self->item if defined $$self{ITEM};
430     return if $text =~ /^\s*$/;
431     $text =~ s/^(\n*)([ \t]*\S+)/$1 . (' ' x $$self{MARGIN}) . $2/gme;
432     $text =~ s/\s*$/\n\n/;
433     $self->output ($text);
434     return '';
435 }
436
437 # Handle literal text (produced by =for and similar constructs).  Just output
438 # it with the minimum of changes.
439 sub cmd_data {
440     my ($self, $attrs, $text) = @_;
441     $text =~ s/^\n+//;
442     $text =~ s/\n{0,2}$/\n/;
443     $self->output ($text);
444     return '';
445 }
446
447 ##############################################################################
448 # Headings
449 ##############################################################################
450
451 # The common code for handling all headers.  Takes the header text, the
452 # indentation, and the surrounding marker for the alt formatting method.
453 sub heading {
454     my ($self, $text, $indent, $marker) = @_;
455     $self->item ("\n\n") if defined $$self{ITEM};
456     $text =~ s/\s+$//;
457     if ($$self{opt_alt}) {
458         my $closemark = reverse (split (//, $marker));
459         my $margin = ' ' x $$self{opt_margin};
460         $self->output ("\n" . "$margin$marker $text $closemark" . "\n\n");
461     } else {
462         $text .= "\n" if $$self{opt_loose};
463         my $margin = ' ' x ($$self{opt_margin} + $indent);
464         $self->output ($margin . $text . "\n");
465     }
466     return '';
467 }
468
469 # First level heading.
470 sub cmd_head1 {
471     my ($self, $attrs, $text) = @_;
472     $self->heading ($text, 0, '====');
473 }
474
475 # Second level heading.
476 sub cmd_head2 {
477     my ($self, $attrs, $text) = @_;
478     $self->heading ($text, $$self{opt_indent} / 2, '==  ');
479 }
480
481 # Third level heading.
482 sub cmd_head3 {
483     my ($self, $attrs, $text) = @_;
484     $self->heading ($text, $$self{opt_indent} * 2 / 3 + 0.5, '=   ');
485 }
486
487 # Fourth level heading.
488 sub cmd_head4 {
489     my ($self, $attrs, $text) = @_;
490     $self->heading ($text, $$self{opt_indent} * 3 / 4 + 0.5, '-   ');
491 }
492
493 ##############################################################################
494 # List handling
495 ##############################################################################
496
497 # Handle the beginning of an =over block.  Takes the type of the block as the
498 # first argument, and then the attr hash.  This is called by the handlers for
499 # the four different types of lists (bullet, number, text, and block).
500 sub over_common_start {
501     my ($self, $attrs) = @_;
502     $self->item ("\n\n") if defined $$self{ITEM};
503
504     # Find the indentation level.
505     my $indent = $$attrs{indent};
506     unless (defined ($indent) && $indent =~ /^\s*[-+]?\d{1,4}\s*$/) {
507         $indent = $$self{opt_indent};
508     }
509
510     # Add this to our stack of indents and increase our current margin.
511     push (@{ $$self{INDENTS} }, $$self{MARGIN});
512     $$self{MARGIN} += ($indent + 0);
513     return '';
514 }
515
516 # End an =over block.  Takes no options other than the class pointer.  Output
517 # any pending items and then pop one level of indentation.
518 sub over_common_end {
519     my ($self) = @_;
520     $self->item ("\n\n") if defined $$self{ITEM};
521     $$self{MARGIN} = pop @{ $$self{INDENTS} };
522     return '';
523 }
524
525 # Dispatch the start and end calls as appropriate.
526 sub start_over_bullet { $_[0]->over_common_start ($_[1]) }
527 sub start_over_number { $_[0]->over_common_start ($_[1]) }
528 sub start_over_text   { $_[0]->over_common_start ($_[1]) }
529 sub start_over_block  { $_[0]->over_common_start ($_[1]) }
530 sub end_over_bullet { $_[0]->over_common_end }
531 sub end_over_number { $_[0]->over_common_end }
532 sub end_over_text   { $_[0]->over_common_end }
533 sub end_over_block  { $_[0]->over_common_end }
534
535 # The common handler for all item commands.  Takes the type of the item, the
536 # attributes, and then the text of the item.
537 sub item_common {
538     my ($self, $type, $attrs, $text) = @_;
539     $self->item if defined $$self{ITEM};
540
541     # Clean up the text.  We want to end up with two variables, one ($text)
542     # which contains any body text after taking out the item portion, and
543     # another ($item) which contains the actual item text.  Note the use of
544     # the internal Pod::Simple attribute here; that's a potential land mine.
545     $text =~ s/\s+$//;
546     my ($item, $index);
547     if ($type eq 'bullet') {
548         $item = '*';
549     } elsif ($type eq 'number') {
550         $item = $$attrs{'~orig_content'};
551     } else {
552         $item = $text;
553         $item =~ s/\s*\n\s*/ /g;
554         $text = '';
555     }
556     $$self{ITEM} = $item;
557
558     # If body text for this item was included, go ahead and output that now.
559     if ($text) {
560         $text =~ s/\s*$/\n/;
561         $self->item ($text);
562     }
563     return '';
564 }
565
566 # Dispatch the item commands to the appropriate place.
567 sub cmd_item_bullet { my $self = shift; $self->item_common ('bullet', @_) }
568 sub cmd_item_number { my $self = shift; $self->item_common ('number', @_) }
569 sub cmd_item_text   { my $self = shift; $self->item_common ('text',   @_) }
570 sub cmd_item_block  { my $self = shift; $self->item_common ('block',  @_) }
571
572 ##############################################################################
573 # Formatting codes
574 ##############################################################################
575
576 # The simple ones.
577 sub cmd_b { return $_[0]{alt} ? "``$_[2]''" : $_[2] }
578 sub cmd_f { return $_[0]{alt} ? "\"$_[2]\"" : $_[2] }
579 sub cmd_i { return '*' . $_[2] . '*' }
580 sub cmd_x { return '' }
581
582 # Apply a whole bunch of messy heuristics to not quote things that don't
583 # benefit from being quoted.  These originally come from Barrie Slaymaker and
584 # largely duplicate code in Pod::Man.
585 sub cmd_c {
586     my ($self, $attrs, $text) = @_;
587
588     # A regex that matches the portion of a variable reference that's the
589     # array or hash index, separated out just because we want to use it in
590     # several places in the following regex.
591     my $index = '(?: \[.*\] | \{.*\} )?';
592
593     # Check for things that we don't want to quote, and if we find any of
594     # them, return the string with just a font change and no quoting.
595     $text =~ m{
596       ^\s*
597       (?:
598          ( [\'\`\"] ) .* \1                             # already quoted
599        | \` .* \'                                       # `quoted'
600        | \$+ [\#^]? \S $index                           # special ($^Foo, $")
601        | [\$\@%&*]+ \#? [:\'\w]+ $index                 # plain var or func
602        | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call
603        | [+-]? ( \d[\d.]* | \.\d+ ) (?: [eE][+-]?\d+ )? # a number
604        | 0x [a-fA-F\d]+                                 # a hex constant
605       )
606       \s*\z
607      }xo && return $text;
608
609     # If we didn't return, go ahead and quote the text.
610     return $$self{opt_alt}
611         ? "``$text''"
612         : "$$self{LQUOTE}$text$$self{RQUOTE}";
613 }
614
615 # Links reduce to the text that we're given, wrapped in angle brackets if it's
616 # a URL.
617 sub cmd_l {
618     my ($self, $attrs, $text) = @_;
619     if ($$attrs{type} eq 'url') {
620         if (not defined($$attrs{to}) or $$attrs{to} eq $text) {
621             return "<$text>";
622         } elsif ($$self{opt_nourls}) {
623             return $text;
624         } else {
625             return "$text <$$attrs{to}>";
626         }
627     } else {
628         return $text;
629     }
630 }
631
632 ##############################################################################
633 # Backwards compatibility
634 ##############################################################################
635
636 # The old Pod::Text module did everything in a pod2text() function.  This
637 # tries to provide the same interface for legacy applications.
638 sub pod2text {
639     my @args;
640
641     # This is really ugly; I hate doing option parsing in the middle of a
642     # module.  But the old Pod::Text module supported passing flags to its
643     # entry function, so handle -a and -<number>.
644     while ($_[0] =~ /^-/) {
645         my $flag = shift;
646         if    ($flag eq '-a')       { push (@args, alt => 1)    }
647         elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }
648         else {
649             unshift (@_, $flag);
650             last;
651         }
652     }
653
654     # Now that we know what arguments we're using, create the parser.
655     my $parser = Pod::Text->new (@args);
656
657     # If two arguments were given, the second argument is going to be a file
658     # handle.  That means we want to call parse_from_filehandle(), which means
659     # we need to turn the first argument into a file handle.  Magic open will
660     # handle the <&STDIN case automagically.
661     if (defined $_[1]) {
662         my @fhs = @_;
663         local *IN;
664         unless (open (IN, $fhs[0])) {
665             croak ("Can't open $fhs[0] for reading: $!\n");
666             return;
667         }
668         $fhs[0] = \*IN;
669         $parser->output_fh ($fhs[1]);
670         my $retval = $parser->parse_file ($fhs[0]);
671         my $fh = $parser->output_fh ();
672         close $fh;
673         return $retval;
674     } else {
675         $parser->output_fh (\*STDOUT);
676         return $parser->parse_file (@_);
677     }
678 }
679
680 # Reset the underlying Pod::Simple object between calls to parse_from_file so
681 # that the same object can be reused to convert multiple pages.
682 sub parse_from_file {
683     my $self = shift;
684     $self->reinit;
685
686     # Fake the old cutting option to Pod::Parser.  This fiddings with internal
687     # Pod::Simple state and is quite ugly; we need a better approach.
688     if (ref ($_[0]) eq 'HASH') {
689         my $opts = shift @_;
690         if (defined ($$opts{-cutting}) && !$$opts{-cutting}) {
691             $$self{in_pod} = 1;
692             $$self{last_was_blank} = 1;
693         }
694     }
695
696     # Do the work.
697     my $retval = $self->Pod::Simple::parse_from_file (@_);
698
699     # Flush output, since Pod::Simple doesn't do this.  Ideally we should also
700     # close the file descriptor if we had to open one, but we can't easily
701     # figure this out.
702     my $fh = $self->output_fh ();
703     my $oldfh = select $fh;
704     my $oldflush = $|;
705     $| = 1;
706     print $fh '';
707     $| = $oldflush;
708     select $oldfh;
709     return $retval;
710 }
711
712 # Pod::Simple failed to provide this backward compatibility function, so
713 # implement it ourselves.  File handles are one of the inputs that
714 # parse_from_file supports.
715 sub parse_from_filehandle {
716     my $self = shift;
717     $self->parse_from_file (@_);
718 }
719
720 # Pod::Simple's parse_file doesn't set output_fh.  Wrap the call and do so
721 # ourself unless it was already set by the caller, since our documentation has
722 # always said that this should work.
723 sub parse_file {
724     my ($self, $in) = @_;
725     unless (defined $$self{output_fh}) {
726         $self->output_fh (\*STDOUT);
727     }
728     return $self->SUPER::parse_file ($in);
729 }
730
731 # Do the same for parse_lines, just to be polite.  Pod::Simple's man page
732 # implies that the caller is responsible for setting this, but I don't see any
733 # reason not to set a default.
734 sub parse_lines {
735     my ($self, @lines) = @_;
736     unless (defined $$self{output_fh}) {
737         $self->output_fh (\*STDOUT);
738     }
739     return $self->SUPER::parse_lines (@lines);
740 }
741
742 # Likewise for parse_string_document.
743 sub parse_string_document {
744     my ($self, $doc) = @_;
745     unless (defined $$self{output_fh}) {
746         $self->output_fh (\*STDOUT);
747     }
748     return $self->SUPER::parse_string_document ($doc);
749 }
750
751 ##############################################################################
752 # Module return value and documentation
753 ##############################################################################
754
755 1;
756 __END__
757
758 =for stopwords
759 alt stderr Allbery Sean Burke's Christiansen UTF-8 pre-Unicode utf8 nourls
760 parsers
761
762 =head1 NAME
763
764 Pod::Text - Convert POD data to formatted text
765
766 =head1 SYNOPSIS
767
768     use Pod::Text;
769     my $parser = Pod::Text->new (sentence => 0, width => 78);
770
771     # Read POD from STDIN and write to STDOUT.
772     $parser->parse_from_filehandle;
773
774     # Read POD from file.pod and write to file.txt.
775     $parser->parse_from_file ('file.pod', 'file.txt');
776
777 =head1 DESCRIPTION
778
779 Pod::Text is a module that can convert documentation in the POD format
780 (the preferred language for documenting Perl) into formatted text.  It
781 uses no special formatting controls or codes whatsoever, and its output is
782 therefore suitable for nearly any device.
783
784 As a derived class from Pod::Simple, Pod::Text supports the same methods and
785 interfaces.  See L<Pod::Simple> for all the details; briefly, one creates a
786 new parser with C<< Pod::Text->new() >> and then normally calls parse_file().
787
788 new() can take options, in the form of key/value pairs, that control the
789 behavior of the parser.  The currently recognized options are:
790
791 =over 4
792
793 =item alt
794
795 If set to a true value, selects an alternate output format that, among other
796 things, uses a different heading style and marks C<=item> entries with a
797 colon in the left margin.  Defaults to false.
798
799 =item code
800
801 If set to a true value, the non-POD parts of the input file will be included
802 in the output.  Useful for viewing code documented with POD blocks with the
803 POD rendered and the code left intact.
804
805 =item errors
806
807 How to report errors.  C<die> says to throw an exception on any POD
808 formatting error.  C<stderr> says to report errors on standard error, but
809 not to throw an exception.  C<pod> says to include a POD ERRORS section
810 in the resulting documentation summarizing the errors.  C<none> ignores
811 POD errors entirely, as much as possible.
812
813 The default is C<pod>.
814
815 =item indent
816
817 The number of spaces to indent regular text, and the default indentation for
818 C<=over> blocks.  Defaults to 4.
819
820 =item loose
821
822 If set to a true value, a blank line is printed after a C<=head1> heading.
823 If set to false (the default), no blank line is printed after C<=head1>,
824 although one is still printed after C<=head2>.  This is the default because
825 it's the expected formatting for manual pages; if you're formatting
826 arbitrary text documents, setting this to true may result in more pleasing
827 output.
828
829 =item margin
830
831 The width of the left margin in spaces.  Defaults to 0.  This is the margin
832 for all text, including headings, not the amount by which regular text is
833 indented; for the latter, see the I<indent> option.  To set the right
834 margin, see the I<width> option.
835
836 =item nourls
837
838 Normally, LZ<><> formatting codes with a URL but anchor text are formatted
839 to show both the anchor text and the URL.  In other words:
840
841     L<foo|http://example.com/>
842
843 is formatted as:
844
845     foo <http://example.com/>
846
847 This option, if set to a true value, suppresses the URL when anchor text
848 is given, so this example would be formatted as just C<foo>.  This can
849 produce less cluttered output in cases where the URLs are not particularly
850 important.
851
852 =item quotes
853
854 Sets the quote marks used to surround CE<lt>> text.  If the value is a
855 single character, it is used as both the left and right quote.  Otherwise,
856 it is split in half, and the first half of the string is used as the left
857 quote and the second is used as the right quote.
858
859 This may also be set to the special value C<none>, in which case no quote
860 marks are added around CE<lt>> text.
861
862 =item sentence
863
864 If set to a true value, Pod::Text will assume that each sentence ends in two
865 spaces, and will try to preserve that spacing.  If set to false, all
866 consecutive whitespace in non-verbatim paragraphs is compressed into a
867 single space.  Defaults to true.
868
869 =item stderr
870
871 Send error messages about invalid POD to standard error instead of
872 appending a POD ERRORS section to the generated output.  This is
873 equivalent to setting C<errors> to C<stderr> if C<errors> is not already
874 set.  It is supported for backward compatibility.
875
876 =item utf8
877
878 By default, Pod::Text uses the same output encoding as the input encoding
879 of the POD source (provided that Perl was built with PerlIO; otherwise, it
880 doesn't encode its output).  If this option is given, the output encoding
881 is forced to UTF-8.
882
883 Be aware that, when using this option, the input encoding of your POD
884 source should be properly declared unless it's US-ASCII.  Pod::Simple will
885 attempt to guess the encoding and may be successful if it's Latin-1 or
886 UTF-8, but it will produce warnings.  Use the C<=encoding> command to
887 declare the encoding.  See L<perlpod(1)> for more information.
888
889 =item width
890
891 The column at which to wrap text on the right-hand side.  Defaults to 76.
892
893 =back
894
895 The standard Pod::Simple method parse_file() takes one argument naming the
896 POD file to read from.  By default, the output is sent to C<STDOUT>, but
897 this can be changed with the output_fh() method.
898
899 The standard Pod::Simple method parse_from_file() takes up to two
900 arguments, the first being the input file to read POD from and the second
901 being the file to write the formatted output to.
902
903 You can also call parse_lines() to parse an array of lines or
904 parse_string_document() to parse a document already in memory.  As with
905 parse_file(), parse_lines() and parse_string_document() default to sending
906 their output to C<STDOUT> unless changed with the output_fh() method.
907
908 To put the output from any parse method into a string instead of a file
909 handle, call the output_string() method instead of output_fh().
910
911 See L<Pod::Simple> for more specific details on the methods available to
912 all derived parsers.
913
914 =head1 DIAGNOSTICS
915
916 =over 4
917
918 =item Bizarre space in item
919
920 =item Item called without tag
921
922 (W) Something has gone wrong in internal C<=item> processing.  These
923 messages indicate a bug in Pod::Text; you should never see them.
924
925 =item Can't open %s for reading: %s
926
927 (F) Pod::Text was invoked via the compatibility mode pod2text() interface
928 and the input file it was given could not be opened.
929
930 =item Invalid errors setting "%s"
931
932 (F) The C<errors> parameter to the constructor was set to an unknown value.
933
934 =item Invalid quote specification "%s"
935
936 (F) The quote specification given (the C<quotes> option to the
937 constructor) was invalid.  A quote specification must be either one
938 character long or an even number (greater than one) characters long.
939
940 =item POD document had syntax errors
941
942 (F) The POD document being formatted had syntax errors and the C<errors>
943 option was set to C<die>.
944
945 =back
946
947 =head1 BUGS
948
949 Encoding handling assumes that PerlIO is available and does not work
950 properly if it isn't.  The C<utf8> option is therefore not supported
951 unless Perl is built with PerlIO support.
952
953 =head1 CAVEATS
954
955 If Pod::Text is given the C<utf8> option, the encoding of its output file
956 handle will be forced to UTF-8 if possible, overriding any existing
957 encoding.  This will be done even if the file handle is not created by
958 Pod::Text and was passed in from outside.  This maintains consistency
959 regardless of PERL_UNICODE and other settings.
960
961 If the C<utf8> option is not given, the encoding of its output file handle
962 will be forced to the detected encoding of the input POD, which preserves
963 whatever the input text is.  This ensures backward compatibility with
964 earlier, pre-Unicode versions of this module, without large numbers of
965 Perl warnings.
966
967 This is not ideal, but it seems to be the best compromise.  If it doesn't
968 work for you, please let me know the details of how it broke.
969
970 =head1 NOTES
971
972 This is a replacement for an earlier Pod::Text module written by Tom
973 Christiansen.  It has a revamped interface, since it now uses Pod::Simple,
974 but an interface roughly compatible with the old Pod::Text::pod2text()
975 function is still available.  Please change to the new calling convention,
976 though.
977
978 The original Pod::Text contained code to do formatting via termcap
979 sequences, although it wasn't turned on by default and it was problematic to
980 get it to work at all.  This rewrite doesn't even try to do that, but a
981 subclass of it does.  Look for L<Pod::Text::Termcap>.
982
983 =head1 SEE ALSO
984
985 L<Pod::Simple>, L<Pod::Text::Termcap>, L<perlpod(1)>, L<pod2text(1)>
986
987 The current version of this module is always available from its web site at
988 L<http://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
989 Perl core distribution as of 5.6.0.
990
991 =head1 AUTHOR
992
993 Russ Allbery <rra@cpan.org>, based I<very> heavily on the original
994 Pod::Text by Tom Christiansen <tchrist@mox.perl.com> and its conversion to
995 Pod::Parser by Brad Appleton <bradapp@enteract.com>.  Sean Burke's initial
996 conversion of Pod::Man to use Pod::Simple provided much-needed guidance on
997 how to use Pod::Simple.
998
999 =head1 COPYRIGHT AND LICENSE
1000
1001 Copyright 1999, 2000, 2001, 2002, 2004, 2006, 2008, 2009, 2012, 2013, 2014,
1002 2015 Russ Allbery <rra@cpan.org>
1003
1004 This program is free software; you may redistribute it and/or modify it
1005 under the same terms as Perl itself.
1006
1007 =cut