[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/pod/Text/ -> Overstrike.pm (source)

   1  # Pod::Text::Overstrike -- Convert POD data to formatted overstrike text
   2  # $Id: Overstrike.pm,v 2.0 2004/06/09 04:51:20 eagle Exp $
   3  #
   4  # Created by Joe Smith <Joe.Smith@inwap.com> 30-Nov-2000
   5  #   (based on Pod::Text::Color by Russ Allbery <rra@stanford.edu>)
   6  #
   7  # This program is free software; you may redistribute it and/or modify it
   8  # under the same terms as Perl itself.
   9  #
  10  # This was written because the output from:
  11  #
  12  #     pod2text Text.pm > plain.txt; less plain.txt
  13  #
  14  # is not as rich as the output from
  15  #
  16  #     pod2man Text.pm | nroff -man > fancy.txt; less fancy.txt
  17  #
  18  # and because both Pod::Text::Color and Pod::Text::Termcap are not device
  19  # independent.
  20  
  21  ##############################################################################
  22  # Modules and declarations
  23  ##############################################################################
  24  
  25  package Pod::Text::Overstrike;
  26  
  27  require 5.004;
  28  
  29  use Pod::Text ();
  30  
  31  use strict;
  32  use vars qw(@ISA $VERSION);
  33  
  34  @ISA = qw(Pod::Text);
  35  
  36  # Don't use the CVS revision as the version, since this module is also in Perl
  37  # core and too many things could munge CVS magic revision strings.  This
  38  # number should ideally be the same as the CVS revision in podlators, however.
  39  $VERSION = 2.00;
  40  
  41  ##############################################################################
  42  # Overrides
  43  ##############################################################################
  44  
  45  # Make level one headings bold, overridding any existing formatting.
  46  sub cmd_head1 {
  47      my ($self, $attrs, $text) = @_;
  48      $text =~ s/\s+$//;
  49      $text = $self->strip_format ($text);
  50      $text =~ s/(.)/$1\b$1/g;
  51      return $self->SUPER::cmd_head1 ($attrs, $text);
  52  }
  53  
  54  # Make level two headings bold, overriding any existing formatting.
  55  sub cmd_head2 {
  56      my ($self, $attrs, $text) = @_;
  57      $text =~ s/\s+$//;
  58      $text = $self->strip_format ($text);
  59      $text =~ s/(.)/$1\b$1/g;
  60      return $self->SUPER::cmd_head2 ($attrs, $text);
  61  }
  62  
  63  # Make level three headings underscored, overriding any existing formatting.
  64  sub cmd_head3 {
  65      my ($self, $attrs, $text) = @_;
  66      $text =~ s/\s+$//;
  67      $text = $self->strip_format ($text);
  68      $text =~ s/(.)/_\b$1/g;
  69      return $self->SUPER::cmd_head3 ($attrs, $text);
  70  }
  71  
  72  # Level four headings look like level three headings.
  73  sub cmd_head4 {
  74      my ($self, $attrs, $text) = @_;
  75      $text =~ s/\s+$//;
  76      $text = $self->strip_format ($text);
  77      $text =~ s/(.)/_\b$1/g;
  78      return $self->SUPER::cmd_head4 ($attrs, $text);
  79  }
  80  
  81  # The common code for handling all headers.  We have to override to avoid
  82  # interpolating twice and because we don't want to honor alt.
  83  sub heading {
  84      my ($self, $text, $indent, $marker) = @_;
  85      $self->item ("\n\n") if defined $$self{ITEM};
  86      $text .= "\n" if $$self{opt_loose};
  87      my $margin = ' ' x ($$self{opt_margin} + $indent);
  88      $self->output ($margin . $text . "\n");
  89      return '';
  90  }
  91  
  92  # Fix the various formatting codes.
  93  sub cmd_b { local $_ = $_[0]->strip_format ($_[2]); s/(.)/$1\b$1/g; $_ }
  94  sub cmd_f { local $_ = $_[0]->strip_format ($_[2]); s/(.)/_\b$1/g; $_ }
  95  sub cmd_i { local $_ = $_[0]->strip_format ($_[2]); s/(.)/_\b$1/g; $_ }
  96  
  97  # Output any included code in bold.
  98  sub output_code {
  99      my ($self, $code) = @_;
 100      $code =~ s/(.)/$1\b$1/g;
 101      $self->output ($code);
 102  }
 103  
 104  # We unfortunately have to override the wrapping code here, since the normal
 105  # wrapping code gets really confused by all the backspaces.
 106  sub wrap {
 107      my $self = shift;
 108      local $_ = shift;
 109      my $output = '';
 110      my $spaces = ' ' x $$self{MARGIN};
 111      my $width = $$self{opt_width} - $$self{MARGIN};
 112      while (length > $width) {
 113          # This regex represents a single character, that's possibly underlined
 114          # or in bold (in which case, it's three characters; the character, a
 115          # backspace, and a character).  Use [^\n] rather than . to protect
 116          # against odd settings of $*.
 117          my $char = '(?:[^\n][\b])?[^\n]';
 118          if (s/^((?>$char){0,$width})(?:\Z|\s+)//) {
 119              $output .= $spaces . $1 . "\n";
 120          } else {
 121              last;
 122          }
 123      }
 124      $output .= $spaces . $_;
 125      $output =~ s/\s+$/\n\n/;
 126      return $output;
 127  }
 128  
 129  ##############################################################################
 130  # Utility functions
 131  ##############################################################################
 132  
 133  # Strip all of the formatting from a provided string, returning the stripped
 134  # version.
 135  sub strip_format {
 136      my ($self, $text) = @_;
 137      $text =~ s/(.)[\b]\1/$1/g;
 138      $text =~ s/_[\b]//g;
 139      return $text;
 140  }
 141  
 142  ##############################################################################
 143  # Module return value and documentation
 144  ##############################################################################
 145  
 146  1;
 147  __END__
 148  
 149  =head1 NAME
 150  
 151  Pod::Text::Overstrike - Convert POD data to formatted overstrike text
 152  
 153  =head1 SYNOPSIS
 154  
 155      use Pod::Text::Overstrike;
 156      my $parser = Pod::Text::Overstrike->new (sentence => 0, width => 78);
 157  
 158      # Read POD from STDIN and write to STDOUT.
 159      $parser->parse_from_filehandle;
 160  
 161      # Read POD from file.pod and write to file.txt.
 162      $parser->parse_from_file ('file.pod', 'file.txt');
 163  
 164  =head1 DESCRIPTION
 165  
 166  Pod::Text::Overstrike is a simple subclass of Pod::Text that highlights
 167  output text using overstrike sequences, in a manner similar to nroff.
 168  Characters in bold text are overstruck (character, backspace, character) and
 169  characters in underlined text are converted to overstruck underscores
 170  (underscore, backspace, character).  This format was originally designed for
 171  hardcopy terminals and/or lineprinters, yet is readable on softcopy (CRT)
 172  terminals.
 173  
 174  Overstruck text is best viewed by page-at-a-time programs that take
 175  advantage of the terminal's B<stand-out> and I<underline> capabilities, such
 176  as the less program on Unix.
 177  
 178  Apart from the overstrike, it in all ways functions like Pod::Text.  See
 179  L<Pod::Text> for details and available options.
 180  
 181  =head1 BUGS
 182  
 183  Currently, the outermost formatting instruction wins, so for example
 184  underlined text inside a region of bold text is displayed as simply bold.
 185  There may be some better approach possible.
 186  
 187  =head1 SEE ALSO
 188  
 189  L<Pod::Text>, L<Pod::Simple>
 190  
 191  The current version of this module is always available from its web site at
 192  L<http://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
 193  Perl core distribution as of 5.6.0.
 194  
 195  =head1 AUTHOR
 196  
 197  Joe Smith <Joe.Smith@inwap.com>, using the framework created by Russ Allbery
 198  <rra@stanford.edu>.
 199  
 200  =head1 COPYRIGHT AND LICENSE
 201  
 202  Copyright 2000 by Joe Smith <Joe.Smith@inwap.com>.
 203  Copyright 2001, 2004 by Russ Allbery <rra@stanford.edu>.
 204  
 205  This program is free software; you may redistribute it and/or modify it
 206  under the same terms as Perl itself.
 207  
 208  =cut


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1