1N/A

1N/A

1N/Apackage Pod::Text;

1N/A

1N/Arequire 5.004;

1N/A

1N/Ause Carp qw(carp croak);

1N/Ause Exporter ();

1N/Ause Pod::ParseLink qw(parselink);

1N/Ause Pod::Select ();

1N/A

1N/Ause strict;

1N/Ause vars qw(@ISA @EXPORT %ESCAPES $VERSION);

1N/A

1N/A@ISA = qw(Pod::Select Exporter);

1N/A

1N/A@EXPORT = qw(pod2text);

1N/A

1N/A$VERSION = 2.21;

1N/A

1N/A

1N/A

1N/A%ESCAPES = (

1N/A 'amp' => '&', # ampersand

1N/A 'apos' => "'", # apostrophe

1N/A 'lt' => '<', # left chevron, less-than

1N/A 'gt' => '>', # right chevron, greater-than

1N/A 'quot' => '"', # double quote

1N/A 'sol' => '/', # solidus (forward slash)

1N/A 'verbar' => '|', # vertical bar

1N/A

1N/A "Aacute" => "\xC1", # capital A, acute accent

1N/A "aacute" => "\xE1", # small a, acute accent

1N/A "Acirc" => "\xC2", # capital A, circumflex accent

1N/A "acirc" => "\xE2", # small a, circumflex accent

1N/A "AElig" => "\xC6", # capital AE diphthong (ligature)

1N/A "aelig" => "\xE6", # small ae diphthong (ligature)

1N/A "Agrave" => "\xC0", # capital A, grave accent

1N/A "agrave" => "\xE0", # small a, grave accent

1N/A "Aring" => "\xC5", # capital A, ring

1N/A "aring" => "\xE5", # small a, ring

1N/A "Atilde" => "\xC3", # capital A, tilde

1N/A "atilde" => "\xE3", # small a, tilde

1N/A "Auml" => "\xC4", # capital A, dieresis or umlaut mark

1N/A "auml" => "\xE4", # small a, dieresis or umlaut mark

1N/A "Ccedil" => "\xC7", # capital C, cedilla

1N/A "ccedil" => "\xE7", # small c, cedilla

1N/A "Eacute" => "\xC9", # capital E, acute accent

1N/A "eacute" => "\xE9", # small e, acute accent

1N/A "Ecirc" => "\xCA", # capital E, circumflex accent

1N/A "ecirc" => "\xEA", # small e, circumflex accent

1N/A "Egrave" => "\xC8", # capital E, grave accent

1N/A "egrave" => "\xE8", # small e, grave accent

1N/A "ETH" => "\xD0", # capital Eth, Icelandic

1N/A "eth" => "\xF0", # small eth, Icelandic

1N/A "Euml" => "\xCB", # capital E, dieresis or umlaut mark

1N/A "euml" => "\xEB", # small e, dieresis or umlaut mark

1N/A "Iacute" => "\xCD", # capital I, acute accent

1N/A "iacute" => "\xED", # small i, acute accent

1N/A "Icirc" => "\xCE", # capital I, circumflex accent

1N/A "icirc" => "\xEE", # small i, circumflex accent

1N/A "Igrave" => "\xCC", # capital I, grave accent

1N/A "igrave" => "\xEC", # small i, grave accent

1N/A "Iuml" => "\xCF", # capital I, dieresis or umlaut mark

1N/A "iuml" => "\xEF", # small i, dieresis or umlaut mark

1N/A "Ntilde" => "\xD1", # capital N, tilde

1N/A "ntilde" => "\xF1", # small n, tilde

1N/A "Oacute" => "\xD3", # capital O, acute accent

1N/A "oacute" => "\xF3", # small o, acute accent

1N/A "Ocirc" => "\xD4", # capital O, circumflex accent

1N/A "ocirc" => "\xF4", # small o, circumflex accent

1N/A "Ograve" => "\xD2", # capital O, grave accent

1N/A "ograve" => "\xF2", # small o, grave accent

1N/A "Oslash" => "\xD8", # capital O, slash

1N/A "oslash" => "\xF8", # small o, slash

1N/A "Otilde" => "\xD5", # capital O, tilde

1N/A "otilde" => "\xF5", # small o, tilde

1N/A "Ouml" => "\xD6", # capital O, dieresis or umlaut mark

1N/A "ouml" => "\xF6", # small o, dieresis or umlaut mark

1N/A "szlig" => "\xDF", # small sharp s, German (sz ligature)

1N/A "THORN" => "\xDE", # capital THORN, Icelandic

1N/A "thorn" => "\xFE", # small thorn, Icelandic

1N/A "Uacute" => "\xDA", # capital U, acute accent

1N/A "uacute" => "\xFA", # small u, acute accent

1N/A "Ucirc" => "\xDB", # capital U, circumflex accent

1N/A "ucirc" => "\xFB", # small u, circumflex accent

1N/A "Ugrave" => "\xD9", # capital U, grave accent

1N/A "ugrave" => "\xF9", # small u, grave accent

1N/A "Uuml" => "\xDC", # capital U, dieresis or umlaut mark

1N/A "uuml" => "\xFC", # small u, dieresis or umlaut mark

1N/A "Yacute" => "\xDD", # capital Y, acute accent

1N/A "yacute" => "\xFD", # small y, acute accent

1N/A "yuml" => "\xFF", # small y, dieresis or umlaut mark

1N/A

1N/A "laquo" => "\xAB", # left pointing double angle quotation mark

1N/A "lchevron" => "\xAB", # synonym (backwards compatibility)

1N/A "raquo" => "\xBB", # right pointing double angle quotation mark

1N/A "rchevron" => "\xBB", # synonym (backwards compatibility)

1N/A

1N/A "iexcl" => "\xA1", # inverted exclamation mark

1N/A "cent" => "\xA2", # cent sign

1N/A "pound" => "\xA3", # (UK) pound sign

1N/A "curren" => "\xA4", # currency sign

1N/A "yen" => "\xA5", # yen sign

1N/A "brvbar" => "\xA6", # broken vertical bar

1N/A "sect" => "\xA7", # section sign

1N/A "uml" => "\xA8", # diaresis

1N/A "copy" => "\xA9", # Copyright symbol

1N/A "ordf" => "\xAA", # feminine ordinal indicator

1N/A "not" => "\xAC", # not sign

1N/A "shy" => '', # soft (discretionary) hyphen

1N/A "reg" => "\xAE", # registered trademark

1N/A "macr" => "\xAF", # macron, overline

1N/A "deg" => "\xB0", # degree sign

1N/A "plusmn" => "\xB1", # plus-minus sign

1N/A "sup2" => "\xB2", # superscript 2

1N/A "sup3" => "\xB3", # superscript 3

1N/A "acute" => "\xB4", # acute accent

1N/A "micro" => "\xB5", # micro sign

1N/A "para" => "\xB6", # pilcrow sign = paragraph sign

1N/A "middot" => "\xB7", # middle dot = Georgian comma

1N/A "cedil" => "\xB8", # cedilla

1N/A "sup1" => "\xB9", # superscript 1

1N/A "ordm" => "\xBA", # masculine ordinal indicator

1N/A "frac14" => "\xBC", # vulgar fraction one quarter

1N/A "frac12" => "\xBD", # vulgar fraction one half

1N/A "frac34" => "\xBE", # vulgar fraction three quarters

1N/A "iquest" => "\xBF", # inverted question mark

1N/A "times" => "\xD7", # multiplication sign

1N/A "divide" => "\xF7", # division sign

1N/A

1N/A "nbsp" => "\x01", # non-breaking space

1N/A);

1N/A

1N/A

1N/A

1N/Asub initialize {

1N/A my $self = shift;

1N/A

1N/A $$self{alt} = 0 unless defined $$self{alt};

1N/A $$self{indent} = 4 unless defined $$self{indent};

1N/A $$self{margin} = 0 unless defined $$self{margin};

1N/A $$self{loose} = 0 unless defined $$self{loose};

1N/A $$self{sentence} = 0 unless defined $$self{sentence};

1N/A $$self{width} = 76 unless defined $$self{width};

1N/A

1N/A # Figure out what quotes we'll be using for C<> text.

1N/A $$self{quotes} ||= '"';

1N/A if ($$self{quotes} eq 'none') {

1N/A $$self{LQUOTE} = $$self{RQUOTE} = '';

1N/A } elsif (length ($$self{quotes}) == 1) {

1N/A $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes};

1N/A } elsif ($$self{quotes} =~ /^(.)(.)$/

1N/A || $$self{quotes} =~ /^(..)(..)$/) {

1N/A $$self{LQUOTE} = $1;

1N/A $$self{RQUOTE} = $2;

1N/A } else {

1N/A croak qq(Invalid quote specification "$$self{quotes}");

1N/A }

1N/A

1N/A # Stack of indentations.

1N/A $$self{INDENTS} = [];

1N/A

1N/A # Current left margin.

1N/A $$self{MARGIN} = $$self{indent} + $$self{margin};

1N/A

1N/A $self->SUPER::initialize;

1N/A

1N/A # Tell Pod::Parser that we want the non-POD stuff too if code was set.

1N/A $self->parseopts ('-want_nonPODs' => 1) if $$self{code};

1N/A}

1N/A

1N/A

1N/A

1N/Asub command {

1N/A my $self = shift;

1N/A my $command = shift;

1N/A return if $command eq 'pod';

1N/A return if ($$self{EXCLUDE} && $command ne 'end');

1N/A if ($self->can ('cmd_' . $command)) {

1N/A $command = 'cmd_' . $command;

1N/A $self->$command (@_);

1N/A } else {

1N/A my ($text, $line, $paragraph) = @_;

1N/A my $file;

1N/A ($file, $line) = $paragraph->file_line;

1N/A $text =~ s/\n+\z//;

1N/A $text = " $text" if ($text =~ /^\S/);

1N/A warn qq($file:$line: Unknown command paragraph: =$command$text\n);

1N/A return;

1N/A }

1N/A}

1N/A

1N/Asub verbatim {

1N/A my $self = shift;

1N/A return if $$self{EXCLUDE};

1N/A $self->item if defined $$self{ITEM};

1N/A local $_ = shift;

1N/A return if /^\s*$/;

1N/A s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;

1N/A $self->output ($_);

1N/A}

1N/A

1N/Asub textblock {

1N/A my $self = shift;

1N/A return if $$self{EXCLUDE};

1N/A $self->output ($_[0]), return if $$self{VERBATIM};

1N/A local $_ = shift;

1N/A my $line = shift;

1N/A

1N/A # Interpolate and output the paragraph.

1N/A $_ = $self->interpolate ($_, $line);

1N/A s/\s+$/\n/;

1N/A if (defined $$self{ITEM}) {

1N/A $self->item ($_ . "\n");

1N/A } else {

1N/A $self->output ($self->reformat ($_ . "\n"));

1N/A }

1N/A}

1N/A

1N/Asub interior_sequence {

1N/A local $_;

1N/A my ($self, $command, $seq);

1N/A ($self, $command, $_, $seq) = @_;

1N/A

1N/A # We have to defer processing of the inside of an L<> formatting code. If

1N/A # this code is nested inside an L<> code, return the literal raw text of

1N/A # it.

1N/A my $parent = $seq->nested;

1N/A while (defined $parent) {

1N/A return $seq->raw_text if ($parent->cmd_name eq 'L');

1N/A $parent = $parent->nested;

1N/A }

1N/A

1N/A # Index entries are ignored in plain text.

1N/A return '' if ($command eq 'X' || $command eq 'Z');

1N/A

1N/A # Expand escapes into the actual character now, warning if invalid.

1N/A if ($command eq 'E') {

1N/A if (/^\d+$/) {

1N/A return chr;

1N/A } else {

1N/A return $ESCAPES{$_} if defined $ESCAPES{$_};

1N/A my ($file, $line) = $seq->file_line;

1N/A warn "$file:$line: Unknown escape: E<$_>\n";

1N/A return "E<$_>";

1N/A }

1N/A }

1N/A

1N/A # For all the other formatting codes, empty content produces no output.

1N/A return if $_ eq '';

1N/A

1N/A # For S<>, compress all internal whitespace and then map spaces to \01.

1N/A # When we output the text, we'll map this back.

1N/A if ($command eq 'S') {

1N/A s/\s+/ /g;

1N/A tr/ /\01/;

1N/A return $_;

1N/A }

1N/A

1N/A # Anything else needs to get dispatched to another method.

1N/A if ($command eq 'B') { return $self->seq_b ($_) }

1N/A elsif ($command eq 'C') { return $self->seq_c ($_) }

1N/A elsif ($command eq 'F') { return $self->seq_f ($_) }

1N/A elsif ($command eq 'I') { return $self->seq_i ($_) }

1N/A elsif ($command eq 'L') { return $self->seq_l ($_, $seq) }

1N/A else {

1N/A my ($file, $line) = $seq->file_line;

1N/A warn "$file:$line: Unknown formatting code: $command<$_>\n";

1N/A }

1N/A}

1N/A

1N/Asub preprocess_paragraph {

1N/A my $self = shift;

1N/A local $_ = shift;

1N/A 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;

1N/A $self->output_code ($_) if $self->cutting;

1N/A $_;

1N/A}

1N/A

1N/A

1N/A

1N/A

1N/Asub cmd_head1 {

1N/A my ($self, $text, $line) = @_;

1N/A $self->heading ($text, $line, 0, '====');

1N/A}

1N/A

1N/Asub cmd_head2 {

1N/A my ($self, $text, $line) = @_;

1N/A $self->heading ($text, $line, $$self{indent} / 2, '== ');

1N/A}

1N/A

1N/Asub cmd_head3 {

1N/A my ($self, $text, $line) = @_;

1N/A $self->heading ($text, $line, $$self{indent} * 2 / 3 + 0.5, '= ');

1N/A}

1N/A

1N/Asub cmd_head4 {

1N/A my ($self, $text, $line) = @_;

1N/A $self->heading ($text, $line, $$self{indent} * 3 / 4 + 0.5, '- ');

1N/A}

1N/A

1N/Asub cmd_over {

1N/A my $self = shift;

1N/A local $_ = shift;

1N/A $self->item ("\n\n") if defined $$self{ITEM};

1N/A unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }

1N/A push (@{ $$self{INDENTS} }, $$self{MARGIN});

1N/A $$self{MARGIN} += ($_ + 0);

1N/A}

1N/A

1N/Asub cmd_back {

1N/A my ($self, $text, $line, $paragraph) = @_;

1N/A $self->item ("\n\n") if defined $$self{ITEM};

1N/A $$self{MARGIN} = pop @{ $$self{INDENTS} };

1N/A unless (defined $$self{MARGIN}) {

1N/A my $file;

1N/A ($file, $line) = $paragraph->file_line;

1N/A warn "$file:$line: Unmatched =back\n";

1N/A $$self{MARGIN} = $$self{indent};

1N/A }

1N/A}

1N/A

1N/Asub cmd_item {

1N/A my $self = shift;

1N/A if (defined $$self{ITEM}) { $self->item }

1N/A local $_ = shift;

1N/A s/\s+$//;

1N/A $$self{ITEM} = $_ ? $self->interpolate ($_) : '*';

1N/A}

1N/A

1N/Asub cmd_begin {

1N/A my $self = shift;

1N/A local $_ = shift;

1N/A my ($kind) = /^(\S+)/ or return;

1N/A if ($kind eq 'text') {

1N/A $$self{VERBATIM} = 1;

1N/A } else {

1N/A $$self{EXCLUDE} = 1;

1N/A }

1N/A}

1N/A

1N/Asub cmd_end {

1N/A my $self = shift;

1N/A $$self{EXCLUDE} = 0;

1N/A $$self{VERBATIM} = 0;

1N/A}

1N/A

1N/Asub cmd_for {

1N/A my $self = shift;

1N/A local $_ = shift;

1N/A my $line = shift;

1N/A return unless s/^text\b[ \t]*\n?//;

1N/A $self->verbatim ($_, $line);

1N/A}

1N/A

1N/A

1N/A

1N/Asub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }

1N/Asub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }

1N/Asub seq_i { return '*' . $_[1] . '*' }

1N/A

1N/Asub seq_c {

1N/A my $self = shift;

1N/A local $_ = shift;

1N/A

1N/A # A regex that matches the portion of a variable reference that's the

1N/A # array or hash index, separated out just because we want to use it in

1N/A # several places in the following regex.

1N/A my $index = '(?: \[.*\] | \{.*\} )?';

1N/A

1N/A # Check for things that we don't want to quote, and if we find any of

1N/A # them, return the string with just a font change and no quoting.

1N/A m{

1N/A ^\s*

1N/A (?:

1N/A ( [\'\`\"] ) .* \1 # already quoted

1N/A | \` .* \' # `quoted'

1N/A | \$+ [\#^]? \S $index # special ($^Foo, $")

1N/A | [\$\@%&*]+ \#? [:\'\w]+ $index # plain var or func

1N/A | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call

1N/A | [+-]? ( \d[\d.]* | \.\d+ ) (?: [eE][+-]?\d+ )? # a number

1N/A | 0x [a-fA-F\d]+ # a hex constant

1N/A )

1N/A \s*\z

1N/A }xo && return $_;

1N/A

1N/A # If we didn't return, go ahead and quote the text.

1N/A return $$self{alt} ? "``$_''" : "$$self{LQUOTE}$_$$self{RQUOTE}";

1N/A}

1N/A

1N/Asub seq_l {

1N/A my ($self, $link, $seq) = @_;

1N/A my ($text, $type) = (parselink ($link))[1,4];

1N/A my ($file, $line) = $seq->file_line;

1N/A $text = $self->interpolate ($text, $line);

1N/A $text = '<' . $text . '>' if $type eq 'url';

1N/A return $text || '';

1N/A}

1N/A

1N/A

1N/A

1N/Asub heading {

1N/A my ($self, $text, $line, $indent, $marker) = @_;

1N/A $self->item ("\n\n") if defined $$self{ITEM};

1N/A $text =~ s/\s+$//;

1N/A $text = $self->interpolate ($text, $line);

1N/A if ($$self{alt}) {

1N/A my $closemark = reverse (split (//, $marker));

1N/A my $margin = ' ' x $$self{margin};

1N/A $self->output ("\n" . "$margin$marker $text $closemark" . "\n\n");

1N/A } else {

1N/A $text .= "\n" if $$self{loose};

1N/A my $margin = ' ' x ($$self{margin} + $indent);

1N/A $self->output ($margin . $text . "\n");

1N/A }

1N/A}

1N/A

1N/A

1N/A

1N/Asub item {

1N/A my $self = shift;

1N/A local $_ = shift;

1N/A my $tag = $$self{ITEM};

1N/A unless (defined $tag) {

1N/A carp "Item called without tag";

1N/A return;

1N/A }

1N/A undef $$self{ITEM};

1N/A my $indent = $$self{INDENTS}[-1];

1N/A unless (defined $indent) { $indent = $$self{indent} }

1N/A my $margin = ' ' x $$self{margin};

1N/A if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {

1N/A my $realindent = $$self{MARGIN};

1N/A $$self{MARGIN} = $indent;

1N/A my $output = $self->reformat ($tag);

1N/A $output =~ s/^$margin /$margin:/ if ($$self{alt} && $indent > 0);

1N/A $output =~ s/\n*$/\n/;

1N/A

1N/A # If the text is just whitespace, we have an empty item paragraph;

1N/A # this can result from =over/=item/=back without any intermixed

1N/A # paragraphs. Insert some whitespace to keep the =item from merging

1N/A # into the next paragraph.

1N/A $output .= "\n" if $_ && $_ =~ /^\s*$/;

1N/A

1N/A $self->output ($output);

1N/A $$self{MARGIN} = $realindent;

1N/A $self->output ($self->reformat ($_)) if $_ && /\S/;

1N/A } else {

1N/A my $space = ' ' x $indent;

1N/A $space =~ s/^$margin /$margin:/ if $$self{alt};

1N/A $_ = $self->reformat ($_);

1N/A s/^$margin /$margin:/ if ($$self{alt} && $indent > 0);

1N/A my $tagspace = ' ' x length $tag;

1N/A s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item";

1N/A $self->output ($_);

1N/A }

1N/A}

1N/A

1N/A

1N/A

1N/Asub wrap {

1N/A my $self = shift;

1N/A local $_ = shift;

1N/A my $output = '';

1N/A my $spaces = ' ' x $$self{MARGIN};

1N/A my $width = $$self{width} - $$self{MARGIN};

1N/A while (length > $width) {

1N/A if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//) {

1N/A $output .= $spaces . $1 . "\n";

1N/A } else {

1N/A last;

1N/A }

1N/A }

1N/A $output .= $spaces . $_;

1N/A $output =~ s/\s+$/\n\n/;

1N/A $output;

1N/A}

1N/A

1N/Asub reformat {

1N/A my $self = shift;

1N/A local $_ = shift;

1N/A

1N/A # If we're trying to preserve two spaces after sentences, do some munging

1N/A # to support that. Otherwise, smash all repeated whitespace.

1N/A if ($$self{sentence}) {

1N/A s/ +$//mg;

1N/A s/\.\n/. \n/g;

1N/A s/\n/ /g;

1N/A s/ +/ /g;

1N/A } else {

1N/A s/\s+/ /g;

1N/A }

1N/A $self->wrap ($_);

1N/A}

1N/A

1N/Asub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }

1N/A

1N/Asub output_code { $_[0]->output ($_[1]) }

1N/A

1N/A

1N/A

1N/Asub pod2text {

1N/A my @args;

1N/A

1N/A # This is really ugly; I hate doing option parsing in the middle of a

1N/A # module. But the old Pod::Text module supported passing flags to its

1N/A # entry function, so handle -a and -<number>.

1N/A while ($_[0] =~ /^-/) {

1N/A my $flag = shift;

1N/A if ($flag eq '-a') { push (@args, alt => 1) }

1N/A elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }

1N/A else {

1N/A unshift (@_, $flag);

1N/A last;

1N/A }

1N/A }

1N/A

1N/A # Now that we know what arguments we're using, create the parser.

1N/A my $parser = Pod::Text->new (@args);

1N/A

1N/A # If two arguments were given, the second argument is going to be a file

1N/A # handle. That means we want to call parse_from_filehandle(), which means

1N/A # we need to turn the first argument into a file handle. Magic open will

1N/A # handle the <&STDIN case automagically.

1N/A if (defined $_[1]) {

1N/A my @fhs = @_;

1N/A local *IN;

1N/A unless (open (IN, $fhs[0])) {

1N/A croak ("Can't open $fhs[0] for reading: $!\n");

1N/A return;

1N/A }

1N/A $fhs[0] = \*IN;

1N/A return $parser->parse_from_filehandle (@fhs);

1N/A } else {

1N/A return $parser->parse_from_file (@_);

1N/A }

1N/A}

1N/A

1N/A

1N/A

1N/A1;

1N/A