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