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