1# Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes. 2# 3# This is a simple subclass of Pod::Text that overrides a few key methods to 4# output the right termcap escape sequences for formatted text on the current 5# terminal type. 6# 7# Copyright 1999, 2001, 2002, 2004, 2006, 2008, 2009, 2014, 2015 8# Russ Allbery <rra@cpan.org> 9# 10# This program is free software; you may redistribute it and/or modify it 11# under the same terms as Perl itself. 12 13############################################################################## 14# Modules and declarations 15############################################################################## 16 17package Pod::Text::Termcap; 18 19use 5.006; 20use strict; 21use warnings; 22 23use Pod::Text (); 24use POSIX (); 25use Term::Cap; 26 27use vars qw(@ISA $VERSION); 28 29@ISA = qw(Pod::Text); 30 31$VERSION = '4.07'; 32 33############################################################################## 34# Overrides 35############################################################################## 36 37# In the initialization method, grab our terminal characteristics as well as 38# do all the stuff we normally do. 39sub new { 40 my ($self, @args) = @_; 41 my ($ospeed, $term, $termios); 42 $self = $self->SUPER::new (@args); 43 44 # $ENV{HOME} is usually not set on Windows. The default Term::Cap path 45 # may not work on Solaris. 46 unless (exists $ENV{TERMPATH}) { 47 my $home = exists $ENV{HOME} ? "$ENV{HOME}/.termcap:" : ''; 48 $ENV{TERMPATH} = 49 "${home}/etc/termcap:/usr/share/misc/termcap:/usr/share/lib/termcap"; 50 } 51 52 # Fall back on a hard-coded terminal speed if POSIX::Termios isn't 53 # available (such as on VMS). 54 eval { $termios = POSIX::Termios->new }; 55 if ($@) { 56 $ospeed = 9600; 57 } else { 58 $termios->getattr; 59 $ospeed = $termios->getospeed || 9600; 60 } 61 62 # Fall back on the ANSI escape sequences if Term::Cap doesn't work. 63 eval { $term = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed } }; 64 $$self{BOLD} = $$term{_md} || "\e[1m"; 65 $$self{UNDL} = $$term{_us} || "\e[4m"; 66 $$self{NORM} = $$term{_me} || "\e[m"; 67 68 unless (defined $$self{width}) { 69 $$self{opt_width} = $ENV{COLUMNS} || $$term{_co} || 80; 70 $$self{opt_width} -= 2; 71 } 72 73 return $self; 74} 75 76# Make level one headings bold. 77sub cmd_head1 { 78 my ($self, $attrs, $text) = @_; 79 $text =~ s/\s+$//; 80 $self->SUPER::cmd_head1 ($attrs, "$$self{BOLD}$text$$self{NORM}"); 81} 82 83# Make level two headings bold. 84sub cmd_head2 { 85 my ($self, $attrs, $text) = @_; 86 $text =~ s/\s+$//; 87 $self->SUPER::cmd_head2 ($attrs, "$$self{BOLD}$text$$self{NORM}"); 88} 89 90# Fix up B<> and I<>. Note that we intentionally don't do F<>. 91sub cmd_b { my $self = shift; return "$$self{BOLD}$_[1]$$self{NORM}" } 92sub cmd_i { my $self = shift; return "$$self{UNDL}$_[1]$$self{NORM}" } 93 94# Output any included code in bold. 95sub output_code { 96 my ($self, $code) = @_; 97 $self->output ($$self{BOLD} . $code . $$self{NORM}); 98} 99 100# Strip all of the formatting from a provided string, returning the stripped 101# version. 102sub strip_format { 103 my ($self, $text) = @_; 104 $text =~ s/\Q$$self{BOLD}//g; 105 $text =~ s/\Q$$self{UNDL}//g; 106 $text =~ s/\Q$$self{NORM}//g; 107 return $text; 108} 109 110# Override the wrapping code to ignore the special sequences. 111sub wrap { 112 my $self = shift; 113 local $_ = shift; 114 my $output = ''; 115 my $spaces = ' ' x $$self{MARGIN}; 116 my $width = $$self{opt_width} - $$self{MARGIN}; 117 118 # $codes matches a single special sequence. $char matches any number of 119 # special sequences preceding a single character other than a newline. 120 # We have to do $shortchar and $longchar in variables because the 121 # construct ${char}{0,$width} didn't do the right thing until Perl 5.8.x. 122 my $codes = "(?:\Q$$self{BOLD}\E|\Q$$self{UNDL}\E|\Q$$self{NORM}\E)"; 123 my $char = "(?:$codes*[^\\n])"; 124 my $shortchar = $char . "{0,$width}"; 125 my $longchar = $char . "{$width}"; 126 while (length > $width) { 127 if (s/^($shortchar)\s+// || s/^($longchar)//) { 128 $output .= $spaces . $1 . "\n"; 129 } else { 130 last; 131 } 132 } 133 $output .= $spaces . $_; 134 $output =~ s/\s+$/\n\n/; 135 return $output; 136} 137 138############################################################################## 139# Module return value and documentation 140############################################################################## 141 1421; 143__END__ 144 145=head1 NAME 146 147Pod::Text::Termcap - Convert POD data to ASCII text with format escapes 148 149=for stopwords 150ECMA-48 VT100 Allbery Solaris TERMPATH 151 152=head1 SYNOPSIS 153 154 use Pod::Text::Termcap; 155 my $parser = Pod::Text::Termcap->new (sentence => 0, width => 78); 156 157 # Read POD from STDIN and write to STDOUT. 158 $parser->parse_from_filehandle; 159 160 # Read POD from file.pod and write to file.txt. 161 $parser->parse_from_file ('file.pod', 'file.txt'); 162 163=head1 DESCRIPTION 164 165Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output 166text using the correct termcap escape sequences for the current terminal. 167Apart from the format codes, it in all ways functions like Pod::Text. See 168L<Pod::Text> for details and available options. 169 170=head1 ENVIRONMENT 171 172This module sets the TERMPATH environment variable globally to: 173 174 $HOME/.termcap:/etc/termcap:/usr/share/misc/termcap:/usr/share/lib/termcap 175 176if it isn't already set. (The first entry is omitted if the HOME 177environment variable isn't set.) This is a (very old) workaround for 178problems finding termcap information on older versions of Solaris, and is 179not good module behavior. Please do not rely on this behavior; it may be 180dropped in a future release. 181 182=head1 NOTES 183 184This module uses Term::Cap to retrieve the formatting escape sequences for 185the current terminal, and falls back on the ECMA-48 (the same in this 186regard as ANSI X3.64 and ISO 6429, the escape codes also used by DEC VT100 187terminals) if the bold, underline, and reset codes aren't set in the 188termcap information. 189 190=head1 SEE ALSO 191 192L<Pod::Text>, L<Pod::Simple>, L<Term::Cap> 193 194The current version of this module is always available from its web site at 195L<http://www.eyrie.org/~eagle/software/podlators/>. It is also part of the 196Perl core distribution as of 5.6.0. 197 198=head1 AUTHOR 199 200Russ Allbery <rra@cpan.org>. 201 202=head1 COPYRIGHT AND LICENSE 203 204Copyright 1999, 2001, 2002, 2004, 2006, 2008, 2009, 2014, 2015 Russ Allbery 205<rra@cpan.org> 206 207This program is free software; you may redistribute it and/or modify it 208under the same terms as Perl itself. 209 210=cut 211