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