← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:11 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/Pod/PlainText.pm
StatementsExecuted 15 statements in 2.42ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11111µs23µsPod::PlainText::::BEGIN@19Pod::PlainText::BEGIN@19
1119µs34µsPod::PlainText::::BEGIN@23Pod::PlainText::BEGIN@23
1116µs48µsPod::PlainText::::BEGIN@26Pod::PlainText::BEGIN@26
1114µs4µsPod::PlainText::::BEGIN@34Pod::PlainText::BEGIN@34
1113µs3µsPod::PlainText::::BEGIN@24Pod::PlainText::BEGIN@24
0000s0sPod::PlainText::::cmd_backPod::PlainText::cmd_back
0000s0sPod::PlainText::::cmd_beginPod::PlainText::cmd_begin
0000s0sPod::PlainText::::cmd_encodingPod::PlainText::cmd_encoding
0000s0sPod::PlainText::::cmd_endPod::PlainText::cmd_end
0000s0sPod::PlainText::::cmd_forPod::PlainText::cmd_for
0000s0sPod::PlainText::::cmd_head1Pod::PlainText::cmd_head1
0000s0sPod::PlainText::::cmd_head2Pod::PlainText::cmd_head2
0000s0sPod::PlainText::::cmd_head3Pod::PlainText::cmd_head3
0000s0sPod::PlainText::::cmd_itemPod::PlainText::cmd_item
0000s0sPod::PlainText::::cmd_overPod::PlainText::cmd_over
0000s0sPod::PlainText::::commandPod::PlainText::command
0000s0sPod::PlainText::::initializePod::PlainText::initialize
0000s0sPod::PlainText::::interior_sequencePod::PlainText::interior_sequence
0000s0sPod::PlainText::::itemPod::PlainText::item
0000s0sPod::PlainText::::outputPod::PlainText::output
0000s0sPod::PlainText::::pod2textPod::PlainText::pod2text
0000s0sPod::PlainText::::preprocess_paragraphPod::PlainText::preprocess_paragraph
0000s0sPod::PlainText::::reformatPod::PlainText::reformat
0000s0sPod::PlainText::::seq_bPod::PlainText::seq_b
0000s0sPod::PlainText::::seq_cPod::PlainText::seq_c
0000s0sPod::PlainText::::seq_fPod::PlainText::seq_f
0000s0sPod::PlainText::::seq_iPod::PlainText::seq_i
0000s0sPod::PlainText::::seq_lPod::PlainText::seq_l
0000s0sPod::PlainText::::textblockPod::PlainText::textblock
0000s0sPod::PlainText::::verbatimPod::PlainText::verbatim
0000s0sPod::PlainText::::wrapPod::PlainText::wrap
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# Pod::PlainText -- Convert POD data to formatted ASCII text.
2# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $
3#
4# Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>
5#
6# This program is free software; you can redistribute it and/or modify it
7# under the same terms as Perl itself.
8#
9# This module is intended to be a replacement for Pod::Text, and attempts to
10# match its output except for some specific circumstances where other
11# decisions seemed to produce better output. It uses Pod::Parser and is
12# designed to be very easy to subclass.
13
14############################################################################
15# Modules and declarations
16############################################################################
17
18package Pod::PlainText;
19226µs235µs
# spent 23µs (11+12) within Pod::PlainText::BEGIN@19 which was called: # once (11µs+12µs) by Perl::Critic::Violation::BEGIN@19 at line 19
use strict;
# spent 23µs making 1 call to Pod::PlainText::BEGIN@19 # spent 12µs making 1 call to strict::import
20
2118µsrequire 5.005;
22
23221µs260µs
# spent 34µs (9+26) within Pod::PlainText::BEGIN@23 which was called: # once (9µs+26µs) by Perl::Critic::Violation::BEGIN@19 at line 23
use Carp qw(carp croak);
# spent 34µs making 1 call to Pod::PlainText::BEGIN@23 # spent 26µs making 1 call to Exporter::import
24218µs13µs
# spent 3µs within Pod::PlainText::BEGIN@24 which was called: # once (3µs+0s) by Perl::Critic::Violation::BEGIN@19 at line 24
use Pod::Select ();
# spent 3µs making 1 call to Pod::PlainText::BEGIN@24
25
26249µs289µs
# spent 48µs (6+41) within Pod::PlainText::BEGIN@26 which was called: # once (6µs+41µs) by Perl::Critic::Violation::BEGIN@19 at line 26
use vars qw(@ISA %ESCAPES $VERSION);
# spent 48µs making 1 call to Pod::PlainText::BEGIN@26 # spent 41µs making 1 call to vars::import
27
28# We inherit from Pod::Select instead of Pod::Parser so that we can be used
29# by Pod::Usage.
3017µs@ISA = qw(Pod::Select);
31
321300ns$VERSION = '2.06';
33
34
# spent 4µs within Pod::PlainText::BEGIN@34 which was called: # once (4µs+0s) by Perl::Critic::Violation::BEGIN@19 at line 39
BEGIN {
3515µs if ($] < 5.006) {
36 require Symbol;
37 import Symbol;
38 }
3912.24ms14µs}
# spent 4µs making 1 call to Pod::PlainText::BEGIN@34
40
41############################################################################
42# Table of supported E<> escapes
43############################################################################
44
45# This table is taken near verbatim from Pod::PlainText in Pod::Parser,
46# which got it near verbatim from the original Pod::Text. It is therefore
47# credited to Tom Christiansen, and I'm glad I didn't have to write it. :)
48126µs%ESCAPES = (
49 'amp' => '&', # ampersand
50 'lt' => '<', # left chevron, less-than
51 'gt' => '>', # right chevron, greater-than
52 'quot' => '"', # double quote
53
54 "Aacute" => "\xC1", # capital A, acute accent
55 "aacute" => "\xE1", # small a, acute accent
56 "Acirc" => "\xC2", # capital A, circumflex accent
57 "acirc" => "\xE2", # small a, circumflex accent
58 "AElig" => "\xC6", # capital AE diphthong (ligature)
59 "aelig" => "\xE6", # small ae diphthong (ligature)
60 "Agrave" => "\xC0", # capital A, grave accent
61 "agrave" => "\xE0", # small a, grave accent
62 "Aring" => "\xC5", # capital A, ring
63 "aring" => "\xE5", # small a, ring
64 "Atilde" => "\xC3", # capital A, tilde
65 "atilde" => "\xE3", # small a, tilde
66 "Auml" => "\xC4", # capital A, dieresis or umlaut mark
67 "auml" => "\xE4", # small a, dieresis or umlaut mark
68 "Ccedil" => "\xC7", # capital C, cedilla
69 "ccedil" => "\xE7", # small c, cedilla
70 "Eacute" => "\xC9", # capital E, acute accent
71 "eacute" => "\xE9", # small e, acute accent
72 "Ecirc" => "\xCA", # capital E, circumflex accent
73 "ecirc" => "\xEA", # small e, circumflex accent
74 "Egrave" => "\xC8", # capital E, grave accent
75 "egrave" => "\xE8", # small e, grave accent
76 "ETH" => "\xD0", # capital Eth, Icelandic
77 "eth" => "\xF0", # small eth, Icelandic
78 "Euml" => "\xCB", # capital E, dieresis or umlaut mark
79 "euml" => "\xEB", # small e, dieresis or umlaut mark
80 "Iacute" => "\xCD", # capital I, acute accent
81 "iacute" => "\xED", # small i, acute accent
82 "Icirc" => "\xCE", # capital I, circumflex accent
83 "icirc" => "\xEE", # small i, circumflex accent
84 "Igrave" => "\xCD", # capital I, grave accent
85 "igrave" => "\xED", # small i, grave accent
86 "Iuml" => "\xCF", # capital I, dieresis or umlaut mark
87 "iuml" => "\xEF", # small i, dieresis or umlaut mark
88 "Ntilde" => "\xD1", # capital N, tilde
89 "ntilde" => "\xF1", # small n, tilde
90 "Oacute" => "\xD3", # capital O, acute accent
91 "oacute" => "\xF3", # small o, acute accent
92 "Ocirc" => "\xD4", # capital O, circumflex accent
93 "ocirc" => "\xF4", # small o, circumflex accent
94 "Ograve" => "\xD2", # capital O, grave accent
95 "ograve" => "\xF2", # small o, grave accent
96 "Oslash" => "\xD8", # capital O, slash
97 "oslash" => "\xF8", # small o, slash
98 "Otilde" => "\xD5", # capital O, tilde
99 "otilde" => "\xF5", # small o, tilde
100 "Ouml" => "\xD6", # capital O, dieresis or umlaut mark
101 "ouml" => "\xF6", # small o, dieresis or umlaut mark
102 "szlig" => "\xDF", # small sharp s, German (sz ligature)
103 "THORN" => "\xDE", # capital THORN, Icelandic
104 "thorn" => "\xFE", # small thorn, Icelandic
105 "Uacute" => "\xDA", # capital U, acute accent
106 "uacute" => "\xFA", # small u, acute accent
107 "Ucirc" => "\xDB", # capital U, circumflex accent
108 "ucirc" => "\xFB", # small u, circumflex accent
109 "Ugrave" => "\xD9", # capital U, grave accent
110 "ugrave" => "\xF9", # small u, grave accent
111 "Uuml" => "\xDC", # capital U, dieresis or umlaut mark
112 "uuml" => "\xFC", # small u, dieresis or umlaut mark
113 "Yacute" => "\xDD", # capital Y, acute accent
114 "yacute" => "\xFD", # small y, acute accent
115 "yuml" => "\xFF", # small y, dieresis or umlaut mark
116
117 "lchevron" => "\xAB", # left chevron (double less than)
118 "rchevron" => "\xBB", # right chevron (double greater than)
119);
120
121
122############################################################################
123# Initialization
124############################################################################
125
126# Initialize the object. Must be sure to call our parent initializer.
127sub initialize {
128 my $self = shift;
129
130 $$self{alt} = 0 unless defined $$self{alt};
131 $$self{indent} = 4 unless defined $$self{indent};
132 $$self{loose} = 0 unless defined $$self{loose};
133 $$self{sentence} = 0 unless defined $$self{sentence};
134 $$self{width} = 76 unless defined $$self{width};
135
136 $$self{INDENTS} = []; # Stack of indentations.
137 $$self{MARGIN} = $$self{indent}; # Current left margin in spaces.
138
139 return $self->SUPER::initialize;
140}
141
142
143############################################################################
144# Core overrides
145############################################################################
146
147# Called for each command paragraph. Gets the command, the associated
148# paragraph, the line number, and a Pod::Paragraph object. Just dispatches
149# the command to a method named the same as the command. =cut is handled
150# internally by Pod::Parser.
151sub command {
152 my $self = shift;
153 my $command = shift;
154 return if $command eq 'pod';
155 return if ($$self{EXCLUDE} && $command ne 'end');
156 if (defined $$self{ITEM}) {
157 $self->item ("\n");
158 local $_ = "\n";
159 $self->output($_) if($command eq 'back');
160 }
161 $command = 'cmd_' . $command;
162 return $self->$command (@_);
163}
164
165# Called for a verbatim paragraph. Gets the paragraph, the line number, and
166# a Pod::Paragraph object. Just output it verbatim, but with tabs converted
167# to spaces.
168sub verbatim {
169 my $self = shift;
170 return if $$self{EXCLUDE};
171 $self->item if defined $$self{ITEM};
172 local $_ = shift;
173 return if /^\s*$/;
174 s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
175 return $self->output($_);
176}
177
178# Called for a regular text block. Gets the paragraph, the line number, and
179# a Pod::Paragraph object. Perform interpolation and output the results.
180sub textblock {
181 my $self = shift;
182 return if $$self{EXCLUDE};
183 if($$self{VERBATIM}) {
184 $self->output($_[0]);
185 return;
186 }
187 local $_ = shift;
188 my $line = shift;
189
190 # Perform a little magic to collapse multiple L<> references. This is
191 # here mostly for backwards-compatibility. We'll just rewrite the whole
192 # thing into actual text at this part, bypassing the whole internal
193 # sequence parsing thing.
194 s{
195 (
196 L< # A link of the form L</something>.
197 /
198 (
199 [:\w]+ # The item has to be a simple word...
200 (\(\))? # ...or simple function.
201 )
202 >
203 (
204 ,?\s+(and\s+)? # Allow lots of them, conjuncted.
205 L<
206 /
207 (
208 [:\w]+
209 (\(\))?
210 )
211 >
212 )+
213 )
214 } {
215 local $_ = $1;
216 s%L</([^>]+)>%$1%g;
217 my @items = split /(?:,?\s+(?:and\s+)?)/;
218 my $string = "the ";
219 my $i;
220 for ($i = 0; $i < @items; $i++) {
221 $string .= $items[$i];
222 $string .= ", " if @items > 2 && $i != $#items;
223 $string .= " and " if ($i == $#items - 1);
224 }
225 $string .= " entries elsewhere in this document";
226 $string;
227 }gex;
228
229 # Now actually interpolate and output the paragraph.
230 $_ = $self->interpolate ($_, $line);
231 s/\s*$/\n/s;
232 if (defined $$self{ITEM}) {
233 $self->item ($_ . "\n");
234 } else {
235 $self->output ($self->reformat ($_ . "\n"));
236 }
237}
238
239# Called for an interior sequence. Gets the command, argument, and a
240# Pod::InteriorSequence object and is expected to return the resulting text.
241# Calls code, bold, italic, file, and link to handle those types of
242# sequences, and handles S<>, E<>, X<>, and Z<> directly.
243sub interior_sequence {
244 my $self = shift;
245 my $command = shift;
246 local $_ = shift;
247 return '' if ($command eq 'X' || $command eq 'Z');
248
249 # Expand escapes into the actual character now, carping if invalid.
250 if ($command eq 'E') {
251 return $ESCAPES{$_} if defined $ESCAPES{$_};
252 carp "Unknown escape: E<$_>";
253 return "E<$_>";
254 }
255
256 # For all the other sequences, empty content produces no output.
257 return if $_ eq '';
258
259 # For S<>, compress all internal whitespace and then map spaces to \01.
260 # When we output the text, we'll map this back.
261 if ($command eq 'S') {
262 s/\s{2,}/ /g;
263 tr/ /\01/;
264 return $_;
265 }
266
267 # Anything else needs to get dispatched to another method.
268 if ($command eq 'B') { return $self->seq_b ($_) }
269 elsif ($command eq 'C') { return $self->seq_c ($_) }
270 elsif ($command eq 'F') { return $self->seq_f ($_) }
271 elsif ($command eq 'I') { return $self->seq_i ($_) }
272 elsif ($command eq 'L') { return $self->seq_l ($_) }
273 else { carp "Unknown sequence $command<$_>" }
274}
275
276# Called for each paragraph that's actually part of the POD. We take
277# advantage of this opportunity to untabify the input.
278sub preprocess_paragraph {
279 my $self = shift;
280 local $_ = shift;
281 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
282 return $_;
283}
284
285
286############################################################################
287# Command paragraphs
288############################################################################
289
290# All command paragraphs take the paragraph and the line number.
291
292# First level heading.
293sub cmd_head1 {
294 my $self = shift;
295 local $_ = shift;
296 s/\s+$//s;
297 $_ = $self->interpolate ($_, shift);
298 if ($$self{alt}) {
299 $self->output ("\n==== $_ ====\n\n");
300 } else {
301 $_ .= "\n" if $$self{loose};
302 $self->output ($_ . "\n");
303 }
304}
305
306# Second level heading.
307sub cmd_head2 {
308 my $self = shift;
309 local $_ = shift;
310 s/\s+$//s;
311 $_ = $self->interpolate ($_, shift);
312 if ($$self{alt}) {
313 $self->output ("\n== $_ ==\n\n");
314 } else {
315 $_ .= "\n" if $$self{loose};
316 $self->output (' ' x ($$self{indent} / 2) . $_ . "\n");
317 }
318}
319
320# third level heading - not strictly perlpodspec compliant
321sub cmd_head3 {
322 my $self = shift;
323 local $_ = shift;
324 s/\s+$//s;
325 $_ = $self->interpolate ($_, shift);
326 if ($$self{alt}) {
327 $self->output ("\n= $_ =\n");
328 } else {
329 $_ .= "\n" if $$self{loose};
330 $self->output (' ' x ($$self{indent}) . $_ . "\n");
331 }
332}
333
334# fourth level heading - not strictly perlpodspec compliant
335# just like head3
3361900ns*cmd_head4 = \&cmd_head3;
337
338# Start a list.
339sub cmd_over {
340 my $self = shift;
341 local $_ = shift;
342 unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
343 push (@{ $$self{INDENTS} }, $$self{MARGIN});
344 $$self{MARGIN} += ($_ + 0);
345}
346
347# End a list.
348sub cmd_back {
349 my $self = shift;
350 $$self{MARGIN} = pop @{ $$self{INDENTS} };
351 unless (defined $$self{MARGIN}) {
352 carp 'Unmatched =back';
353 $$self{MARGIN} = $$self{indent};
354 }
355}
356
357# An individual list item.
358sub cmd_item {
359 my $self = shift;
360 if (defined $$self{ITEM}) { $self->item }
361 local $_ = shift;
362 s/\s+$//s;
363 $$self{ITEM} = $self->interpolate ($_);
364}
365
366# Begin a block for a particular translator. Setting VERBATIM triggers
367# special handling in textblock().
368sub cmd_begin {
369 my $self = shift;
370 local $_ = shift;
371 my ($kind) = /^(\S+)/ or return;
372 if ($kind eq 'text') {
373 $$self{VERBATIM} = 1;
374 } else {
375 $$self{EXCLUDE} = 1;
376 }
377}
378
379# End a block for a particular translator. We assume that all =begin/=end
380# pairs are properly closed.
381sub cmd_end {
382 my $self = shift;
383 $$self{EXCLUDE} = 0;
384 $$self{VERBATIM} = 0;
385}
386
387# One paragraph for a particular translator. Ignore it unless it's intended
388# for text, in which case we treat it as a verbatim text block.
389sub cmd_for {
390 my $self = shift;
391 local $_ = shift;
392 my $line = shift;
393 return unless s/^text\b[ \t]*\r?\n?//;
394 $self->verbatim ($_, $line);
395}
396
397# just a dummy method for the time being
398sub cmd_encoding {
399 return;
400}
401
402############################################################################
403# Interior sequences
404############################################################################
405
406# The simple formatting ones. These are here mostly so that subclasses can
407# override them and do more complicated things.
408sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }
409sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" }
410sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
411sub seq_i { return '*' . $_[1] . '*' }
412
413# The complicated one. Handle links. Since this is plain text, we can't
414# actually make any real links, so this is all to figure out what text we
415# print out.
416sub seq_l {
417 my $self = shift;
418 local $_ = shift;
419
420 # Smash whitespace in case we were split across multiple lines.
421 s/\s+/ /g;
422
423 # If we were given any explicit text, just output it.
424 if (/^([^|]+)\|/) { return $1 }
425
426 # Okay, leading and trailing whitespace isn't important; get rid of it.
427 s/^\s+//;
428 s/\s+$//;
429
430 # Default to using the whole content of the link entry as a section
431 # name. Note that L<manpage/> forces a manpage interpretation, as does
432 # something looking like L<manpage(section)>. The latter is an
433 # enhancement over the original Pod::Text.
434 my ($manpage, $section) = ('', $_);
435 if (/^(?:https?|ftp|news):/) {
436 # a URL
437 return $_;
438 } elsif (/^"\s*(.*?)\s*"$/) {
439 $section = '"' . $1 . '"';
440 } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
441 ($manpage, $section) = ($_, '');
442 } elsif (m{/}) {
443 ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
444 }
445
446 my $text = '';
447 # Now build the actual output text.
448 if (!length $section) {
449 $text = "the $manpage manpage" if length $manpage;
450 } elsif ($section =~ /^[:\w]+(?:\(\))?/) {
451 $text .= 'the ' . $section . ' entry';
452 $text .= (length $manpage) ? " in the $manpage manpage"
453 : ' elsewhere in this document';
454 } else {
455 $section =~ s/^\"\s*//;
456 $section =~ s/\s*\"$//;
457 $text .= 'the section on "' . $section . '"';
458 $text .= " in the $manpage manpage" if length $manpage;
459 }
460 return $text;
461}
462
463
464############################################################################
465# List handling
466############################################################################
467
468# This method is called whenever an =item command is complete (in other
469# words, we've seen its associated paragraph or know for certain that it
470# doesn't have one). It gets the paragraph associated with the item as an
471# argument. If that argument is empty, just output the item tag; if it
472# contains a newline, output the item tag followed by the newline.
473# Otherwise, see if there's enough room for us to output the item tag in the
474# margin of the text or if we have to put it on a separate line.
475sub item {
476 my $self = shift;
477 local $_ = shift;
478 my $tag = $$self{ITEM};
479 unless (defined $tag) {
480 carp 'item called without tag';
481 return;
482 }
483 undef $$self{ITEM};
484 my $indent = $$self{INDENTS}[-1];
485 unless (defined $indent) { $indent = $$self{indent} }
486 my $space = ' ' x $indent;
487 $space =~ s/^ /:/ if $$self{alt};
488 if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
489 my $margin = $$self{MARGIN};
490 $$self{MARGIN} = $indent;
491 my $output = $self->reformat ($tag);
492 $output =~ s/[\r\n]*$/\n/;
493 $self->output ($output);
494 $$self{MARGIN} = $margin;
495 $self->output ($self->reformat ($_)) if /\S/;
496 } else {
497 $_ = $self->reformat ($_);
498 s/^ /:/ if ($$self{alt} && $indent > 0);
499 my $tagspace = ' ' x length $tag;
500 s/^($space)$tagspace/$1$tag/ or carp 'Bizarre space in item';
501 $self->output ($_);
502 }
503}
504
505
506############################################################################
507# Output formatting
508############################################################################
509
510# Wrap a line, indenting by the current left margin. We can't use
511# Text::Wrap because it plays games with tabs. We can't use formline, even
512# though we'd really like to, because it screws up non-printing characters.
513# So we have to do the wrapping ourselves.
514sub wrap {
515 my $self = shift;
516 local $_ = shift;
517 my $output = '';
518 my $spaces = ' ' x $$self{MARGIN};
519 my $width = $$self{width} - $$self{MARGIN};
520 while (length > $width) {
521 if (s/^([^\r\n]{0,$width})\s+// || s/^([^\r\n]{$width})//) {
522 $output .= $spaces . $1 . "\n";
523 } else {
524 last;
525 }
526 }
527 $output .= $spaces . $_;
528 $output =~ s/\s+$/\n\n/;
529 return $output;
530}
531
532# Reformat a paragraph of text for the current margin. Takes the text to
533# reformat and returns the formatted text.
534sub reformat {
535 my $self = shift;
536 local $_ = shift;
537
538 # If we're trying to preserve two spaces after sentences, do some
539 # munging to support that. Otherwise, smash all repeated whitespace.
540 if ($$self{sentence}) {
541 s/ +$//mg;
542 s/\.\r?\n/. \n/g;
543 s/[\r\n]+/ /g;
544 s/ +/ /g;
545 } else {
546 s/\s+/ /g;
547 }
548 return $self->wrap($_);
549}
550
551# Output text to the output device.
552sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }
553
554
555############################################################################
556# Backwards compatibility
557############################################################################
558
559# The old Pod::Text module did everything in a pod2text() function. This
560# tries to provide the same interface for legacy applications.
561sub pod2text {
562 my @args;
563
564 # This is really ugly; I hate doing option parsing in the middle of a
565 # module. But the old Pod::Text module supported passing flags to its
566 # entry function, so handle -a and -<number>.
567 while ($_[0] =~ /^-/) {
568 my $flag = shift;
569 if ($flag eq '-a') { push (@args, alt => 1) }
570 elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }
571 else {
572 unshift (@_, $flag);
573 last;
574 }
575 }
576
577 # Now that we know what arguments we're using, create the parser.
578 my $parser = Pod::PlainText->new (@args);
579
580 # If two arguments were given, the second argument is going to be a file
581 # handle. That means we want to call parse_from_filehandle(), which
582 # means we need to turn the first argument into a file handle. Magic
583 # open will handle the <&STDIN case automagically.
584 if (defined $_[1]) {
585 my $infh;
586 if ($] < 5.006) {
587 $infh = gensym();
588 }
589 unless (open ($infh, $_[0])) {
590 croak ("Can't open $_[0] for reading: $!\n");
591 }
592 $_[0] = $infh;
593 return $parser->parse_from_filehandle (@_);
594 } else {
595 return $parser->parse_from_file (@_);
596 }
597}
598
599
600############################################################################
601# Module return value and documentation
602############################################################################
603
604118µs1;
605__END__
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.