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.006;
16use strict;
17use warnings;
18
19use Pod::Text ();
20use POSIX ();
21use Term::Cap;
22
23use vars qw(@ISA $VERSION);
24
25@ISA = qw(Pod::Text);
26
27$VERSION = '4.11';
28
29##############################################################################
30# Overrides
31##############################################################################
32
33# In the initialization method, grab our terminal characteristics as well as
34# do all the stuff we normally do.
35sub new {
36    my ($self, %args) = @_;
37    my ($ospeed, $term, $termios);
38
39    # $ENV{HOME} is usually not set on Windows.  The default Term::Cap path
40    # may not work on Solaris.
41    unless (exists $ENV{TERMPATH}) {
42        my $home = exists $ENV{HOME} ? "$ENV{HOME}/.termcap:" : '';
43        $ENV{TERMPATH} =
44          "${home}/etc/termcap:/usr/share/misc/termcap:/usr/share/lib/termcap";
45    }
46
47    # Fall back on a hard-coded terminal speed if POSIX::Termios isn't
48    # available (such as on VMS).
49    eval { $termios = POSIX::Termios->new };
50    if ($@) {
51        $ospeed = 9600;
52    } else {
53        $termios->getattr;
54        $ospeed = $termios->getospeed || 9600;
55    }
56
57    # Get data from Term::Cap if possible.
58    my ($bold, $undl, $norm, $width);
59    eval {
60        my $term = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
61        $bold = $term->Tputs('md');
62        $undl = $term->Tputs('us');
63        $norm = $term->Tputs('me');
64        if (defined $$term{_co}) {
65            $width = $$term{_co};
66            $width =~ s/^\#//;
67        }
68    };
69
70    # Figure out the terminal width before calling the Pod::Text constructor,
71    # since it will otherwise force 76 characters.  Pod::Text::Termcap has
72    # historically used 2 characters less than the width of the screen, while
73    # the other Pod::Text classes have used 76.  This is weirdly inconsistent,
74    # but there's probably no good reason to change it now.
75    unless (defined $args{width}) {
76        $args{width} = $ENV{COLUMNS} || $width || 80;
77        $args{width} -= 2;
78    }
79
80    # Initialize Pod::Text.
81    $self = $self->SUPER::new (%args);
82
83    # Fall back on the ANSI escape sequences if Term::Cap doesn't work.
84    $$self{BOLD} = $bold || "\e[1m";
85    $$self{UNDL} = $undl || "\e[4m";
86    $$self{NORM} = $norm || "\e[m";
87
88    return $self;
89}
90
91# Make level one headings bold.
92sub cmd_head1 {
93    my ($self, $attrs, $text) = @_;
94    $text =~ s/\s+$//;
95    $self->SUPER::cmd_head1 ($attrs, "$$self{BOLD}$text$$self{NORM}");
96}
97
98# Make level two headings bold.
99sub cmd_head2 {
100    my ($self, $attrs, $text) = @_;
101    $text =~ s/\s+$//;
102    $self->SUPER::cmd_head2 ($attrs, "$$self{BOLD}$text$$self{NORM}");
103}
104
105# Fix up B<> and I<>.  Note that we intentionally don't do F<>.
106sub cmd_b { my $self = shift; return "$$self{BOLD}$_[1]$$self{NORM}" }
107sub cmd_i { my $self = shift; return "$$self{UNDL}$_[1]$$self{NORM}" }
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 = "(\Q$$self{BOLD}\E|\Q$$self{UNDL}\E|\Q$$self{NORM}\E)";
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    # $code matches a single special sequence.  $char matches any number of
151    # special sequences preceding a single character other than a newline.
152    # $shortchar matches some sequence of $char ending in codes followed by
153    # whitespace or the end of the string.  $longchar matches exactly $width
154    # $chars, used when we have to truncate and hard wrap.
155    #
156    # $shortchar and $longchar are created in a slightly odd way because the
157    # construct ${char}{0,$width} didn't do the right thing until Perl 5.8.x.
158    my $code = "(?:\Q$$self{BOLD}\E|\Q$$self{UNDL}\E|\Q$$self{NORM}\E)";
159    my $char = "(?>$code*[^\\n])";
160    my $shortchar = '^(' . $char . "{0,$width}(?>$code*)" . ')(?:\s+|\z)';
161    my $longchar = '^(' . $char . "{$width})";
162    while (length > $width) {
163        if (s/$shortchar// || s/$longchar//) {
164            $output .= $spaces . $1 . "\n";
165        } else {
166            last;
167        }
168    }
169    $output .= $spaces . $_;
170
171    # less -R always resets terminal attributes at the end of each line, so we
172    # need to clear attributes at the end of lines and then set them again at
173    # the start of the next line.  This requires a second pass through the
174    # wrapped string, accumulating any attributes we see, remembering them,
175    # and then inserting the appropriate sequences at the newline.
176    if ($output =~ /\n/) {
177        my @lines = split (/\n/, $output);
178        my $start_format;
179        for my $line (@lines) {
180            if ($start_format && $line =~ /\S/) {
181                $line =~ s/^(\s*)(\S)/$1$start_format$2/;
182            }
183            $start_format = $self->end_format ($line);
184            if ($start_format) {
185                $line .= $$self{NORM};
186            }
187        }
188        $output = join ("\n", @lines);
189    }
190
191    # Fix up trailing whitespace and return the results.
192    $output =~ s/\s+$/\n\n/;
193    return $output;
194}
195
196##############################################################################
197# Module return value and documentation
198##############################################################################
199
2001;
201__END__
202
203=head1 NAME
204
205Pod::Text::Termcap - Convert POD data to ASCII text with format escapes
206
207=for stopwords
208ECMA-48 VT100 Allbery Solaris TERMPATH
209
210=head1 SYNOPSIS
211
212    use Pod::Text::Termcap;
213    my $parser = Pod::Text::Termcap->new (sentence => 0, width => 78);
214
215    # Read POD from STDIN and write to STDOUT.
216    $parser->parse_from_filehandle;
217
218    # Read POD from file.pod and write to file.txt.
219    $parser->parse_from_file ('file.pod', 'file.txt');
220
221=head1 DESCRIPTION
222
223Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output
224text using the correct termcap escape sequences for the current terminal.
225Apart from the format codes, it in all ways functions like Pod::Text.  See
226L<Pod::Text> for details and available options.
227
228=head1 ENVIRONMENT
229
230This module sets the TERMPATH environment variable globally to:
231
232    $HOME/.termcap:/etc/termcap:/usr/share/misc/termcap:/usr/share/lib/termcap
233
234if it isn't already set.  (The first entry is omitted if the HOME
235environment variable isn't set.)  This is a (very old) workaround for
236problems finding termcap information on older versions of Solaris, and is
237not good module behavior.  Please do not rely on this behavior; it may be
238dropped in a future release.
239
240=head1 NOTES
241
242This module uses Term::Cap to retrieve the formatting escape sequences for
243the current terminal, and falls back on the ECMA-48 (the same in this
244regard as ANSI X3.64 and ISO 6429, the escape codes also used by DEC VT100
245terminals) if the bold, underline, and reset codes aren't set in the
246termcap information.
247
248=head1 AUTHOR
249
250Russ Allbery <rra@cpan.org>.
251
252=head1 COPYRIGHT AND LICENSE
253
254Copyright 1999, 2001-2002, 2004, 2006, 2008-2009, 2014-2015, 2018 Russ Allbery
255<rra@cpan.org>
256
257This program is free software; you may redistribute it and/or modify it
258under the same terms as Perl itself.
259
260=head1 SEE ALSO
261
262L<Pod::Text>, L<Pod::Simple>, L<Term::Cap>
263
264The current version of this module is always available from its web site at
265L<https://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
266Perl core distribution as of 5.6.0.
267
268=cut
269
270# Local Variables:
271# copyright-at-end-flag: t
272# End:
273