# Pod::PlainText -- Convert POD data to formatted ASCII text.# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $## Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>## This program is free software; you can redistribute it and/or modify it# under the same terms as Perl itself.## This module is intended to be a replacement for Pod::Text, and attempts to# match its output except for some specific circumstances where other# decisions seemed to produce better output.  It uses Pod::Parser and is# designed to be very easy to subclass.############################################################################# Modules and declarations############################################################################package Pod::PlainText;require 5.005;use Carp qw(carp croak);use Pod::Select ();use strict;use vars qw(@ISA %ESCAPES $VERSION);# We inherit from Pod::Select instead of Pod::Parser so that we can be used# by Pod::Usage.@ISA = qw(Pod::Select);$VERSION = '2.02';############################################################################# Table of supported E<> escapes############################################################################# This table is taken near verbatim from Pod::PlainText in Pod::Parser,# which got it near verbatim from the original Pod::Text.  It is therefore# credited to Tom Christiansen, and I'm glad I didn't have to write it.  :)%ESCAPES = (    'amp'       =>    '&',      # ampersand    'lt'        =>    '<',      # left chevron, less-than    'gt'        =>    '>',      # right chevron, greater-than    'quot'      =>    '"',      # double quote    "Aacute"    =>    "\xC1",   # capital A, acute accent    "aacute"    =>    "\xE1",   # small a, acute accent    "Acirc"     =>    "\xC2",   # capital A, circumflex accent    "acirc"     =>    "\xE2",   # small a, circumflex accent    "AElig"     =>    "\xC6",   # capital AE diphthong (ligature)    "aelig"     =>    "\xE6",   # small ae diphthong (ligature)    "Agrave"    =>    "\xC0",   # capital A, grave accent    "agrave"    =>    "\xE0",   # small a, grave accent    "Aring"     =>    "\xC5",   # capital A, ring    "aring"     =>    "\xE5",   # small a, ring    "Atilde"    =>    "\xC3",   # capital A, tilde    "atilde"    =>    "\xE3",   # small a, tilde    "Auml"      =>    "\xC4",   # capital A, dieresis or umlaut mark    "auml"      =>    "\xE4",   # small a, dieresis or umlaut mark    "Ccedil"    =>    "\xC7",   # capital C, cedilla    "ccedil"    =>    "\xE7",   # small c, cedilla    "Eacute"    =>    "\xC9",   # capital E, acute accent    "eacute"    =>    "\xE9",   # small e, acute accent    "Ecirc"     =>    "\xCA",   # capital E, circumflex accent    "ecirc"     =>    "\xEA",   # small e, circumflex accent    "Egrave"    =>    "\xC8",   # capital E, grave accent    "egrave"    =>    "\xE8",   # small e, grave accent    "ETH"       =>    "\xD0",   # capital Eth, Icelandic    "eth"       =>    "\xF0",   # small eth, Icelandic    "Euml"      =>    "\xCB",   # capital E, dieresis or umlaut mark    "euml"      =>    "\xEB",   # small e, dieresis or umlaut mark    "Iacute"    =>    "\xCD",   # capital I, acute accent    "iacute"    =>    "\xED",   # small i, acute accent    "Icirc"     =>    "\xCE",   # capital I, circumflex accent    "icirc"     =>    "\xEE",   # small i, circumflex accent    "Igrave"    =>    "\xCD",   # capital I, grave accent    "igrave"    =>    "\xED",   # small i, grave accent    "Iuml"      =>    "\xCF",   # capital I, dieresis or umlaut mark    "iuml"      =>    "\xEF",   # small i, dieresis or umlaut mark    "Ntilde"    =>    "\xD1",   # capital N, tilde    "ntilde"    =>    "\xF1",   # small n, tilde    "Oacute"    =>    "\xD3",   # capital O, acute accent    "oacute"    =>    "\xF3",   # small o, acute accent    "Ocirc"     =>    "\xD4",   # capital O, circumflex accent    "ocirc"     =>    "\xF4",   # small o, circumflex accent    "Ograve"    =>    "\xD2",   # capital O, grave accent    "ograve"    =>    "\xF2",   # small o, grave accent    "Oslash"    =>    "\xD8",   # capital O, slash    "oslash"    =>    "\xF8",   # small o, slash    "Otilde"    =>    "\xD5",   # capital O, tilde    "otilde"    =>    "\xF5",   # small o, tilde    "Ouml"      =>    "\xD6",   # capital O, dieresis or umlaut mark    "ouml"      =>    "\xF6",   # small o, dieresis or umlaut mark    "szlig"     =>    "\xDF",   # small sharp s, German (sz ligature)    "THORN"     =>    "\xDE",   # capital THORN, Icelandic    "thorn"     =>    "\xFE",   # small thorn, Icelandic    "Uacute"    =>    "\xDA",   # capital U, acute accent    "uacute"    =>    "\xFA",   # small u, acute accent    "Ucirc"     =>    "\xDB",   # capital U, circumflex accent    "ucirc"     =>    "\xFB",   # small u, circumflex accent    "Ugrave"    =>    "\xD9",   # capital U, grave accent    "ugrave"    =>    "\xF9",   # small u, grave accent    "Uuml"      =>    "\xDC",   # capital U, dieresis or umlaut mark    "uuml"      =>    "\xFC",   # small u, dieresis or umlaut mark    "Yacute"    =>    "\xDD",   # capital Y, acute accent    "yacute"    =>    "\xFD",   # small y, acute accent    "yuml"      =>    "\xFF",   # small y, dieresis or umlaut mark    "lchevron"  =>    "\xAB",   # left chevron (double less than)    "rchevron"  =>    "\xBB",   # right chevron (double greater than));############################################################################# Initialization############################################################################# Initialize the object.  Must be sure to call our parent initializer.sub initialize {    my $self = shift;    $$self{alt}      = 0  unless defined $$self{alt};    $$self{indent}   = 4  unless defined $$self{indent};    $$self{loose}    = 0  unless defined $$self{loose};    $$self{sentence} = 0  unless defined $$self{sentence};    $$self{width}    = 76 unless defined $$self{width};    $$self{INDENTS}  = [];              # Stack of indentations.    $$self{MARGIN}   = $$self{indent};  # Current left margin in spaces.    $self->SUPER::initialize;}############################################################################# Core overrides############################################################################# Called for each command paragraph.  Gets the command, the associated# paragraph, the line number, and a Pod::Paragraph object.  Just dispatches# the command to a method named the same as the command.  =cut is handled# internally by Pod::Parser.sub command {    my $self = shift;    my $command = shift;    return if $command eq 'pod';    return if ($$self{EXCLUDE} && $command ne 'end');    $self->item ("\n") if defined $$self{ITEM};    $command = 'cmd_' . $command;    $self->$command (@_);}# Called for a verbatim paragraph.  Gets the paragraph, the line number, and# a Pod::Paragraph object.  Just output it verbatim, but with tabs converted# to spaces.sub verbatim {    my $self = shift;    return if $$self{EXCLUDE};    $self->item if defined $$self{ITEM};    local $_ = shift;    return if /^\s*$/;    s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;    $self->output ($_);}# Called for a regular text block.  Gets the paragraph, the line number, and# a Pod::Paragraph object.  Perform interpolation and output the results.sub textblock {    my $self = shift;    return if $$self{EXCLUDE};    $self->output ($_[0]), return if $$self{VERBATIM};    local $_ = shift;    my $line = shift;    # Perform a little magic to collapse multiple L<> references.  This is    # here mostly for backwards-compatibility.  We'll just rewrite the whole    # thing into actual text at this part, bypassing the whole internal    # sequence parsing thing.    s{        (          L<                    # A link of the form L</something>.              /              (                  [:\w]+        # The item has to be a simple word...                  (\(\))?       # ...or simple function.              )          >          (              ,?\s+(and\s+)?    # Allow lots of them, conjuncted.              L<                    /                  (                      [:\w]+                      (\(\))?                  )              >          )+        )    } {        local $_ = $1;        s%L</([^>]+)>%$1%g;        my @items = split /(?:,?\s+(?:and\s+)?)/;        my $string = "the ";        my $i;        for ($i = 0; $i < @items; $i++) {            $string .= $items[$i];            $string .= ", " if @items > 2 && $i != $#items;            $string .= " and " if ($i == $#items - 1);        }        $string .= " entries elsewhere in this document";        $string;    }gex;    # Now actually interpolate and output the paragraph.    $_ = $self->interpolate ($_, $line);    s/\s+$/\n/;    if (defined $$self{ITEM}) {        $self->item ($_ . "\n");    } else {        $self->output ($self->reformat ($_ . "\n"));    }}# Called for an interior sequence.  Gets the command, argument, and a# Pod::InteriorSequence object and is expected to return the resulting text.# Calls code, bold, italic, file, and link to handle those types of# sequences, and handles S<>, E<>, X<>, and Z<> directly.sub interior_sequence {    my $self = shift;    my $command = shift;    local $_ = shift;    return '' if ($command eq 'X' || $command eq 'Z');    # Expand escapes into the actual character now, carping if invalid.    if ($command eq 'E') {        return $ESCAPES{$_} if defined $ESCAPES{$_};        carp "Unknown escape: E<$_>";        return "E<$_>";    }    # For all the other sequences, empty content produces no output.    return if $_ eq '';    # For S<>, compress all internal whitespace and then map spaces to \01.    # When we output the text, we'll map this back.    if ($command eq 'S') {        s/\s{2,}/ /g;        tr/ /\01/;        return $_;    }    # Anything else needs to get dispatched to another method.    if    ($command eq 'B') { return $self->seq_b ($_) }    elsif ($command eq 'C') { return $self->seq_c ($_) }    elsif ($command eq 'F') { return $self->seq_f ($_) }    elsif ($command eq 'I') { return $self->seq_i ($_) }    elsif ($command eq 'L') { return $self->seq_l ($_) }    else { carp "Unknown sequence $command<$_>" }}# Called for each paragraph that's actually part of the POD.  We take# advantage of this opportunity to untabify the input.sub preprocess_paragraph {    my $self = shift;    local $_ = shift;    1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;    $_;}############################################################################# Command paragraphs############################################################################# All command paragraphs take the paragraph and the line number.# First level heading.sub cmd_head1 {    my $self = shift;    local $_ = shift;    s/\s+$//;    $_ = $self->interpolate ($_, shift);    if ($$self{alt}) {        $self->output ("\n==== $_ ====\n\n");    } else {        $_ .= "\n" if $$self{loose};        $self->output ($_ . "\n");    }}# Second level heading.sub cmd_head2 {    my $self = shift;    local $_ = shift;    s/\s+$//;    $_ = $self->interpolate ($_, shift);    if ($$self{alt}) {        $self->output ("\n==   $_   ==\n\n");    } else {        $self->output (' ' x ($$self{indent} / 2) . $_ . "\n\n");    }}# third level heading - not strictly perlpodspec compliantsub cmd_head3 {    my $self = shift;    local $_ = shift;    s/\s+$//;    $_ = $self->interpolate ($_, shift);    if ($$self{alt}) {        $self->output ("\n= $_ =\n");    } else {        $self->output (' ' x ($$self{indent}) . $_ . "\n");    }}# fourth level heading - not strictly perlpodspec compliant# just like head3*cmd_head4 = \&cmd_head3;# Start a list.sub cmd_over {    my $self = shift;    local $_ = shift;    unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }    push (@{ $$self{INDENTS} }, $$self{MARGIN});    $$self{MARGIN} += ($_ + 0);}# End a list.sub cmd_back {    my $self = shift;    $$self{MARGIN} = pop @{ $$self{INDENTS} };    unless (defined $$self{MARGIN}) {        carp "Unmatched =back";        $$self{MARGIN} = $$self{indent};    }}# An individual list item.sub cmd_item {    my $self = shift;    if (defined $$self{ITEM}) { $self->item }    local $_ = shift;    s/\s+$//;    $$self{ITEM} = $self->interpolate ($_);}# Begin a block for a particular translator.  Setting VERBATIM triggers# special handling in textblock().sub cmd_begin {    my $self = shift;    local $_ = shift;    my ($kind) = /^(\S+)/ or return;    if ($kind eq 'text') {        $$self{VERBATIM} = 1;    } else {        $$self{EXCLUDE} = 1;    }}