18ba7b20ff51f147212eeb7a81eff2ad6f4517e8
[perl.git] / cpan / podlators / lib / Pod / Text / Termcap.pm
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
8 #     Russ Allbery <rra@stanford.edu>
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
17 package Pod::Text::Termcap;
18
19 require 5.004;
20
21 use Pod::Text ();
22 use POSIX ();
23 use Term::Cap;
24
25 use strict;
26 use vars qw(@ISA $VERSION);
27
28 @ISA = qw(Pod::Text);
29
30 $VERSION = '2.08';
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.
38 sub 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.
74 sub 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.
81 sub 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<>.
88 sub cmd_b { my $self = shift; return "$$self{BOLD}$_[1]$$self{NORM}" }
89 sub cmd_i { my $self = shift; return "$$self{UNDL}$_[1]$$self{NORM}" }
90
91 # Output any included code in bold.
92 sub 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.
99 sub 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 ignore the special sequences.
108 sub 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 preceding 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
139 1;
140 __END__
141
142 =head1 NAME
143
144 Pod::Text::Termcap - Convert POD data to ASCII text with format escapes
145
146 =for stopwords
147 ECMA-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
162 Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output
163 text using the correct termcap escape sequences for the current terminal.
164 Apart from the format codes, it in all ways functions like Pod::Text.  See
165 L<Pod::Text> for details and available options.
166
167 =head1 NOTES
168
169 This module uses Term::Cap to retrieve the formatting escape sequences for
170 the current terminal, and falls back on the ECMA-48 (the same in this
171 regard as ANSI X3.64 and ISO 6429, the escape codes also used by DEC VT100
172 terminals) if the bold, underline, and reset codes aren't set in the
173 termcap information.
174
175 =head1 SEE ALSO
176
177 L<Pod::Text>, L<Pod::Simple>, L<Term::Cap>
178
179 The current version of this module is always available from its web site at
180 L<http://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
181 Perl core distribution as of 5.6.0.
182
183 =head1 AUTHOR
184
185 Russ Allbery <rra@stanford.edu>.
186
187 =head1 COPYRIGHT AND LICENSE
188
189 Copyright 1999, 2001, 2002, 2004, 2006, 2008, 2009 Russ Allbery
190 <rra@stanford.edu>.
191
192 This program is free software; you may redistribute it and/or modify it
193 under the same terms as Perl itself.
194
195 =cut