xref: /openbsd-src/gnu/usr.bin/perl/cpan/Pod-Usage/t/inc/Pod/PlainText.pm (revision f2a19305cfc49ea4d1a5feb55cd6c283c6f1e031)
15759b3d2Safresh1# Pod::PlainText -- Convert POD data to formatted ASCII text.
25759b3d2Safresh1# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $
35759b3d2Safresh1#
45759b3d2Safresh1# Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>
55759b3d2Safresh1#
65759b3d2Safresh1# This program is free software; you can redistribute it and/or modify it
75759b3d2Safresh1# under the same terms as Perl itself.
85759b3d2Safresh1#
95759b3d2Safresh1# This module is intended to be a replacement for Pod::Text, and attempts to
105759b3d2Safresh1# match its output except for some specific circumstances where other
115759b3d2Safresh1# decisions seemed to produce better output.  It uses Pod::Parser and is
125759b3d2Safresh1# designed to be very easy to subclass.
135759b3d2Safresh1
145759b3d2Safresh1############################################################################
155759b3d2Safresh1# Modules and declarations
165759b3d2Safresh1############################################################################
175759b3d2Safresh1
185759b3d2Safresh1package Pod::PlainText;
195759b3d2Safresh1use strict;
20256a93a4Safresh1use warnings;
215759b3d2Safresh1
225759b3d2Safresh1require 5.005;
235759b3d2Safresh1
245759b3d2Safresh1use Carp qw(carp croak);
255759b3d2Safresh1use Pod::Select ();
265759b3d2Safresh1
275759b3d2Safresh1use vars qw(@ISA %ESCAPES $VERSION);
285759b3d2Safresh1
295759b3d2Safresh1# We inherit from Pod::Select instead of Pod::Parser so that we can be used
305759b3d2Safresh1# by Pod::Usage.
315759b3d2Safresh1@ISA = qw(Pod::Select);
325759b3d2Safresh1
335759b3d2Safresh1$VERSION = '2.06';
345759b3d2Safresh1
355759b3d2Safresh1BEGIN {
365759b3d2Safresh1   if ($] < 5.006) {
375759b3d2Safresh1      require Symbol;
38256a93a4Safresh1      Symbol->import;
395759b3d2Safresh1   }
40*f2a19305Safresh1   if ($] < 5.008 || ord "A" == 65) {
41*f2a19305Safresh1      *to_native = sub { return chr shift; };
42*f2a19305Safresh1   }
43*f2a19305Safresh1   else {
44*f2a19305Safresh1      *to_native = sub { return chr utf8::unicode_to_native(shift); };
45*f2a19305Safresh1   }
465759b3d2Safresh1}
475759b3d2Safresh1
485759b3d2Safresh1############################################################################
495759b3d2Safresh1# Table of supported E<> escapes
505759b3d2Safresh1############################################################################
515759b3d2Safresh1
525759b3d2Safresh1# This table is taken near verbatim from Pod::PlainText in Pod::Parser,
535759b3d2Safresh1# which got it near verbatim from the original Pod::Text.  It is therefore
545759b3d2Safresh1# credited to Tom Christiansen, and I'm glad I didn't have to write it.  :)
555759b3d2Safresh1%ESCAPES = (
565759b3d2Safresh1    'amp'       =>    '&',      # ampersand
575759b3d2Safresh1    'lt'        =>    '<',      # left chevron, less-than
585759b3d2Safresh1    'gt'        =>    '>',      # right chevron, greater-than
595759b3d2Safresh1    'quot'      =>    '"',      # double quote
605759b3d2Safresh1
61*f2a19305Safresh1    "Aacute"    =>    to_native(0xC1),   # capital A, acute accent
62*f2a19305Safresh1    "aacute"    =>    to_native(0xE1),   # small a, acute accent
63*f2a19305Safresh1    "Acirc"     =>    to_native(0xC2),   # capital A, circumflex accent
64*f2a19305Safresh1    "acirc"     =>    to_native(0xE2),   # small a, circumflex accent
65*f2a19305Safresh1    "AElig"     =>    to_native(0xC6),   # capital AE diphthong (ligature)
66*f2a19305Safresh1    "aelig"     =>    to_native(0xE6),   # small ae diphthong (ligature)
67*f2a19305Safresh1    "Agrave"    =>    to_native(0xC0),   # capital A, grave accent
68*f2a19305Safresh1    "agrave"    =>    to_native(0xE0),   # small a, grave accent
69*f2a19305Safresh1    "Aring"     =>    to_native(0xC5),   # capital A, ring
70*f2a19305Safresh1    "aring"     =>    to_native(0xE5),   # small a, ring
71*f2a19305Safresh1    "Atilde"    =>    to_native(0xC3),   # capital A, tilde
72*f2a19305Safresh1    "atilde"    =>    to_native(0xE3),   # small a, tilde
73*f2a19305Safresh1    "Auml"      =>    to_native(0xC4),   # capital A, dieresis or umlaut mark
74*f2a19305Safresh1    "auml"      =>    to_native(0xE4),   # small a, dieresis or umlaut mark
75*f2a19305Safresh1    "Ccedil"    =>    to_native(0xC7),   # capital C, cedilla
76*f2a19305Safresh1    "ccedil"    =>    to_native(0xE7),   # small c, cedilla
77*f2a19305Safresh1    "Eacute"    =>    to_native(0xC9),   # capital E, acute accent
78*f2a19305Safresh1    "eacute"    =>    to_native(0xE9),   # small e, acute accent
79*f2a19305Safresh1    "Ecirc"     =>    to_native(0xCA),   # capital E, circumflex accent
80*f2a19305Safresh1    "ecirc"     =>    to_native(0xEA),   # small e, circumflex accent
81*f2a19305Safresh1    "Egrave"    =>    to_native(0xC8),   # capital E, grave accent
82*f2a19305Safresh1    "egrave"    =>    to_native(0xE8),   # small e, grave accent
83*f2a19305Safresh1    "ETH"       =>    to_native(0xD0),   # capital Eth, Icelandic
84*f2a19305Safresh1    "eth"       =>    to_native(0xF0),   # small eth, Icelandic
85*f2a19305Safresh1    "Euml"      =>    to_native(0xCB),   # capital E, dieresis or umlaut mark
86*f2a19305Safresh1    "euml"      =>    to_native(0xEB),   # small e, dieresis or umlaut mark
87*f2a19305Safresh1    "Iacute"    =>    to_native(0xCD),   # capital I, acute accent
88*f2a19305Safresh1    "iacute"    =>    to_native(0xED),   # small i, acute accent
89*f2a19305Safresh1    "Icirc"     =>    to_native(0xCE),   # capital I, circumflex accent
90*f2a19305Safresh1    "icirc"     =>    to_native(0xEE),   # small i, circumflex accent
91*f2a19305Safresh1    "Igrave"    =>    to_native(0xCD),   # capital I, grave accent
92*f2a19305Safresh1    "igrave"    =>    to_native(0xED),   # small i, grave accent
93*f2a19305Safresh1    "Iuml"      =>    to_native(0xCF),   # capital I, dieresis or umlaut mark
94*f2a19305Safresh1    "iuml"      =>    to_native(0xEF),   # small i, dieresis or umlaut mark
95*f2a19305Safresh1    "Ntilde"    =>    to_native(0xD1),   # capital N, tilde
96*f2a19305Safresh1    "ntilde"    =>    to_native(0xF1),   # small n, tilde
97*f2a19305Safresh1    "Oacute"    =>    to_native(0xD3),   # capital O, acute accent
98*f2a19305Safresh1    "oacute"    =>    to_native(0xF3),   # small o, acute accent
99*f2a19305Safresh1    "Ocirc"     =>    to_native(0xD4),   # capital O, circumflex accent
100*f2a19305Safresh1    "ocirc"     =>    to_native(0xF4),   # small o, circumflex accent
101*f2a19305Safresh1    "Ograve"    =>    to_native(0xD2),   # capital O, grave accent
102*f2a19305Safresh1    "ograve"    =>    to_native(0xF2),   # small o, grave accent
103*f2a19305Safresh1    "Oslash"    =>    to_native(0xD8),   # capital O, slash
104*f2a19305Safresh1    "oslash"    =>    to_native(0xF8),   # small o, slash
105*f2a19305Safresh1    "Otilde"    =>    to_native(0xD5),   # capital O, tilde
106*f2a19305Safresh1    "otilde"    =>    to_native(0xF5),   # small o, tilde
107*f2a19305Safresh1    "Ouml"      =>    to_native(0xD6),   # capital O, dieresis or umlaut mark
108*f2a19305Safresh1    "ouml"      =>    to_native(0xF6),   # small o, dieresis or umlaut mark
109*f2a19305Safresh1    "szlig"     =>    to_native(0xDF),   # small sharp s, German (sz ligature)
110*f2a19305Safresh1    "THORN"     =>    to_native(0xDE),   # capital THORN, Icelandic
111*f2a19305Safresh1    "thorn"     =>    to_native(0xFE),   # small thorn, Icelandic
112*f2a19305Safresh1    "Uacute"    =>    to_native(0xDA),   # capital U, acute accent
113*f2a19305Safresh1    "uacute"    =>    to_native(0xFA),   # small u, acute accent
114*f2a19305Safresh1    "Ucirc"     =>    to_native(0xDB),   # capital U, circumflex accent
115*f2a19305Safresh1    "ucirc"     =>    to_native(0xFB),   # small u, circumflex accent
116*f2a19305Safresh1    "Ugrave"    =>    to_native(0xD9),   # capital U, grave accent
117*f2a19305Safresh1    "ugrave"    =>    to_native(0xF9),   # small u, grave accent
118*f2a19305Safresh1    "Uuml"      =>    to_native(0xDC),   # capital U, dieresis or umlaut mark
119*f2a19305Safresh1    "uuml"      =>    to_native(0xFC),   # small u, dieresis or umlaut mark
120*f2a19305Safresh1    "Yacute"    =>    to_native(0xDD),   # capital Y, acute accent
121*f2a19305Safresh1    "yacute"    =>    to_native(0xFD),   # small y, acute accent
122*f2a19305Safresh1    "yuml"      =>    to_native(0xFF),   # small y, dieresis or umlaut mark
1235759b3d2Safresh1
124*f2a19305Safresh1    "lchevron"  =>    to_native(0xAB),   # left chevron (double less than)
125*f2a19305Safresh1    "rchevron"  =>    to_native(0xBB),   # right chevron (double greater than)
1265759b3d2Safresh1);
1275759b3d2Safresh1
1285759b3d2Safresh1
1295759b3d2Safresh1############################################################################
1305759b3d2Safresh1# Initialization
1315759b3d2Safresh1############################################################################
1325759b3d2Safresh1
1335759b3d2Safresh1# Initialize the object.  Must be sure to call our parent initializer.
1345759b3d2Safresh1sub initialize {
1355759b3d2Safresh1    my $self = shift;
1365759b3d2Safresh1
1375759b3d2Safresh1    $$self{alt}      = 0  unless defined $$self{alt};
1385759b3d2Safresh1    $$self{indent}   = 4  unless defined $$self{indent};
1395759b3d2Safresh1    $$self{loose}    = 0  unless defined $$self{loose};
1405759b3d2Safresh1    $$self{sentence} = 0  unless defined $$self{sentence};
1415759b3d2Safresh1    $$self{width}    = 76 unless defined $$self{width};
1425759b3d2Safresh1
1435759b3d2Safresh1    $$self{INDENTS}  = [];              # Stack of indentations.
1445759b3d2Safresh1    $$self{MARGIN}   = $$self{indent};  # Current left margin in spaces.
1455759b3d2Safresh1
1465759b3d2Safresh1    return $self->SUPER::initialize;
1475759b3d2Safresh1}
1485759b3d2Safresh1
1495759b3d2Safresh1
1505759b3d2Safresh1############################################################################
1515759b3d2Safresh1# Core overrides
1525759b3d2Safresh1############################################################################
1535759b3d2Safresh1
1545759b3d2Safresh1# Called for each command paragraph.  Gets the command, the associated
1555759b3d2Safresh1# paragraph, the line number, and a Pod::Paragraph object.  Just dispatches
1565759b3d2Safresh1# the command to a method named the same as the command.  =cut is handled
1575759b3d2Safresh1# internally by Pod::Parser.
1585759b3d2Safresh1sub command {
1595759b3d2Safresh1    my $self = shift;
1605759b3d2Safresh1    my $command = shift;
1615759b3d2Safresh1    return if $command eq 'pod';
1625759b3d2Safresh1    return if ($$self{EXCLUDE} && $command ne 'end');
1635759b3d2Safresh1    if (defined $$self{ITEM}) {
1645759b3d2Safresh1      $self->item ("\n");
1655759b3d2Safresh1      local $_ = "\n";
1665759b3d2Safresh1      $self->output($_) if($command eq 'back');
1675759b3d2Safresh1    }
1685759b3d2Safresh1    $command = 'cmd_' . $command;
1695759b3d2Safresh1    return $self->$command (@_);
1705759b3d2Safresh1}
1715759b3d2Safresh1
1725759b3d2Safresh1# Called for a verbatim paragraph.  Gets the paragraph, the line number, and
1735759b3d2Safresh1# a Pod::Paragraph object.  Just output it verbatim, but with tabs converted
1745759b3d2Safresh1# to spaces.
1755759b3d2Safresh1sub verbatim {
1765759b3d2Safresh1    my $self = shift;
1775759b3d2Safresh1    return if $$self{EXCLUDE};
1785759b3d2Safresh1    $self->item if defined $$self{ITEM};
1795759b3d2Safresh1    local $_ = shift;
1805759b3d2Safresh1    return if /^\s*$/;
1815759b3d2Safresh1    s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
1825759b3d2Safresh1    return $self->output($_);
1835759b3d2Safresh1}
1845759b3d2Safresh1
1855759b3d2Safresh1# Called for a regular text block.  Gets the paragraph, the line number, and
1865759b3d2Safresh1# a Pod::Paragraph object.  Perform interpolation and output the results.
1875759b3d2Safresh1sub textblock {
1885759b3d2Safresh1    my $self = shift;
1895759b3d2Safresh1    return if $$self{EXCLUDE};
1905759b3d2Safresh1    if($$self{VERBATIM}) {
1915759b3d2Safresh1      $self->output($_[0]);
1925759b3d2Safresh1      return;
1935759b3d2Safresh1    }
1945759b3d2Safresh1    local $_ = shift;
1955759b3d2Safresh1    my $line = shift;
1965759b3d2Safresh1
1975759b3d2Safresh1    # Perform a little magic to collapse multiple L<> references.  This is
1985759b3d2Safresh1    # here mostly for backwards-compatibility.  We'll just rewrite the whole
1995759b3d2Safresh1    # thing into actual text at this part, bypassing the whole internal
2005759b3d2Safresh1    # sequence parsing thing.
2015759b3d2Safresh1    s{
2025759b3d2Safresh1        (
2035759b3d2Safresh1          L<                    # A link of the form L</something>.
2045759b3d2Safresh1              /
2055759b3d2Safresh1              (
2065759b3d2Safresh1                  [:\w]+        # The item has to be a simple word...
2075759b3d2Safresh1                  (\(\))?       # ...or simple function.
2085759b3d2Safresh1              )
2095759b3d2Safresh1          >
2105759b3d2Safresh1          (
2115759b3d2Safresh1              ,?\s+(and\s+)?    # Allow lots of them, conjuncted.
2125759b3d2Safresh1              L<
2135759b3d2Safresh1                  /
2145759b3d2Safresh1                  (
2155759b3d2Safresh1                      [:\w]+
2165759b3d2Safresh1                      (\(\))?
2175759b3d2Safresh1                  )
2185759b3d2Safresh1              >
2195759b3d2Safresh1          )+
2205759b3d2Safresh1        )
2215759b3d2Safresh1    } {
2225759b3d2Safresh1        local $_ = $1;
2235759b3d2Safresh1        s%L</([^>]+)>%$1%g;
2245759b3d2Safresh1        my @items = split /(?:,?\s+(?:and\s+)?)/;
2255759b3d2Safresh1        my $string = "the ";
2265759b3d2Safresh1        my $i;
2275759b3d2Safresh1        for ($i = 0; $i < @items; $i++) {
2285759b3d2Safresh1            $string .= $items[$i];
2295759b3d2Safresh1            $string .= ", " if @items > 2 && $i != $#items;
2305759b3d2Safresh1            $string .= " and " if ($i == $#items - 1);
2315759b3d2Safresh1        }
2325759b3d2Safresh1        $string .= " entries elsewhere in this document";
2335759b3d2Safresh1        $string;
2345759b3d2Safresh1    }gex;
2355759b3d2Safresh1
2365759b3d2Safresh1    # Now actually interpolate and output the paragraph.
2375759b3d2Safresh1    $_ = $self->interpolate ($_, $line);
2385759b3d2Safresh1    s/\s*$/\n/s;
2395759b3d2Safresh1    if (defined $$self{ITEM}) {
2405759b3d2Safresh1        $self->item ($_ . "\n");
2415759b3d2Safresh1    } else {
2425759b3d2Safresh1        $self->output ($self->reformat ($_ . "\n"));
2435759b3d2Safresh1    }
2445759b3d2Safresh1}
2455759b3d2Safresh1
2465759b3d2Safresh1# Called for an interior sequence.  Gets the command, argument, and a
2475759b3d2Safresh1# Pod::InteriorSequence object and is expected to return the resulting text.
2485759b3d2Safresh1# Calls code, bold, italic, file, and link to handle those types of
2495759b3d2Safresh1# sequences, and handles S<>, E<>, X<>, and Z<> directly.
2505759b3d2Safresh1sub interior_sequence {
2515759b3d2Safresh1    my $self = shift;
2525759b3d2Safresh1    my $command = shift;
2535759b3d2Safresh1    local $_ = shift;
2545759b3d2Safresh1    return '' if ($command eq 'X' || $command eq 'Z');
2555759b3d2Safresh1
2565759b3d2Safresh1    # Expand escapes into the actual character now, carping if invalid.
2575759b3d2Safresh1    if ($command eq 'E') {
2585759b3d2Safresh1        return $ESCAPES{$_} if defined $ESCAPES{$_};
2595759b3d2Safresh1        carp "Unknown escape: E<$_>";
2605759b3d2Safresh1        return "E<$_>";
2615759b3d2Safresh1    }
2625759b3d2Safresh1
2635759b3d2Safresh1    # For all the other sequences, empty content produces no output.
2645759b3d2Safresh1    return if $_ eq '';
2655759b3d2Safresh1
2665759b3d2Safresh1    # For S<>, compress all internal whitespace and then map spaces to \01.
2675759b3d2Safresh1    # When we output the text, we'll map this back.
2685759b3d2Safresh1    if ($command eq 'S') {
2695759b3d2Safresh1        s/\s{2,}/ /g;
2705759b3d2Safresh1        tr/ /\01/;
2715759b3d2Safresh1        return $_;
2725759b3d2Safresh1    }
2735759b3d2Safresh1
2745759b3d2Safresh1    # Anything else needs to get dispatched to another method.
2755759b3d2Safresh1    if    ($command eq 'B') { return $self->seq_b ($_) }
2765759b3d2Safresh1    elsif ($command eq 'C') { return $self->seq_c ($_) }
2775759b3d2Safresh1    elsif ($command eq 'F') { return $self->seq_f ($_) }
2785759b3d2Safresh1    elsif ($command eq 'I') { return $self->seq_i ($_) }
2795759b3d2Safresh1    elsif ($command eq 'L') { return $self->seq_l ($_) }
2805759b3d2Safresh1    else { carp "Unknown sequence $command<$_>" }
2815759b3d2Safresh1}
2825759b3d2Safresh1
2835759b3d2Safresh1# Called for each paragraph that's actually part of the POD.  We take
2845759b3d2Safresh1# advantage of this opportunity to untabify the input.
2855759b3d2Safresh1sub preprocess_paragraph {
2865759b3d2Safresh1    my $self = shift;
2875759b3d2Safresh1    local $_ = shift;
2885759b3d2Safresh1    1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
2895759b3d2Safresh1    return $_;
2905759b3d2Safresh1}
2915759b3d2Safresh1
2925759b3d2Safresh1
2935759b3d2Safresh1############################################################################
2945759b3d2Safresh1# Command paragraphs
2955759b3d2Safresh1############################################################################
2965759b3d2Safresh1
2975759b3d2Safresh1# All command paragraphs take the paragraph and the line number.
2985759b3d2Safresh1
2995759b3d2Safresh1# First level heading.
3005759b3d2Safresh1sub cmd_head1 {
3015759b3d2Safresh1    my $self = shift;
3025759b3d2Safresh1    local $_ = shift;
3035759b3d2Safresh1    s/\s+$//s;
3045759b3d2Safresh1    $_ = $self->interpolate ($_, shift);
3055759b3d2Safresh1    if ($$self{alt}) {
3065759b3d2Safresh1        $self->output ("\n==== $_ ====\n\n");
3075759b3d2Safresh1    } else {
3085759b3d2Safresh1        $_ .= "\n" if $$self{loose};
3095759b3d2Safresh1        $self->output ($_ . "\n");
3105759b3d2Safresh1    }
3115759b3d2Safresh1}
3125759b3d2Safresh1
3135759b3d2Safresh1# Second level heading.
3145759b3d2Safresh1sub cmd_head2 {
3155759b3d2Safresh1    my $self = shift;
3165759b3d2Safresh1    local $_ = shift;
3175759b3d2Safresh1    s/\s+$//s;
3185759b3d2Safresh1    $_ = $self->interpolate ($_, shift);
3195759b3d2Safresh1    if ($$self{alt}) {
3205759b3d2Safresh1        $self->output ("\n==   $_   ==\n\n");
3215759b3d2Safresh1    } else {
3225759b3d2Safresh1        $_ .= "\n" if $$self{loose};
3235759b3d2Safresh1        $self->output (' ' x ($$self{indent} / 2) . $_ . "\n");
3245759b3d2Safresh1    }
3255759b3d2Safresh1}
3265759b3d2Safresh1
3275759b3d2Safresh1# third level heading - not strictly perlpodspec compliant
3285759b3d2Safresh1sub cmd_head3 {
3295759b3d2Safresh1    my $self = shift;
3305759b3d2Safresh1    local $_ = shift;
3315759b3d2Safresh1    s/\s+$//s;
3325759b3d2Safresh1    $_ = $self->interpolate ($_, shift);
3335759b3d2Safresh1    if ($$self{alt}) {
3345759b3d2Safresh1        $self->output ("\n= $_ =\n");
3355759b3d2Safresh1    } else {
3365759b3d2Safresh1        $_ .= "\n" if $$self{loose};
3375759b3d2Safresh1        $self->output (' ' x ($$self{indent}) . $_ . "\n");
3385759b3d2Safresh1    }
3395759b3d2Safresh1}
3405759b3d2Safresh1
3415759b3d2Safresh1# fourth level heading - not strictly perlpodspec compliant
3425759b3d2Safresh1# just like head3
3435759b3d2Safresh1*cmd_head4 = \&cmd_head3;
3445759b3d2Safresh1
3455759b3d2Safresh1# Start a list.
3465759b3d2Safresh1sub cmd_over {
3475759b3d2Safresh1    my $self = shift;
3485759b3d2Safresh1    local $_ = shift;
3495759b3d2Safresh1    unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
3505759b3d2Safresh1    push (@{ $$self{INDENTS} }, $$self{MARGIN});
3515759b3d2Safresh1    $$self{MARGIN} += ($_ + 0);
3525759b3d2Safresh1}
3535759b3d2Safresh1
3545759b3d2Safresh1# End a list.
3555759b3d2Safresh1sub cmd_back {
3565759b3d2Safresh1    my $self = shift;
3575759b3d2Safresh1    $$self{MARGIN} = pop @{ $$self{INDENTS} };
3585759b3d2Safresh1    unless (defined $$self{MARGIN}) {
3595759b3d2Safresh1        carp 'Unmatched =back';
3605759b3d2Safresh1        $$self{MARGIN} = $$self{indent};
3615759b3d2Safresh1    }
3625759b3d2Safresh1}
3635759b3d2Safresh1
3645759b3d2Safresh1# An individual list item.
3655759b3d2Safresh1sub cmd_item {
3665759b3d2Safresh1    my $self = shift;
3675759b3d2Safresh1    if (defined $$self{ITEM}) { $self->item }
3685759b3d2Safresh1    local $_ = shift;
3695759b3d2Safresh1    s/\s+$//s;
3705759b3d2Safresh1    $$self{ITEM} = $self->interpolate ($_);
3715759b3d2Safresh1}
3725759b3d2Safresh1
3735759b3d2Safresh1# Begin a block for a particular translator.  Setting VERBATIM triggers
3745759b3d2Safresh1# special handling in textblock().
3755759b3d2Safresh1sub cmd_begin {
3765759b3d2Safresh1    my $self = shift;
3775759b3d2Safresh1    local $_ = shift;
3785759b3d2Safresh1    my ($kind) = /^(\S+)/ or return;
3795759b3d2Safresh1    if ($kind eq 'text') {
3805759b3d2Safresh1        $$self{VERBATIM} = 1;
3815759b3d2Safresh1    } else {
3825759b3d2Safresh1        $$self{EXCLUDE} = 1;
3835759b3d2Safresh1    }
3845759b3d2Safresh1}
3855759b3d2Safresh1
3865759b3d2Safresh1# End a block for a particular translator.  We assume that all =begin/=end
3875759b3d2Safresh1# pairs are properly closed.
3885759b3d2Safresh1sub cmd_end {
3895759b3d2Safresh1    my $self = shift;
3905759b3d2Safresh1    $$self{EXCLUDE} = 0;
3915759b3d2Safresh1    $$self{VERBATIM} = 0;
3925759b3d2Safresh1}
3935759b3d2Safresh1
3945759b3d2Safresh1# One paragraph for a particular translator.  Ignore it unless it's intended
3955759b3d2Safresh1# for text, in which case we treat it as a verbatim text block.
3965759b3d2Safresh1sub cmd_for {
3975759b3d2Safresh1    my $self = shift;
3985759b3d2Safresh1    local $_ = shift;
3995759b3d2Safresh1    my $line = shift;
4005759b3d2Safresh1    return unless s/^text\b[ \t]*\r?\n?//;
4015759b3d2Safresh1    $self->verbatim ($_, $line);
4025759b3d2Safresh1}
4035759b3d2Safresh1
4045759b3d2Safresh1# just a dummy method for the time being
4055759b3d2Safresh1sub cmd_encoding {
4065759b3d2Safresh1  return;
4075759b3d2Safresh1}
4085759b3d2Safresh1
4095759b3d2Safresh1############################################################################
4105759b3d2Safresh1# Interior sequences
4115759b3d2Safresh1############################################################################
4125759b3d2Safresh1
4135759b3d2Safresh1# The simple formatting ones.  These are here mostly so that subclasses can
4145759b3d2Safresh1# override them and do more complicated things.
4155759b3d2Safresh1sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }
4165759b3d2Safresh1sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" }
4175759b3d2Safresh1sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
4185759b3d2Safresh1sub seq_i { return '*' . $_[1] . '*' }
4195759b3d2Safresh1
4205759b3d2Safresh1# The complicated one.  Handle links.  Since this is plain text, we can't
4215759b3d2Safresh1# actually make any real links, so this is all to figure out what text we
4225759b3d2Safresh1# print out.
4235759b3d2Safresh1sub seq_l {
4245759b3d2Safresh1    my $self = shift;
4255759b3d2Safresh1    local $_ = shift;
4265759b3d2Safresh1
4275759b3d2Safresh1    # Smash whitespace in case we were split across multiple lines.
4285759b3d2Safresh1    s/\s+/ /g;
4295759b3d2Safresh1
4305759b3d2Safresh1    # If we were given any explicit text, just output it.
4315759b3d2Safresh1    if (/^([^|]+)\|/) { return $1 }
4325759b3d2Safresh1
4335759b3d2Safresh1    # Okay, leading and trailing whitespace isn't important; get rid of it.
4345759b3d2Safresh1    s/^\s+//;
4355759b3d2Safresh1    s/\s+$//;
4365759b3d2Safresh1
4375759b3d2Safresh1    # Default to using the whole content of the link entry as a section
4385759b3d2Safresh1    # name.  Note that L<manpage/> forces a manpage interpretation, as does
4395759b3d2Safresh1    # something looking like L<manpage(section)>.  The latter is an
4405759b3d2Safresh1    # enhancement over the original Pod::Text.
4415759b3d2Safresh1    my ($manpage, $section) = ('', $_);
4425759b3d2Safresh1    if (/^(?:https?|ftp|news):/) {
4435759b3d2Safresh1        # a URL
4445759b3d2Safresh1        return $_;
4455759b3d2Safresh1    } elsif (/^"\s*(.*?)\s*"$/) {
4465759b3d2Safresh1        $section = '"' . $1 . '"';
4475759b3d2Safresh1    } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
4485759b3d2Safresh1        ($manpage, $section) = ($_, '');
4495759b3d2Safresh1    } elsif (m{/}) {
4505759b3d2Safresh1        ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
4515759b3d2Safresh1    }
4525759b3d2Safresh1
4535759b3d2Safresh1    my $text = '';
4545759b3d2Safresh1    # Now build the actual output text.
4555759b3d2Safresh1    if (!length $section) {
4565759b3d2Safresh1        $text = "the $manpage manpage" if length $manpage;
4575759b3d2Safresh1    } elsif ($section =~ /^[:\w]+(?:\(\))?/) {
4585759b3d2Safresh1        $text .= 'the ' . $section . ' entry';
4595759b3d2Safresh1        $text .= (length $manpage) ? " in the $manpage manpage"
4605759b3d2Safresh1                                   : ' elsewhere in this document';
4615759b3d2Safresh1    } else {
4625759b3d2Safresh1        $section =~ s/^\"\s*//;
4635759b3d2Safresh1        $section =~ s/\s*\"$//;
4645759b3d2Safresh1        $text .= 'the section on "' . $section . '"';
4655759b3d2Safresh1        $text .= " in the $manpage manpage" if length $manpage;
4665759b3d2Safresh1    }
4675759b3d2Safresh1    return $text;
4685759b3d2Safresh1}
4695759b3d2Safresh1
4705759b3d2Safresh1
4715759b3d2Safresh1############################################################################
4725759b3d2Safresh1# List handling
4735759b3d2Safresh1############################################################################
4745759b3d2Safresh1
4755759b3d2Safresh1# This method is called whenever an =item command is complete (in other
4765759b3d2Safresh1# words, we've seen its associated paragraph or know for certain that it
4775759b3d2Safresh1# doesn't have one).  It gets the paragraph associated with the item as an
4785759b3d2Safresh1# argument.  If that argument is empty, just output the item tag; if it
4795759b3d2Safresh1# contains a newline, output the item tag followed by the newline.
4805759b3d2Safresh1# Otherwise, see if there's enough room for us to output the item tag in the
4815759b3d2Safresh1# margin of the text or if we have to put it on a separate line.
4825759b3d2Safresh1sub item {
4835759b3d2Safresh1    my $self = shift;
4845759b3d2Safresh1    local $_ = shift;
4855759b3d2Safresh1    my $tag = $$self{ITEM};
4865759b3d2Safresh1    unless (defined $tag) {
4875759b3d2Safresh1        carp 'item called without tag';
4885759b3d2Safresh1        return;
4895759b3d2Safresh1    }
4905759b3d2Safresh1    undef $$self{ITEM};
4915759b3d2Safresh1    my $indent = $$self{INDENTS}[-1];
4925759b3d2Safresh1    unless (defined $indent) { $indent = $$self{indent} }
4935759b3d2Safresh1    my $space = ' ' x $indent;
4945759b3d2Safresh1    $space =~ s/^ /:/ if $$self{alt};
4955759b3d2Safresh1    if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
4965759b3d2Safresh1        my $margin = $$self{MARGIN};
4975759b3d2Safresh1        $$self{MARGIN} = $indent;
4985759b3d2Safresh1        my $output = $self->reformat ($tag);
4995759b3d2Safresh1        $output =~ s/[\r\n]*$/\n/;
5005759b3d2Safresh1        $self->output ($output);
5015759b3d2Safresh1        $$self{MARGIN} = $margin;
5025759b3d2Safresh1        $self->output ($self->reformat ($_)) if /\S/;
5035759b3d2Safresh1    } else {
5045759b3d2Safresh1        $_ = $self->reformat ($_);
5055759b3d2Safresh1        s/^ /:/ if ($$self{alt} && $indent > 0);
5065759b3d2Safresh1        my $tagspace = ' ' x length $tag;
5075759b3d2Safresh1        s/^($space)$tagspace/$1$tag/ or carp 'Bizarre space in item';
5085759b3d2Safresh1        $self->output ($_);
5095759b3d2Safresh1    }
5105759b3d2Safresh1}
5115759b3d2Safresh1
5125759b3d2Safresh1
5135759b3d2Safresh1############################################################################
5145759b3d2Safresh1# Output formatting
5155759b3d2Safresh1############################################################################
5165759b3d2Safresh1
5175759b3d2Safresh1# Wrap a line, indenting by the current left margin.  We can't use
5185759b3d2Safresh1# Text::Wrap because it plays games with tabs.  We can't use formline, even
5195759b3d2Safresh1# though we'd really like to, because it screws up non-printing characters.
5205759b3d2Safresh1# So we have to do the wrapping ourselves.
5215759b3d2Safresh1sub wrap {
5225759b3d2Safresh1    my $self = shift;
5235759b3d2Safresh1    local $_ = shift;
5245759b3d2Safresh1    my $output = '';
5255759b3d2Safresh1    my $spaces = ' ' x $$self{MARGIN};
5265759b3d2Safresh1    my $width = $$self{width} - $$self{MARGIN};
5275759b3d2Safresh1    while (length > $width) {
5285759b3d2Safresh1        if (s/^([^\r\n]{0,$width})\s+// || s/^([^\r\n]{$width})//) {
5295759b3d2Safresh1            $output .= $spaces . $1 . "\n";
5305759b3d2Safresh1        } else {
5315759b3d2Safresh1            last;
5325759b3d2Safresh1        }
5335759b3d2Safresh1    }
5345759b3d2Safresh1    $output .= $spaces . $_;
5355759b3d2Safresh1    $output =~ s/\s+$/\n\n/;
5365759b3d2Safresh1    return $output;
5375759b3d2Safresh1}
5385759b3d2Safresh1
5395759b3d2Safresh1# Reformat a paragraph of text for the current margin.  Takes the text to
5405759b3d2Safresh1# reformat and returns the formatted text.
5415759b3d2Safresh1sub reformat {
5425759b3d2Safresh1    my $self = shift;
5435759b3d2Safresh1    local $_ = shift;
5445759b3d2Safresh1
5455759b3d2Safresh1    # If we're trying to preserve two spaces after sentences, do some
5465759b3d2Safresh1    # munging to support that.  Otherwise, smash all repeated whitespace.
5475759b3d2Safresh1    if ($$self{sentence}) {
5485759b3d2Safresh1        s/ +$//mg;
5495759b3d2Safresh1        s/\.\r?\n/. \n/g;
5505759b3d2Safresh1        s/[\r\n]+/ /g;
5515759b3d2Safresh1        s/   +/  /g;
5525759b3d2Safresh1    } else {
5535759b3d2Safresh1        s/\s+/ /g;
5545759b3d2Safresh1    }
5555759b3d2Safresh1    return $self->wrap($_);
5565759b3d2Safresh1}
5575759b3d2Safresh1
5585759b3d2Safresh1# Output text to the output device.
5595759b3d2Safresh1sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }
5605759b3d2Safresh1
5615759b3d2Safresh1
5625759b3d2Safresh1############################################################################
5635759b3d2Safresh1# Backwards compatibility
5645759b3d2Safresh1############################################################################
5655759b3d2Safresh1
5665759b3d2Safresh1# The old Pod::Text module did everything in a pod2text() function.  This
5675759b3d2Safresh1# tries to provide the same interface for legacy applications.
5685759b3d2Safresh1sub pod2text {
5695759b3d2Safresh1    my @args;
5705759b3d2Safresh1
5715759b3d2Safresh1    # This is really ugly; I hate doing option parsing in the middle of a
5725759b3d2Safresh1    # module.  But the old Pod::Text module supported passing flags to its
5735759b3d2Safresh1    # entry function, so handle -a and -<number>.
5745759b3d2Safresh1    while ($_[0] =~ /^-/) {
5755759b3d2Safresh1        my $flag = shift;
5765759b3d2Safresh1        if    ($flag eq '-a')       { push (@args, alt => 1)    }
5775759b3d2Safresh1        elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }
5785759b3d2Safresh1        else {
5795759b3d2Safresh1            unshift (@_, $flag);
5805759b3d2Safresh1            last;
5815759b3d2Safresh1        }
5825759b3d2Safresh1    }
5835759b3d2Safresh1
5845759b3d2Safresh1    # Now that we know what arguments we're using, create the parser.
5855759b3d2Safresh1    my $parser = Pod::PlainText->new (@args);
5865759b3d2Safresh1
5875759b3d2Safresh1    # If two arguments were given, the second argument is going to be a file
5885759b3d2Safresh1    # handle.  That means we want to call parse_from_filehandle(), which
5895759b3d2Safresh1    # means we need to turn the first argument into a file handle.  Magic
5905759b3d2Safresh1    # open will handle the <&STDIN case automagically.
5915759b3d2Safresh1    if (defined $_[1]) {
5925759b3d2Safresh1        my $infh;
5935759b3d2Safresh1        if ($] < 5.006) {
5945759b3d2Safresh1          $infh = gensym();
5955759b3d2Safresh1        }
5965759b3d2Safresh1        unless (open ($infh, $_[0])) {
5975759b3d2Safresh1            croak ("Can't open $_[0] for reading: $!\n");
5985759b3d2Safresh1        }
5995759b3d2Safresh1        $_[0] = $infh;
6005759b3d2Safresh1        return $parser->parse_from_filehandle (@_);
6015759b3d2Safresh1    } else {
6025759b3d2Safresh1        return $parser->parse_from_file (@_);
6035759b3d2Safresh1    }
6045759b3d2Safresh1}
6055759b3d2Safresh1
6065759b3d2Safresh1
6075759b3d2Safresh1############################################################################
6085759b3d2Safresh1# Module return value and documentation
6095759b3d2Safresh1############################################################################
6105759b3d2Safresh1
6115759b3d2Safresh11;
6125759b3d2Safresh1__END__
6135759b3d2Safresh1
6145759b3d2Safresh1=head1 NAME
6155759b3d2Safresh1
6165759b3d2Safresh1Pod::PlainText - Convert POD data to formatted ASCII text
6175759b3d2Safresh1
6185759b3d2Safresh1=head1 SYNOPSIS
6195759b3d2Safresh1
6205759b3d2Safresh1    use Pod::PlainText;
6215759b3d2Safresh1    my $parser = Pod::PlainText->new (sentence => 0, width => 78);
6225759b3d2Safresh1
6235759b3d2Safresh1    # Read POD from STDIN and write to STDOUT.
6245759b3d2Safresh1    $parser->parse_from_filehandle;
6255759b3d2Safresh1
6265759b3d2Safresh1    # Read POD from file.pod and write to file.txt.
6275759b3d2Safresh1    $parser->parse_from_file ('file.pod', 'file.txt');
6285759b3d2Safresh1
6295759b3d2Safresh1=head1 DESCRIPTION
6305759b3d2Safresh1
6315759b3d2Safresh1Pod::PlainText is a module that can convert documentation in the POD format (the
6325759b3d2Safresh1preferred language for documenting Perl) into formatted ASCII.  It uses no
6335759b3d2Safresh1special formatting controls or codes whatsoever, and its output is therefore
6345759b3d2Safresh1suitable for nearly any device.
6355759b3d2Safresh1
6365759b3d2Safresh1As a derived class from Pod::Parser, Pod::PlainText supports the same methods and
6375759b3d2Safresh1interfaces.  See L<Pod::Parser> for all the details; briefly, one creates a
6385759b3d2Safresh1new parser with C<Pod::PlainText-E<gt>new()> and then calls either
6395759b3d2Safresh1parse_from_filehandle() or parse_from_file().
6405759b3d2Safresh1
6415759b3d2Safresh1new() can take options, in the form of key/value pairs, that control the
6425759b3d2Safresh1behavior of the parser.  The currently recognized options are:
6435759b3d2Safresh1
6445759b3d2Safresh1=over 4
6455759b3d2Safresh1
6465759b3d2Safresh1=item alt
6475759b3d2Safresh1
6485759b3d2Safresh1If set to a true value, selects an alternate output format that, among other
6495759b3d2Safresh1things, uses a different heading style and marks C<=item> entries with a
6505759b3d2Safresh1colon in the left margin.  Defaults to false.
6515759b3d2Safresh1
6525759b3d2Safresh1=item indent
6535759b3d2Safresh1
6545759b3d2Safresh1The number of spaces to indent regular text, and the default indentation for
6555759b3d2Safresh1C<=over> blocks.  Defaults to 4.
6565759b3d2Safresh1
6575759b3d2Safresh1=item loose
6585759b3d2Safresh1
6595759b3d2Safresh1If set to a true value, a blank line is printed after a C<=headN> headings.
6605759b3d2Safresh1If set to false (the default), no blank line is printed after C<=headN>.
6615759b3d2Safresh1This is the default because it's the expected formatting for manual pages;
6625759b3d2Safresh1if you're formatting arbitrary text documents, setting this to true may
6635759b3d2Safresh1result in more pleasing output.
6645759b3d2Safresh1
6655759b3d2Safresh1=item sentence
6665759b3d2Safresh1
6675759b3d2Safresh1If set to a true value, Pod::PlainText will assume that each sentence ends in two
6685759b3d2Safresh1spaces, and will try to preserve that spacing.  If set to false, all
6695759b3d2Safresh1consecutive whitespace in non-verbatim paragraphs is compressed into a
6705759b3d2Safresh1single space.  Defaults to true.
6715759b3d2Safresh1
6725759b3d2Safresh1=item width
6735759b3d2Safresh1
6745759b3d2Safresh1The column at which to wrap text on the right-hand side.  Defaults to 76.
6755759b3d2Safresh1
6765759b3d2Safresh1=back
6775759b3d2Safresh1
6785759b3d2Safresh1The standard Pod::Parser method parse_from_filehandle() takes up to two
6795759b3d2Safresh1arguments, the first being the file handle to read POD from and the second
6805759b3d2Safresh1being the file handle to write the formatted output to.  The first defaults
6815759b3d2Safresh1to STDIN if not given, and the second defaults to STDOUT.  The method
6825759b3d2Safresh1parse_from_file() is almost identical, except that its two arguments are the
6835759b3d2Safresh1input and output disk files instead.  See L<Pod::Parser> for the specific
6845759b3d2Safresh1details.
6855759b3d2Safresh1
6865759b3d2Safresh1=head1 DIAGNOSTICS
6875759b3d2Safresh1
6885759b3d2Safresh1=over 4
6895759b3d2Safresh1
6905759b3d2Safresh1=item Bizarre space in item
6915759b3d2Safresh1
6925759b3d2Safresh1(W) Something has gone wrong in internal C<=item> processing.  This message
6935759b3d2Safresh1indicates a bug in Pod::PlainText; you should never see it.
6945759b3d2Safresh1
6955759b3d2Safresh1=item Can't open %s for reading: %s
6965759b3d2Safresh1
6975759b3d2Safresh1(F) Pod::PlainText was invoked via the compatibility mode pod2text() interface
6985759b3d2Safresh1and the input file it was given could not be opened.
6995759b3d2Safresh1
7005759b3d2Safresh1=item Unknown escape: %s
7015759b3d2Safresh1
7025759b3d2Safresh1(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::PlainText didn't
7035759b3d2Safresh1know about.
7045759b3d2Safresh1
7055759b3d2Safresh1=item Unknown sequence: %s
7065759b3d2Safresh1
7075759b3d2Safresh1(W) The POD source contained a non-standard internal sequence (something of
7085759b3d2Safresh1the form C<XE<lt>E<gt>>) that Pod::PlainText didn't know about.
7095759b3d2Safresh1
7105759b3d2Safresh1=item Unmatched =back
7115759b3d2Safresh1
7125759b3d2Safresh1(W) Pod::PlainText encountered a C<=back> command that didn't correspond to an
7135759b3d2Safresh1C<=over> command.
7145759b3d2Safresh1
7155759b3d2Safresh1=back
7165759b3d2Safresh1
7175759b3d2Safresh1=head1 RESTRICTIONS
7185759b3d2Safresh1
7195759b3d2Safresh1Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on
7205759b3d2Safresh1output, due to an internal implementation detail.
7215759b3d2Safresh1
7225759b3d2Safresh1=head1 NOTES
7235759b3d2Safresh1
7245759b3d2Safresh1This is a replacement for an earlier Pod::Text module written by Tom
7255759b3d2Safresh1Christiansen.  It has a revamped interface, since it now uses Pod::Parser,
7265759b3d2Safresh1but an interface roughly compatible with the old Pod::Text::pod2text()
7275759b3d2Safresh1function is still available.  Please change to the new calling convention,
7285759b3d2Safresh1though.
7295759b3d2Safresh1
7305759b3d2Safresh1The original Pod::Text contained code to do formatting via termcap
7315759b3d2Safresh1sequences, although it wasn't turned on by default and it was problematic to
7325759b3d2Safresh1get it to work at all.  This rewrite doesn't even try to do that, but a
7335759b3d2Safresh1subclass of it does.  Look for L<Pod::Text::Termcap|Pod::Text::Termcap>.
7345759b3d2Safresh1
7355759b3d2Safresh1=head1 SEE ALSO
7365759b3d2Safresh1
7375759b3d2Safresh1B<Pod::PlainText> is part of the L<Pod::Parser> distribution.
7385759b3d2Safresh1
7395759b3d2Safresh1L<Pod::Parser|Pod::Parser>, L<Pod::Text::Termcap|Pod::Text::Termcap>,
7405759b3d2Safresh1pod2text(1)
7415759b3d2Safresh1
7425759b3d2Safresh1=head1 AUTHOR
7435759b3d2Safresh1
7445759b3d2Safresh1Please report bugs using L<http://rt.cpan.org>.
7455759b3d2Safresh1
7465759b3d2Safresh1Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the
7475759b3d2Safresh1original Pod::Text by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> and
7485759b3d2Safresh1its conversion to Pod::Parser by Brad Appleton
7495759b3d2Safresh1E<lt>bradapp@enteract.comE<gt>.
7505759b3d2Safresh1
7515759b3d2Safresh1=cut
752