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