1package Pod::Perldoc::BaseTo;
2use strict;
3use warnings;
4
5use vars qw($VERSION);
6$VERSION = '3.28';
7
8use Carp                  qw(croak carp);
9use Config                qw(%Config);
10use File::Spec::Functions qw(catfile);
11
12sub is_pageable        { '' }
13sub write_with_binmode {  1 }
14
15sub output_extension   { 'txt' }  # override in subclass!
16
17# sub new { my $self = shift; ...  }
18# sub parse_from_file( my($class, $in, $out) = ...; ... }
19
20#sub new { return bless {}, ref($_[0]) || $_[0] }
21
22# this is also in Perldoc.pm, but why look there when you're a
23# subclass of this?
24sub TRUE  () {1}
25sub FALSE () {return}
26
27BEGIN {
28 *is_vms     = $^O eq 'VMS'      ? \&TRUE : \&FALSE unless defined &is_vms;
29 *is_mswin32 = $^O eq 'MSWin32'  ? \&TRUE : \&FALSE unless defined &is_mswin32;
30 *is_dos     = $^O eq 'dos'      ? \&TRUE : \&FALSE unless defined &is_dos;
31 *is_os2     = $^O eq 'os2'      ? \&TRUE : \&FALSE unless defined &is_os2;
32 *is_cygwin  = $^O eq 'cygwin'   ? \&TRUE : \&FALSE unless defined &is_cygwin;
33 *is_linux   = $^O eq 'linux'    ? \&TRUE : \&FALSE unless defined &is_linux;
34 *is_hpux    = $^O =~ m/hpux/    ? \&TRUE : \&FALSE unless defined &is_hpux;
35 *is_openbsd = $^O =~ m/openbsd/ ? \&TRUE : \&FALSE unless defined &is_openbsd;
36 *is_freebsd = $^O =~ m/freebsd/ ? \&TRUE : \&FALSE unless defined &is_freebsd;
37 *is_bitrig = $^O =~ m/bitrig/ ? \&TRUE : \&FALSE unless defined &is_bitrig;
38}
39
40sub _perldoc_elem {
41  my($self, $name) = splice @_,0,2;
42  if(@_) {
43    $self->{$name} = $_[0];
44  } else {
45    $self->{$name};
46  }
47}
48
49sub debugging {
50	my( $self, @messages ) = @_;
51
52    ( defined(&Pod::Perldoc::DEBUG) and &Pod::Perldoc::DEBUG() )
53	}
54
55sub debug {
56	my( $self, @messages ) = @_;
57	return unless $self->debugging;
58	print STDERR map { "DEBUG $_" } @messages;
59	}
60
61sub warn {
62	my( $self, @messages ) = @_;
63	carp join "\n", @messages, '';
64	}
65
66sub die {
67	my( $self, @messages ) = @_;
68	croak join "\n", @messages, '';
69	}
70
71sub _get_path_components {
72	my( $self ) = @_;
73
74	my @paths = split /\Q$Config{path_sep}/, $ENV{PATH};
75
76	return @paths;
77	}
78
79sub _find_executable_in_path {
80	my( $self, $program ) = @_;
81
82	my @found = ();
83	foreach my $dir ( $self->_get_path_components ) {
84		my $binary = catfile( $dir, $program );
85		$self->debug( "Looking for $binary\n" );
86		next unless -e $binary;
87		unless( -x $binary ) {
88			$self->warn( "Found $binary but it's not executable. Skipping.\n" );
89			next;
90			}
91		$self->debug( "Found $binary\n" );
92		push @found, $binary;
93		}
94
95	return @found;
96	}
97
981;
99
100__END__
101
102=head1 NAME
103
104Pod::Perldoc::BaseTo - Base for Pod::Perldoc formatters
105
106=head1 SYNOPSIS
107
108    package Pod::Perldoc::ToMyFormat;
109
110    use parent qw( Pod::Perldoc::BaseTo );
111    ...
112
113=head1 DESCRIPTION
114
115This package is meant as a base of Pod::Perldoc formatters,
116like L<Pod::Perldoc::ToText>, L<Pod::Perldoc::ToMan>, etc.
117
118It provides default implementations for the methods
119
120    is_pageable
121    write_with_binmode
122    output_extension
123    _perldoc_elem
124
125The concrete formatter must implement
126
127    new
128    parse_from_file
129
130=head1 SEE ALSO
131
132L<perldoc>
133
134=head1 COPYRIGHT AND DISCLAIMERS
135
136Copyright (c) 2002-2007 Sean M. Burke.
137
138This library is free software; you can redistribute it and/or modify it
139under the same terms as Perl itself.
140
141This program is distributed in the hope that it will be useful, but
142without any warranty; without even the implied warranty of
143merchantability or fitness for a particular purpose.
144
145=head1 AUTHOR
146
147Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
148
149Past contributions from:
150brian d foy C<< <bdfoy@cpan.org> >>
151Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
152Sean M. Burke C<< <sburke@cpan.org> >>
153
154=cut
155