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