1package Pod::Perldoc::ToTerm;
2use strict;
3use warnings;
4
5use vars qw($VERSION);
6$VERSION = '3.28';
7
8use parent qw(Pod::Perldoc::BaseTo);
9
10sub is_pageable        { 1 }
11sub write_with_binmode { 0 }
12sub output_extension   { 'txt' }
13
14use Pod::Text::Termcap ();
15
16sub alt       { shift->_perldoc_elem('alt'     , @_) }
17sub indent    { shift->_perldoc_elem('indent'  , @_) }
18sub loose     { shift->_perldoc_elem('loose'   , @_) }
19sub quotes    { shift->_perldoc_elem('quotes'  , @_) }
20sub sentence  { shift->_perldoc_elem('sentence', @_) }
21sub width     {
22    my $self = shift;
23    $self->_perldoc_elem('width' , @_) ||
24    $self->_get_columns_from_manwidth  ||
25	$self->_get_columns_from_stty      ||
26	$self->_get_default_width;
27}
28
29sub pager_configuration {
30  my($self, $pager, $perldoc) = @_;
31
32  # do not modify anything on Windows or DOS
33  return if ( $perldoc->is_mswin32 || $perldoc->is_dos );
34
35  if ( $pager =~ /less/ ) {
36    $self->_maybe_modify_environment('LESS');
37  }
38  elsif ( $pager =~ /more/ ) {
39    $self->_maybe_modify_environment('MORE');
40  }
41
42  return;
43}
44
45sub _maybe_modify_environment {
46  my($self, $name) = @_;
47
48  if ( ! defined $ENV{$name} ) {
49    $ENV{$name} = "-R";
50  }
51
52  # if the environment is set, don't modify
53  # anything
54
55}
56
57sub _get_stty { `stty -a` }
58
59sub _get_columns_from_stty {
60	my $output = $_[0]->_get_stty;
61
62	if(    $output =~ /\bcolumns\s+(\d+)/ )    { return $1; }
63	elsif( $output =~ /;\s*(\d+)\s+columns;/ ) { return $1; }
64	else                                       { return  0 }
65	}
66
67sub _get_columns_from_manwidth {
68	my( $self ) = @_;
69
70	return 0 unless defined $ENV{MANWIDTH};
71
72	unless( $ENV{MANWIDTH} =~ m/\A\d+\z/ ) {
73		$self->warn( "Ignoring non-numeric MANWIDTH ($ENV{MANWIDTH})\n" );
74		return 0;
75		}
76
77	if( $ENV{MANWIDTH} == 0 ) {
78		$self->warn( "Ignoring MANWIDTH of 0. Really? Why even run the program? :)\n" );
79		return 0;
80		}
81
82	if( $ENV{MANWIDTH} =~ m/\A(\d+)\z/ ) { return $1 }
83
84	return 0;
85	}
86
87sub _get_default_width {
88	76
89	}
90
91
92sub new { return bless {}, ref($_[0]) || $_[0] }
93
94sub parse_from_file {
95  my $self = shift;
96
97  $self->{width} = $self->width();
98
99  my @options =
100    map {; $_, $self->{$_} }
101      grep !m/^_/s,
102        keys %$self
103  ;
104
105  defined(&Pod::Perldoc::DEBUG)
106   and Pod::Perldoc::DEBUG()
107   and print "About to call new Pod::Text::Termcap ",
108    $Pod::Text::VERSION ? "(v$Pod::Text::Termcap::VERSION) " : '',
109    "with options: ",
110    @options ? "[@options]" : "(nil)", "\n";
111  ;
112
113  Pod::Text::Termcap->new(@options)->parse_from_file(@_);
114}
115
1161;
117
118=head1 NAME
119
120Pod::Perldoc::ToTerm - render Pod with terminal escapes
121
122=head1 SYNOPSIS
123
124  perldoc -o term Some::Modulename
125
126=head1 DESCRIPTION
127
128This is a "plug-in" class that allows Perldoc to use
129Pod::Text as a formatter class.
130
131It supports the following options, which are explained in
132L<Pod::Text>: alt, indent, loose, quotes, sentence, width
133
134For example:
135
136  perldoc -o term -w indent:5 Some::Modulename
137
138=head1 PAGER FORMATTING
139
140Depending on the platform, and because this class emits terminal escapes it
141will attempt to set the C<-R> flag on your pager by injecting the flag into
142your environment variable for C<less> or C<more>.
143
144On Windows and DOS, this class will not modify any environment variables.
145
146=head1 CAVEAT
147
148This module may change to use a different text formatter class in the
149future, and this may change what options are supported.
150
151=head1 SEE ALSO
152
153L<Pod::Text>, L<Pod::Text::Termcap>, L<Pod::Perldoc>
154
155=head1 COPYRIGHT AND DISCLAIMERS
156
157Copyright (c) 2017 Mark Allen.
158
159This program is free software; you can redistribute it and/or modify it
160under the terms of either: the GNU General Public License as published
161by the Free Software Foundation; or the Artistic License.
162
163See http://dev.perl.org/licenses/ for more information.
164
165=head1 AUTHOR
166
167Mark Allen C<< <mallen@cpan.org> >>
168
169=cut
170