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 . 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