1# 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# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl 8 9############################################################################## 10# Modules and declarations 11############################################################################## 12 13package Pod::Text::Termcap; 14 15use 5.010; 16use strict; 17use warnings; 18 19use Pod::Text (); 20use POSIX (); 21use Term::Cap; 22 23our @ISA = qw(Pod::Text); 24our $VERSION = '5.01_02'; 25$VERSION =~ tr/_//d; 26 27############################################################################## 28# Overrides 29############################################################################## 30 31# In the initialization method, grab our terminal characteristics as well as 32# do all the stuff we normally do. 33sub new { 34 my ($self, %args) = @_; 35 my ($ospeed, $term, $termios); 36 37 # Fall back on a hard-coded terminal speed if POSIX::Termios isn't 38 # available (such as on VMS). 39 eval { $termios = POSIX::Termios->new }; 40 if ($@) { 41 $ospeed = 9600; 42 } else { 43 $termios->getattr; 44 $ospeed = $termios->getospeed || 9600; 45 } 46 47 # Get data from Term::Cap if possible. 48 my ($bold, $undl, $norm, $width); 49 eval { 50 my $term = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed }; 51 $bold = $term->Tputs('md'); 52 $undl = $term->Tputs('us'); 53 $norm = $term->Tputs('me'); 54 if (defined $$term{_co}) { 55 $width = $$term{_co}; 56 $width =~ s/^\#//; 57 } 58 }; 59 60 # Figure out the terminal width before calling the Pod::Text constructor, 61 # since it will otherwise force 76 characters. Pod::Text::Termcap has 62 # historically used 2 characters less than the width of the screen, while 63 # the other Pod::Text classes have used 76. This is weirdly inconsistent, 64 # but there's probably no good reason to change it now. 65 unless (defined $args{width}) { 66 $args{width} = $ENV{COLUMNS} || $width || 80; 67 $args{width} -= 2; 68 } 69 70 # Initialize Pod::Text. 71 $self = $self->SUPER::new (%args); 72 73 # If we were unable to get any of the formatting sequences, don't attempt 74 # that type of formatting. This will do weird things if bold or underline 75 # were available but normal wasn't, but hopefully that will never happen. 76 $$self{BOLD} = $bold || q{}; 77 $$self{UNDL} = $undl || q{}; 78 $$self{NORM} = $norm || q{}; 79 80 return $self; 81} 82 83# Make level one headings bold. 84sub cmd_head1 { 85 my ($self, $attrs, $text) = @_; 86 $text =~ s/\s+$//; 87 $self->SUPER::cmd_head1 ($attrs, "$$self{BOLD}$text$$self{NORM}"); 88} 89 90# Make level two headings bold. 91sub cmd_head2 { 92 my ($self, $attrs, $text) = @_; 93 $text =~ s/\s+$//; 94 $self->SUPER::cmd_head2 ($attrs, "$$self{BOLD}$text$$self{NORM}"); 95} 96 97# Fix up B<> and I<>. Note that we intentionally don't do F<>. 98sub cmd_b { my $self = shift; return "$$self{BOLD}$_[1]$$self{NORM}" } 99sub cmd_i { my $self = shift; return "$$self{UNDL}$_[1]$$self{NORM}" } 100 101# Return a regex that matches a formatting sequence. This will only be valid 102# if we were able to get at least some termcap information. 103sub format_regex { 104 my ($self) = @_; 105 my @codes = ($self->{BOLD}, $self->{UNDL}, $self->{NORM}); 106 return join(q{|}, map { $_ eq q{} ? () : "\Q$_\E" } @codes); 107} 108 109# Analyze a single line and return any formatting codes in effect at the end 110# of that line. 111sub end_format { 112 my ($self, $line) = @_; 113 my $pattern = "(" . $self->format_regex() . ")"; 114 my $current; 115 while ($line =~ /$pattern/g) { 116 my $code = $1; 117 if ($code eq $$self{NORM}) { 118 undef $current; 119 } else { 120 $current .= $code; 121 } 122 } 123 return $current; 124} 125 126# Output any included code in bold. 127sub output_code { 128 my ($self, $code) = @_; 129 $self->output ($$self{BOLD} . $code . $$self{NORM}); 130} 131 132# Strip all of the formatting from a provided string, returning the stripped 133# version. 134sub strip_format { 135 my ($self, $text) = @_; 136 $text =~ s/\Q$$self{BOLD}//g; 137 $text =~ s/\Q$$self{UNDL}//g; 138 $text =~ s/\Q$$self{NORM}//g; 139 return $text; 140} 141 142# Override the wrapping code to ignore the special sequences. 143sub wrap { 144 my $self = shift; 145 local $_ = shift; 146 my $output = ''; 147 my $spaces = ' ' x $$self{MARGIN}; 148 my $width = $$self{opt_width} - $$self{MARGIN}; 149 150 # If we were unable to find any termcap sequences, use Pod::Text wrapping. 151 if ($self->{BOLD} eq q{} && $self->{UNDL} eq q{} && $self->{NORM} eq q{}) { 152 return $self->SUPER::wrap($_); 153 } 154 155 # $code matches a single special sequence. $char matches any number of 156 # special sequences preceding a single character other than a newline. 157 # $shortchar matches some sequence of $char ending in codes followed by 158 # whitespace or the end of the string. $longchar matches exactly $width 159 # $chars, used when we have to truncate and hard wrap. 160 my $code = "(?:" . $self->format_regex() . ")"; 161 my $char = "(?>$code*[^\\n])"; 162 my $shortchar = '^(' . $char . "{0,$width}(?>$code*)" . ')(?:\s+|\z)'; 163 my $longchar = '^(' . $char . "{$width})"; 164 while (length > $width) { 165 if (s/$shortchar// || s/$longchar//) { 166 $output .= $spaces . $1 . "\n"; 167 } else { 168 last; 169 } 170 } 171 $output .= $spaces . $_; 172 173 # less -R always resets terminal attributes at the end of each line, so we 174 # need to clear attributes at the end of lines and then set them again at 175 # the start of the next line. This requires a second pass through the 176 # wrapped string, accumulating any attributes we see, remembering them, 177 # and then inserting the appropriate sequences at the newline. 178 if ($output =~ /\n/) { 179 my @lines = split (/\n/, $output); 180 my $start_format; 181 for my $line (@lines) { 182 if ($start_format && $line =~ /\S/) { 183 $line =~ s/^(\s*)(\S)/$1$start_format$2/; 184 } 185 $start_format = $self->end_format ($line); 186 if ($start_format) { 187 $line .= $$self{NORM}; 188 } 189 } 190 $output = join ("\n", @lines); 191 } 192 193 # Fix up trailing whitespace and return the results. 194 $output =~ s/\s+$/\n\n/; 195 return $output; 196} 197 198############################################################################## 199# Module return value and documentation 200############################################################################## 201 2021; 203__END__ 204 205=for stopwords 206ECMA-48 VT100 Allbery Solaris TERMPATH unformatted 207 208=head1 NAME 209 210Pod::Text::Termcap - Convert POD data to ASCII text with format escapes 211 212=head1 SYNOPSIS 213 214 use Pod::Text::Termcap; 215 my $parser = Pod::Text::Termcap->new (sentence => 0, width => 78); 216 217 # Read POD from STDIN and write to STDOUT. 218 $parser->parse_from_filehandle; 219 220 # Read POD from file.pod and write to file.txt. 221 $parser->parse_from_file ('file.pod', 'file.txt'); 222 223=head1 DESCRIPTION 224 225Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output 226text using the correct termcap escape sequences for the current terminal. 227Apart from the format codes, it in all ways functions like Pod::Text. See 228L<Pod::Text> for details and available options. 229 230This module uses L<Term::Cap> to find the correct terminal settings. See the 231documentation of that module for how it finds terminal database information 232and how to override that behavior if necessary. If unable to find control 233strings for bold and underscore formatting, that formatting is skipped, 234resulting in the same output as Pod::Text. 235 236=head1 COMPATIBILITY 237 238Pod::Text::Termcap 0.04 (based on L<Pod::Parser>) was the first version of 239this module included with Perl, in Perl 5.6.0. 240 241The current API based on L<Pod::Simple> was added in Pod::Text::Termcap 2.00. 242Pod::Text::Termcap 2.01 was included in Perl 5.9.3, the first version of Perl 243to incorporate those changes. 244 245Several problems with wrapping and line length were fixed as recently as 246Pod::Text::Termcap 4.11, included in Perl 5.29.1. 247 248Pod::Text::Termcap 4.13 stopped setting the TERMPATH environment variable 249during module load. It also stopped falling back on VT100 escape sequences if 250Term::Cap was not able to find usable escape sequences, instead producing 251unformatted output for better results on dumb terminals. The next version to 252be incorporated into Perl, 4.14, was included in Perl 5.31.8. 253 254This module inherits its API and most behavior from Pod::Text, so the details 255in L<Pod::Text/COMPATIBILITY> also apply. Pod::Text and Pod::Text::Termcap 256have had the same module version since 4.00, included in Perl 5.23.7. (They 257unfortunately diverge in confusing ways prior to that.) 258 259=head1 AUTHOR 260 261Russ Allbery <rra@cpan.org> 262 263=head1 COPYRIGHT AND LICENSE 264 265Copyright 1999, 2001-2002, 2004, 2006, 2008-2009, 2014-2015, 2018-2019, 2022 266Russ Allbery <rra@cpan.org> 267 268This program is free software; you may redistribute it and/or modify it 269under the same terms as Perl itself. 270 271=head1 SEE ALSO 272 273L<Pod::Text>, L<Pod::Simple>, L<Term::Cap> 274 275The current version of this module is always available from its web site at 276L<https://www.eyrie.org/~eagle/software/podlators/>. It is also part of the 277Perl core distribution as of 5.6.0. 278 279=cut 280 281# Local Variables: 282# copyright-at-end-flag: t 283# End: 284