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