home *** CD-ROM | disk | FTP | other *** search
/ Chip: Windows 2000 Professional Resource Kit / W2KPRK.iso / apps / perl / ActivePerl.exe / data.z / Text.pm < prev    next >
Encoding:
Perl POD Document  |  1999-10-14  |  13.8 KB  |  552 lines
  1. package Pod::Text;
  2.  
  3. =head1 NAME
  4.  
  5. Pod::Text - convert POD data to formatted ASCII text
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     use Pod::Text;
  10.  
  11.     pod2text("perlfunc.pod");
  12.  
  13. Also:
  14.  
  15.     pod2text [B<-a>] [B<->I<width>] < input.pod
  16.  
  17. =head1 DESCRIPTION
  18.  
  19. Pod::Text is a module that can convert documentation in the POD format (such
  20. as can be found throughout the Perl distribution) into formatted ASCII.
  21. Termcap is optionally supported for boldface/underline, and can enabled via
  22. C<$Pod::Text::termcap=1>. If termcap has not been enabled, then backspaces
  23. will be used to simulate bold and underlined text.
  24.  
  25. A separate F<pod2text> program is included that is primarily a wrapper for
  26. Pod::Text.
  27.  
  28. The single function C<pod2text()> can take the optional options B<-a>
  29. for an alternative output format, then a B<->I<width> option with the
  30. max terminal width, followed by one or two arguments. The first
  31. should be the name of a file to read the pod from, or "E<lt>&STDIN" to read from
  32. STDIN. A second argument, if provided, should be a filehandle glob where
  33. output should be sent.
  34.  
  35. =head1 AUTHOR
  36.  
  37. Tom Christiansen E<lt>F<tchrist@mox.perl.com>E<gt>
  38.  
  39. =head1 TODO
  40.  
  41. Cleanup work. The input and output locations need to be more flexible,
  42. termcap shouldn't be a global variable, and the terminal speed needs to
  43. be properly calculated.
  44.  
  45. =cut
  46.  
  47. use Term::Cap;
  48. require Exporter;
  49. @ISA = Exporter;
  50. @EXPORT = qw(pod2text);
  51.  
  52. use vars qw($VERSION);
  53. $VERSION = "1.0203";
  54.  
  55. use locale;    # make \w work right in non-ASCII lands
  56.  
  57. $termcap=0;
  58.  
  59. $opt_alt_format = 0;
  60.  
  61. #$use_format=1;
  62.  
  63. $UNDL = "\x1b[4m";
  64. $INV = "\x1b[7m";
  65. $BOLD = "\x1b[1m";
  66. $NORM = "\x1b[0m";
  67.  
  68. sub pod2text {
  69. shift if $opt_alt_format = ($_[0] eq '-a');
  70.  
  71. if($termcap and !$setuptermcap) {
  72.     $setuptermcap=1;
  73.  
  74.     my($term) = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 };
  75.     $UNDL = $term->{'_us'};
  76.     $INV = $term->{'_mr'};
  77.     $BOLD = $term->{'_md'};
  78.     $NORM = $term->{'_me'};
  79. }
  80.  
  81. $SCREEN = ($_[0] =~ /^-(\d+)/ && (shift, $1))
  82.        ||  $ENV{COLUMNS}
  83.        || ($ENV{TERMCAP} =~ /co#(\d+)/)[0]
  84.        || ($^O ne 'MSWin32' && $^O ne 'dos' && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0])
  85.        || 72;
  86.  
  87. @_ = ("<&STDIN") unless @_;
  88. local($file,*OUTPUT) = @_;
  89. *OUTPUT = *STDOUT if @_<2;
  90.  
  91. local $: = $:;
  92. $: = " \n" if $opt_alt_format;    # Do not break ``-L/lib/'' into ``- L/lib/''.
  93.  
  94. $/ = "";
  95.  
  96. $FANCY = 0;
  97.  
  98. $cutting = 1;
  99. $DEF_INDENT = 4;
  100. $indent = $DEF_INDENT;
  101. $needspace = 0;
  102. $begun = "";
  103.  
  104. open(IN, $file) || die "Couldn't open $file: $!";
  105.  
  106. POD_DIRECTIVE: while (<IN>) {
  107.     if ($cutting) {
  108.     next unless /^=/;
  109.     $cutting = 0;
  110.     }
  111.     if ($begun) {
  112.         if (/^=end\s+$begun/) {
  113.              $begun = "";
  114.         }
  115.         elsif ($begun eq "text") {
  116.             print OUTPUT $_;
  117.         }
  118.         next;
  119.     }
  120.     1 while s{^(.*?)(\t+)(.*)$}{
  121.     $1
  122.     . (' ' x (length($2) * 8 - length($1) % 8))
  123.     . $3
  124.     }me;
  125.     # Translate verbatim paragraph
  126.     if (/^\s/) {
  127.     output($_);
  128.     next;
  129.     }
  130.  
  131.     if (/^=for\s+(\S+)\s*(.*)/s) {
  132.         if ($1 eq "text") {
  133.             print OUTPUT $2,"";
  134.         } else {
  135.             # ignore unknown for
  136.         }
  137.         next;
  138.     }
  139.     elsif (/^=begin\s+(\S+)\s*(.*)/s) {
  140.         $begun = $1;
  141.         if ($1 eq "text") {
  142.             print OUTPUT $2."";
  143.         }
  144.         next;
  145.     }
  146.  
  147. sub prepare_for_output {
  148.  
  149.     s/\s*$/\n/;
  150.     &init_noremap;
  151.  
  152.     # need to hide E<> first; they're processed in clear_noremap
  153.     s/(E<[^<>]+>)/noremap($1)/ge;
  154.     $maxnest = 10;
  155.     while ($maxnest-- && /[A-Z]</) {
  156.     unless ($FANCY) {
  157.         if ($opt_alt_format) {
  158.         s/[BC]<(.*?)>/``$1''/sg;
  159.         s/F<(.*?)>/"$1"/sg;
  160.         } else {
  161.         s/C<(.*?)>/`$1'/sg;
  162.         }
  163.     } else {
  164.         s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/sge;
  165.     }
  166.         # s/[IF]<(.*?)>/italic($1)/ge;
  167.         s/I<(.*?)>/*$1*/sg;
  168.         # s/[CB]<(.*?)>/bold($1)/ge;
  169.     s/X<.*?>//sg;
  170.  
  171.     # LREF: a la HREF L<show this text|man/section>
  172.     s:L<([^|>]+)\|[^>]+>:$1:g;
  173.  
  174.     # LREF: a manpage(3f)
  175.     s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the $1$2 manpage:g;
  176.     # LREF: an =item on another manpage
  177.     s{
  178.         L<
  179.         ([^/]+)
  180.         /
  181.         (
  182.             [:\w]+
  183.             (\(\))?
  184.         )
  185.         >
  186.     } {the "$2" entry in the $1 manpage}gx;
  187.  
  188.     # LREF: an =item on this manpage
  189.     s{
  190.        ((?:
  191.         L<
  192.         /
  193.         (
  194.             [:\w]+
  195.             (\(\))?
  196.         )
  197.         >
  198.         (,?\s+(and\s+)?)?
  199.       )+)
  200.     } { internal_lrefs($1) }gex;
  201.  
  202.     # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
  203.     # the "func" can disambiguate
  204.     s{
  205.         L<
  206.         (?:
  207.             ([a-zA-Z]\S+?) / 
  208.         )?
  209.         "?(.*?)"?
  210.         >
  211.     }{
  212.         do {
  213.         $1     # if no $1, assume it means on this page.
  214.             ?  "the section on \"$2\" in the $1 manpage"
  215.             :  "the section on \"$2\""
  216.         }
  217.     }sgex;
  218.  
  219.         s/[A-Z]<(.*?)>/$1/sg;
  220.     }
  221.     clear_noremap(1);
  222. }
  223.  
  224.     &prepare_for_output;
  225.  
  226.     if (s/^=//) {
  227.     # $needspace = 0;        # Assume this.
  228.     # s/\n/ /g;
  229.     ($Cmd, $_) = split(' ', $_, 2);
  230.     # clear_noremap(1);
  231.     if ($Cmd eq 'cut') {
  232.         $cutting = 1;
  233.     }
  234.     elsif ($Cmd eq 'pod') {
  235.         $cutting = 0;
  236.     }
  237.     elsif ($Cmd eq 'head1') {
  238.         makespace();
  239.         if ($opt_alt_format) {
  240.         print OUTPUT "\n";
  241.         s/^(.+?)[ \t]*$/==== $1 ====/;
  242.         }
  243.         print OUTPUT;
  244.         # print OUTPUT uc($_);
  245.         $needspace = $opt_alt_format;
  246.     }
  247.     elsif ($Cmd eq 'head2') {
  248.         makespace();
  249.         # s/(\w+)/\u\L$1/g;
  250.         #print ' ' x $DEF_INDENT, $_;
  251.         # print "\xA7";
  252.         s/(\w)/\xA7 $1/ if $FANCY;
  253.         if ($opt_alt_format) {
  254.         s/^(.+?)[ \t]*$/==   $1   ==/;
  255.         print OUTPUT "\n", $_;
  256.         } else {
  257.         print OUTPUT ' ' x ($DEF_INDENT/2), $_, "\n";
  258.         }
  259.         $needspace = $opt_alt_format;
  260.     }
  261.     elsif ($Cmd eq 'over') {
  262.         push(@indent,$indent);
  263.         $indent += ($_ + 0) || $DEF_INDENT;
  264.     }
  265.     elsif ($Cmd eq 'back') {
  266.         $indent = pop(@indent);
  267.         warn "Unmatched =back\n" unless defined $indent;
  268.     }
  269.     elsif ($Cmd eq 'item') {
  270.         makespace();
  271.         # s/\A(\s*)\*/$1\xb7/ if $FANCY;
  272.         # s/^(\s*\*\s+)/$1 /;
  273.         {
  274.         if (length() + 3 < $indent) {
  275.             my $paratag = $_;
  276.             $_ = <IN>;
  277.             if (/^=/) {  # tricked!
  278.             local($indent) = $indent[$#indent - 1] || $DEF_INDENT;
  279.             output($paratag);
  280.             redo POD_DIRECTIVE;
  281.             }
  282.             &prepare_for_output;
  283.             IP_output($paratag, $_);
  284.         } else {
  285.             local($indent) = $indent[$#indent - 1] || $DEF_INDENT;
  286.             output($_, 0);
  287.         }
  288.         }
  289.     }
  290.     else {
  291.         warn "Unrecognized directive: $Cmd\n";
  292.     }
  293.     }
  294.     else {
  295.     # clear_noremap(1);
  296.     makespace();
  297.     output($_, 1);
  298.     }
  299. }
  300.  
  301. close(IN);
  302.  
  303. }
  304.  
  305. #########################################################################
  306.  
  307. sub makespace {
  308.     if ($needspace) {
  309.     print OUTPUT "\n";
  310.     $needspace = 0;
  311.     }
  312. }
  313.  
  314. sub bold {
  315.     my $line = shift;
  316.     return $line if $use_format;
  317.     if($termcap) {
  318.         $line = "$BOLD$line$NORM";
  319.     } else {
  320.         $line =~ s/(.)/$1\b$1/g;
  321.     }
  322. #    $line = "$BOLD$line$NORM" if $ansify;
  323.     return $line;
  324. }
  325.  
  326. sub italic {
  327.     my $line = shift;
  328.     return $line if $use_format;
  329.     if($termcap) {
  330.         $line = "$UNDL$line$NORM";
  331.     } else {
  332.         $line =~ s/(.)/$1\b_/g;
  333.     }
  334. #    $line = "$UNDL$line$NORM" if $ansify;
  335.     return $line;
  336. }
  337.  
  338. # Fill a paragraph including underlined and overstricken chars.
  339. # It's not perfect for words longer than the margin, and it's probably
  340. # slow, but it works.
  341. sub fill {
  342.     local $_ = shift;
  343.     my $par = "";
  344.     my $indent_space = " " x $indent;
  345.     my $marg = $SCREEN-$indent;
  346.     my $line = $indent_space;
  347.     my $line_length;
  348.     foreach (split) {
  349.     my $word_length = length;
  350.     $word_length -= 2 while /\010/g;  # Subtract backspaces
  351.  
  352.     if ($line_length + $word_length > $marg) {
  353.         $par .= $line . "\n";
  354.         $line= $indent_space . $_;
  355.         $line_length = $word_length;
  356.     }
  357.     else {
  358.         if ($line_length) {
  359.         $line_length++;
  360.         $line .= " ";
  361.         }
  362.         $line_length += $word_length;
  363.         $line .= $_;
  364.     }
  365.     }
  366.     $par .= "$line\n" if $line;
  367.     $par .= "\n";
  368.     return $par;
  369. }
  370.  
  371. sub IP_output {
  372.     local($tag, $_) = @_;
  373.     local($tag_indent) = $indent[$#indent - 1] || $DEF_INDENT;
  374.     $tag_cols = $SCREEN - $tag_indent;
  375.     $cols = $SCREEN - $indent;
  376.     $tag =~ s/\s*$//;
  377.     s/\s+/ /g;
  378.     s/^ //;
  379.     $str = "format OUTPUT = \n"
  380.     . (($opt_alt_format && $tag_indent > 1)
  381.        ? ":" . " " x ($tag_indent - 1)
  382.        : " " x ($tag_indent))
  383.     . '@' . ('<' x ($indent - $tag_indent - 1))
  384.     . "^" .  ("<" x ($cols - 1)) . "\n"
  385.     . '$tag, $_'
  386.     . "\n~~"
  387.     . (" " x ($indent-2))
  388.     . "^" .  ("<" x ($cols - 5)) . "\n"
  389.     . '$_' . "\n\n.\n1";
  390.     #warn $str; warn "tag is $tag, _ is $_";
  391.     eval $str || die;
  392.     write OUTPUT;
  393. }
  394.  
  395. sub output {
  396.     local($_, $reformat) = @_;
  397.     if ($reformat) {
  398.     $cols = $SCREEN - $indent;
  399.     s/\s+/ /g;
  400.     s/^ //;
  401.     $str = "format OUTPUT = \n~~"
  402.         . (" " x ($indent-2))
  403.         . "^" .  ("<" x ($cols - 5)) . "\n"
  404.         . '$_' . "\n\n.\n1";
  405.     eval $str || die;
  406.     write OUTPUT;
  407.     } else {
  408.     s/^/' ' x $indent/gem;
  409.     s/^\s+\n$/\n/gm;
  410.     s/^  /: /s if defined($reformat) && $opt_alt_format;
  411.     print OUTPUT;
  412.     }
  413. }
  414.  
  415. sub noremap {
  416.     local($thing_to_hide) = shift;
  417.     $thing_to_hide =~ tr/\000-\177/\200-\377/;
  418.     return $thing_to_hide;
  419. }
  420.  
  421. sub init_noremap {
  422.     die "unmatched init" if $mapready++;
  423.     #mask off high bit characters in input stream
  424.     s/([\200-\377])/"E<".ord($1).">"/ge;
  425. }
  426.  
  427. sub clear_noremap {
  428.     my $ready_to_print = $_[0];
  429.     die "unmatched clear" unless $mapready--;
  430.     tr/\200-\377/\000-\177/;
  431.     # now for the E<>s, which have been hidden until now
  432.     # otherwise the interative \w<> processing would have
  433.     # been hosed by the E<gt>
  434.     s {
  435.         E<
  436.         (
  437.             ( \d+ )
  438.             | ( [A-Za-z]+ )
  439.         )
  440.         >    
  441.     } {
  442.      do {
  443.          defined $2
  444.          ? chr($2)
  445.          :
  446.          defined $HTML_Escapes{$3}
  447.         ? do { $HTML_Escapes{$3} }
  448.         : do {
  449.             warn "Unknown escape: E<$1> in $_";
  450.             "E<$1>";
  451.         }
  452.      }
  453.     }egx if $ready_to_print;
  454. }
  455.  
  456. sub internal_lrefs {
  457.     local($_) = shift;
  458.     s{L</([^>]+)>}{$1}g;
  459.     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
  460.     my $retstr = "the ";
  461.     my $i;
  462.     for ($i = 0; $i <= $#items; $i++) {
  463.     $retstr .= "C<$items[$i]>";
  464.     $retstr .= ", " if @items > 2 && $i != $#items;
  465.     $retstr .= " and " if $i+2 == @items;
  466.     }
  467.  
  468.     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
  469.         .  " elsewhere in this document ";
  470.  
  471.     return $retstr;
  472.  
  473. }
  474.  
  475. BEGIN {
  476.  
  477. %HTML_Escapes = (
  478.     'amp'    =>    '&',    #   ampersand
  479.     'lt'    =>    '<',    #   left chevron, less-than
  480.     'gt'    =>    '>',    #   right chevron, greater-than
  481.     'quot'    =>    '"',    #   double quote
  482.  
  483.     "Aacute"    =>    "\xC1",    #   capital A, acute accent
  484.     "aacute"    =>    "\xE1",    #   small a, acute accent
  485.     "Acirc"    =>    "\xC2",    #   capital A, circumflex accent
  486.     "acirc"    =>    "\xE2",    #   small a, circumflex accent
  487.     "AElig"    =>    "\xC6",    #   capital AE diphthong (ligature)
  488.     "aelig"    =>    "\xE6",    #   small ae diphthong (ligature)
  489.     "Agrave"    =>    "\xC0",    #   capital A, grave accent
  490.     "agrave"    =>    "\xE0",    #   small a, grave accent
  491.     "Aring"    =>    "\xC5",    #   capital A, ring
  492.     "aring"    =>    "\xE5",    #   small a, ring
  493.     "Atilde"    =>    "\xC3",    #   capital A, tilde
  494.     "atilde"    =>    "\xE3",    #   small a, tilde
  495.     "Auml"    =>    "\xC4",    #   capital A, dieresis or umlaut mark
  496.     "auml"    =>    "\xE4",    #   small a, dieresis or umlaut mark
  497.     "Ccedil"    =>    "\xC7",    #   capital C, cedilla
  498.     "ccedil"    =>    "\xE7",    #   small c, cedilla
  499.     "Eacute"    =>    "\xC9",    #   capital E, acute accent
  500.     "eacute"    =>    "\xE9",    #   small e, acute accent
  501.     "Ecirc"    =>    "\xCA",    #   capital E, circumflex accent
  502.     "ecirc"    =>    "\xEA",    #   small e, circumflex accent
  503.     "Egrave"    =>    "\xC8",    #   capital E, grave accent
  504.     "egrave"    =>    "\xE8",    #   small e, grave accent
  505.     "ETH"    =>    "\xD0",    #   capital Eth, Icelandic
  506.     "eth"    =>    "\xF0",    #   small eth, Icelandic
  507.     "Euml"    =>    "\xCB",    #   capital E, dieresis or umlaut mark
  508.     "euml"    =>    "\xEB",    #   small e, dieresis or umlaut mark
  509.     "Iacute"    =>    "\xCD",    #   capital I, acute accent
  510.     "iacute"    =>    "\xED",    #   small i, acute accent
  511.     "Icirc"    =>    "\xCE",    #   capital I, circumflex accent
  512.     "icirc"    =>    "\xEE",    #   small i, circumflex accent
  513.     "Igrave"    =>    "\xCD",    #   capital I, grave accent
  514.     "igrave"    =>    "\xED",    #   small i, grave accent
  515.     "Iuml"    =>    "\xCF",    #   capital I, dieresis or umlaut mark
  516.     "iuml"    =>    "\xEF",    #   small i, dieresis or umlaut mark
  517.     "Ntilde"    =>    "\xD1",        #   capital N, tilde
  518.     "ntilde"    =>    "\xF1",        #   small n, tilde
  519.     "Oacute"    =>    "\xD3",    #   capital O, acute accent
  520.     "oacute"    =>    "\xF3",    #   small o, acute accent
  521.     "Ocirc"    =>    "\xD4",    #   capital O, circumflex accent
  522.     "ocirc"    =>    "\xF4",    #   small o, circumflex accent
  523.     "Ograve"    =>    "\xD2",    #   capital O, grave accent
  524.     "ograve"    =>    "\xF2",    #   small o, grave accent
  525.     "Oslash"    =>    "\xD8",    #   capital O, slash
  526.     "oslash"    =>    "\xF8",    #   small o, slash
  527.     "Otilde"    =>    "\xD5",    #   capital O, tilde
  528.     "otilde"    =>    "\xF5",    #   small o, tilde
  529.     "Ouml"    =>    "\xD6",    #   capital O, dieresis or umlaut mark
  530.     "ouml"    =>    "\xF6",    #   small o, dieresis or umlaut mark
  531.     "szlig"    =>    "\xDF",        #   small sharp s, German (sz ligature)
  532.     "THORN"    =>    "\xDE",    #   capital THORN, Icelandic
  533.     "thorn"    =>    "\xFE",    #   small thorn, Icelandic
  534.     "Uacute"    =>    "\xDA",    #   capital U, acute accent
  535.     "uacute"    =>    "\xFA",    #   small u, acute accent
  536.     "Ucirc"    =>    "\xDB",    #   capital U, circumflex accent
  537.     "ucirc"    =>    "\xFB",    #   small u, circumflex accent
  538.     "Ugrave"    =>    "\xD9",    #   capital U, grave accent
  539.     "ugrave"    =>    "\xF9",    #   small u, grave accent
  540.     "Uuml"    =>    "\xDC",    #   capital U, dieresis or umlaut mark
  541.     "uuml"    =>    "\xFC",    #   small u, dieresis or umlaut mark
  542.     "Yacute"    =>    "\xDD",    #   capital Y, acute accent
  543.     "yacute"    =>    "\xFD",    #   small y, acute accent
  544.     "yuml"    =>    "\xFF",    #   small y, dieresis or umlaut mark
  545.  
  546.     "lchevron"    =>    "\xAB",    #   left chevron (double less than)
  547.     "rchevron"    =>    "\xBB",    #   right chevron (double greater than)
  548. );
  549. }
  550.  
  551. 1;
  552.