1N/A

1N/A

1N/Apackage Pod::PlainText;

1N/A

1N/Arequire 5.005;

1N/A

1N/Ause Carp qw(carp croak);

1N/Ause Pod::Select ();

1N/A

1N/Ause strict;

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

1N/A

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

1N/A

1N/A$VERSION = '2.02';

1N/A

1N/A

1N/A

1N/A%ESCAPES = (

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

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

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

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

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" => "\xCD", # capital I, grave accent

1N/A "igrave" => "\xED", # 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 "lchevron" => "\xAB", # left chevron (double less than)

1N/A "rchevron" => "\xBB", # right chevron (double greater than)

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{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 $$self{INDENTS} = []; # Stack of indentations.

1N/A $$self{MARGIN} = $$self{indent}; # Current left margin in spaces.

1N/A

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

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 $self->item ("\n") if defined $$self{ITEM};

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

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

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 # Perform a little magic to collapse multiple L<> references. This is

1N/A # here mostly for backwards-compatibility. We'll just rewrite the whole

1N/A # thing into actual text at this part, bypassing the whole internal

1N/A # sequence parsing thing.

1N/A s{

1N/A (

1N/A L< # A link of the form L</something>.

1N/A /

1N/A (

1N/A [:\w]+ # The item has to be a simple word...

1N/A (\(\))? # ...or simple function.

1N/A )

1N/A >

1N/A (

1N/A ,?\s+(and\s+)? # Allow lots of them, conjuncted.

1N/A L<

1N/A /

1N/A (

1N/A [:\w]+

1N/A (\(\))?

1N/A )

1N/A >

1N/A )+

1N/A )

1N/A } {

1N/A local $_ = $1;

1N/A s%L</([^>]+)>%$1%g;

1N/A my @items = split /(?:,?\s+(?:and\s+)?)/;

1N/A my $string = "the ";

1N/A my $i;

1N/A for ($i = 0; $i < @items; $i++) {

1N/A $string .= $items[$i];

1N/A $string .= ", " if @items > 2 && $i != $#items;

1N/A $string .= " and " if ($i == $#items - 1);

1N/A }

1N/A $string .= " entries elsewhere in this document";

1N/A $string;

1N/A }gex;

1N/A

1N/A # Now actually 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 my $self = shift;

1N/A my $command = shift;

1N/A local $_ = shift;

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

1N/A

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

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

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

1N/A carp "Unknown escape: E<$_>";

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

1N/A }

1N/A

1N/A # For all the other sequences, 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{2,}/ /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 ($_) }

1N/A else { carp "Unknown sequence $command<$_>" }

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 $_;

1N/A}

1N/A

1N/A

1N/A

1N/A

1N/Asub cmd_head1 {

1N/A my $self = shift;

1N/A local $_ = shift;

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

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

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

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

1N/A } else {

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

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

1N/A }

1N/A}

1N/A

1N/Asub cmd_head2 {

1N/A my $self = shift;

1N/A local $_ = shift;

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

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

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

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

1N/A } else {

1N/A $self->output (' ' x ($$self{indent} / 2) . $_ . "\n\n");

1N/A }

1N/A}

1N/A

1N/Asub cmd_over {

1N/A my $self = shift;

1N/A local $_ = shift;

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 = shift;

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

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

1N/A carp "Unmatched =back";

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_c { 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_l {

1N/A my $self = shift;

1N/A local $_ = shift;

1N/A

1N/A # Smash whitespace in case we were split across multiple lines.

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

1N/A

1N/A # If we were given any explicit text, just output it.

1N/A if (/^([^|]+)\|/) { return $1 }

1N/A

1N/A # Okay, leading and trailing whitespace isn't important; get rid of it.

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

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

1N/A

1N/A # Default to using the whole content of the link entry as a section

1N/A # name. Note that L<manpage/> forces a manpage interpretation, as does

1N/A # something looking like L<manpage(section)>. The latter is an

1N/A # enhancement over the original Pod::Text.

1N/A my ($manpage, $section) = ('', $_);

1N/A if (/^(?:https?|ftp|news):/) {

1N/A # a URL

1N/A return $_;

1N/A } elsif (/^"\s*(.*?)\s*"$/) {

1N/A $section = '"' . $1 . '"';

1N/A } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {

1N/A ($manpage, $section) = ($_, '');

1N/A } elsif (m%/%) {

1N/A ($manpage, $section) = split (/\s*\/\s*/, $_, 2);

1N/A }

1N/A

1N/A my $text = '';

1N/A # Now build the actual output text.

1N/A if (!length $section) {

1N/A $text = "the $manpage manpage" if length $manpage;

1N/A } elsif ($section =~ /^[:\w]+(?:\(\))?/) {

1N/A $text .= 'the ' . $section . ' entry';

1N/A $text .= (length $manpage) ? " in the $manpage manpage"

1N/A : " elsewhere in this document";

1N/A } else {

1N/A $section =~ s/^\"\s*//;

1N/A $section =~ s/\s*\"$//;

1N/A $text .= 'the section on "' . $section . '"';

1N/A $text .= " in the $manpage manpage" if length $manpage;

1N/A }

1N/A $text;

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 $space = ' ' x $indent;

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

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

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

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

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

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

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

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

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

1N/A } else {

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

1N/A s/^ /:/ 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

1N/A # munging 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/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::PlainText->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

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

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

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

1N/A local *IN;

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

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

1N/A return;

1N/A }

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

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

1N/A } else {

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

1N/A }

1N/A}

1N/A

1N/A

1N/A

1N/A1;

1N/A