| 1 | # Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes. |
| 2 | # $Id: Termcap.pm,v 1.10 2002/07/15 05:46:00 eagle Exp $ |
| 3 | # |
| 4 | # Copyright 1999, 2001, 2002 by Russ Allbery <rra@stanford.edu> |
| 5 | # |
| 6 | # This program is free software; you may redistribute it and/or modify it |
| 7 | # under the same terms as Perl itself. |
| 8 | # |
| 9 | # This is a simple subclass of Pod::Text that overrides a few key methods to |
| 10 | # output the right termcap escape sequences for formatted text on the current |
| 11 | # terminal type. |
| 12 | |
| 13 | ############################################################################## |
| 14 | # Modules and declarations |
| 15 | ############################################################################## |
| 16 | |
| 17 | package Pod::Text::Termcap; |
| 18 | |
| 19 | require 5.004; |
| 20 | |
| 21 | use Pod::Text (); |
| 22 | use POSIX (); |
| 23 | use Term::Cap; |
| 24 | |
| 25 | use strict; |
| 26 | use vars qw(@ISA $VERSION); |
| 27 | |
| 28 | @ISA = qw(Pod::Text); |
| 29 | |
| 30 | # Don't use the CVS revision as the version, since this module is also in Perl |
| 31 | # core and too many things could munge CVS magic revision strings. This |
| 32 | # number should ideally be the same as the CVS revision in podlators, however. |
| 33 | $VERSION = 1.10; |
| 34 | |
| 35 | |
| 36 | ############################################################################## |
| 37 | # Overrides |
| 38 | ############################################################################## |
| 39 | |
| 40 | # In the initialization method, grab our terminal characteristics as well as |
| 41 | # do all the stuff we normally do. |
| 42 | sub initialize { |
| 43 | my $self = shift; |
| 44 | my ($ospeed, $term, $termios); |
| 45 | |
| 46 | # The default Term::Cap path won't work on Solaris. |
| 47 | $ENV{TERMPATH} = "$ENV{HOME}/.termcap:/etc/termcap" |
| 48 | . ":/usr/share/misc/termcap:/usr/share/lib/termcap"; |
| 49 | |
| 50 | # Fall back on a hard-coded terminal speed if POSIX::Termios isn't |
| 51 | # available (such as on VMS). |
| 52 | eval { $termios = POSIX::Termios->new }; |
| 53 | if ($@) { |
| 54 | $ospeed = 9600; |
| 55 | } else { |
| 56 | $termios->getattr; |
| 57 | $ospeed = $termios->getospeed || 9600; |
| 58 | } |
| 59 | |
| 60 | # Fall back on the ANSI escape sequences if Term::Cap doesn't work. |
| 61 | eval { $term = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed } }; |
| 62 | $$self{BOLD} = $$term{_md} || "\e[1m"; |
| 63 | $$self{UNDL} = $$term{_us} || "\e[4m"; |
| 64 | $$self{NORM} = $$term{_me} || "\e[m"; |
| 65 | |
| 66 | unless (defined $$self{width}) { |
| 67 | $$self{width} = $ENV{COLUMNS} || $$term{_co} || 80; |
| 68 | $$self{width} -= 2; |
| 69 | } |
| 70 | |
| 71 | $self->SUPER::initialize; |
| 72 | } |
| 73 | |
| 74 | # Make level one headings bold. |
| 75 | sub cmd_head1 { |
| 76 | my $self = shift; |
| 77 | local $_ = shift; |
| 78 | s/\s+$//; |
| 79 | $self->SUPER::cmd_head1 ("$$self{BOLD}$_$$self{NORM}"); |
| 80 | } |
| 81 | |
| 82 | # Make level two headings bold. |
| 83 | sub cmd_head2 { |
| 84 | my $self = shift; |
| 85 | local $_ = shift; |
| 86 | s/\s+$//; |
| 87 | $self->SUPER::cmd_head2 ("$$self{BOLD}$_$$self{NORM}"); |
| 88 | } |
| 89 | |
| 90 | # Fix up B<> and I<>. Note that we intentionally don't do F<>. |
| 91 | sub seq_b { my $self = shift; return "$$self{BOLD}$_[0]$$self{NORM}" } |
| 92 | sub seq_i { my $self = shift; return "$$self{UNDL}$_[0]$$self{NORM}" } |
| 93 | |
| 94 | # Output any included code in bold. |
| 95 | sub output_code { |
| 96 | my ($self, $code) = @_; |
| 97 | $self->output ($$self{BOLD} . $code . $$self{NORM}); |
| 98 | } |
| 99 | |
| 100 | # Override the wrapping code to igore the special sequences. |
| 101 | sub wrap { |
| 102 | my $self = shift; |
| 103 | local $_ = shift; |
| 104 | my $output = ''; |
| 105 | my $spaces = ' ' x $$self{MARGIN}; |
| 106 | my $width = $$self{width} - $$self{MARGIN}; |
| 107 | my $code = "(?:\Q$$self{BOLD}\E|\Q$$self{UNDL}\E|\Q$$self{NORM}\E)"; |
| 108 | while (length > $width) { |
| 109 | if (s/^((?:$code?[^\n]){0,$width})\s+// |
| 110 | || s/^((?:$code?[^\n]){$width})//) { |
| 111 | $output .= $spaces . $1 . "\n"; |
| 112 | } else { |
| 113 | last; |
| 114 | } |
| 115 | } |
| 116 | $output .= $spaces . $_; |
| 117 | $output =~ s/\s+$/\n\n/; |
| 118 | $output; |
| 119 | } |
| 120 | |
| 121 | |
| 122 | ############################################################################## |
| 123 | # Module return value and documentation |
| 124 | ############################################################################## |
| 125 | |
| 126 | 1; |
| 127 | __END__ |
| 128 | |
| 129 | =head1 NAME |
| 130 | |
| 131 | Pod::Text::Termcap - Convert POD data to ASCII text with format escapes |
| 132 | |
| 133 | =head1 SYNOPSIS |
| 134 | |
| 135 | use Pod::Text::Termcap; |
| 136 | my $parser = Pod::Text::Termcap->new (sentence => 0, width => 78); |
| 137 | |
| 138 | # Read POD from STDIN and write to STDOUT. |
| 139 | $parser->parse_from_filehandle; |
| 140 | |
| 141 | # Read POD from file.pod and write to file.txt. |
| 142 | $parser->parse_from_file ('file.pod', 'file.txt'); |
| 143 | |
| 144 | =head1 DESCRIPTION |
| 145 | |
| 146 | Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output |
| 147 | text using the correct termcap escape sequences for the current terminal. |
| 148 | Apart from the format codes, it in all ways functions like Pod::Text. See |
| 149 | L<Pod::Text> for details and available options. |
| 150 | |
| 151 | =head1 NOTES |
| 152 | |
| 153 | This module uses Term::Cap to retrieve the formatting escape sequences for |
| 154 | the current terminal, and falls back on the ECMA-48 (the same in this |
| 155 | regard as ANSI X3.64 and ISO 6429, the escape codes also used by DEC VT100 |
| 156 | terminals) if the bold, underline, and reset codes aren't set in the |
| 157 | termcap information. |
| 158 | |
| 159 | =head1 SEE ALSO |
| 160 | |
| 161 | L<Pod::Text>, L<Pod::Parser>, L<Term::Cap> |
| 162 | |
| 163 | The current version of this module is always available from its web site at |
| 164 | L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the |
| 165 | Perl core distribution as of 5.6.0. |
| 166 | |
| 167 | =head1 AUTHOR |
| 168 | |
| 169 | Russ Allbery <rra@stanford.edu>. |
| 170 | |
| 171 | =head1 COPYRIGHT AND LICENSE |
| 172 | |
| 173 | Copyright 1999, 2001, 2002 by Russ Allbery <rra@stanford.edu>. |
| 174 | |
| 175 | This program is free software; you may redistribute it and/or modify it |
| 176 | under the same terms as Perl itself. |
| 177 | |
| 178 | =cut |