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