xref: /openbsd-src/gnu/usr.bin/perl/cpan/Pod-Perldoc/lib/Pod/Perldoc/BaseTo.pm (revision ae3cb403620ab940fbaabb3055fac045a63d56b7)
1package Pod::Perldoc::BaseTo;
2use strict;
3use warnings;
4
5use vars qw($VERSION);
6$VERSION = '3.25';
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_bitrig = $^O =~ m/bitrig/ ? \&TRUE : \&FALSE unless defined &is_bitrig;
37}
38
39sub _perldoc_elem {
40  my($self, $name) = splice @_,0,2;
41  if(@_) {
42    $self->{$name} = $_[0];
43  } else {
44    $self->{$name};
45  }
46}
47
48sub debugging {
49	my( $self, @messages ) = @_;
50
51    ( defined(&Pod::Perldoc::DEBUG) and &Pod::Perldoc::DEBUG() )
52	}
53
54sub debug {
55	my( $self, @messages ) = @_;
56	return unless $self->debugging;
57	print STDERR map { "DEBUG $_" } @messages;
58	}
59
60sub warn {
61	my( $self, @messages ) = @_;
62	carp join "\n", @messages, '';
63	}
64
65sub die {
66	my( $self, @messages ) = @_;
67	croak join "\n", @messages, '';
68	}
69
70sub _get_path_components {
71	my( $self ) = @_;
72
73	my @paths = split /\Q$Config{path_sep}/, $ENV{PATH};
74
75	return @paths;
76	}
77
78sub _find_executable_in_path {
79	my( $self, $program ) = @_;
80
81	my @found = ();
82	foreach my $dir ( $self->_get_path_components ) {
83		my $binary = catfile( $dir, $program );
84		$self->debug( "Looking for $binary\n" );
85		next unless -e $binary;
86		unless( -x $binary ) {
87			$self->warn( "Found $binary but it's not executable. Skipping.\n" );
88			next;
89			}
90		$self->debug( "Found $binary\n" );
91		push @found, $binary;
92		}
93
94	return @found;
95	}
96
971;
98
99__END__
100
101=head1 NAME
102
103Pod::Perldoc::BaseTo - Base for Pod::Perldoc formatters
104
105=head1 SYNOPSIS
106
107    package Pod::Perldoc::ToMyFormat;
108
109    use parent qw( Pod::Perldoc::BaseTo );
110    ...
111
112=head1 DESCRIPTION
113
114This package is meant as a base of Pod::Perldoc formatters,
115like L<Pod::Perldoc::ToText>, L<Pod::Perldoc::ToMan>, etc.
116
117It provides default implementations for the methods
118
119    is_pageable
120    write_with_binmode
121    output_extension
122    _perldoc_elem
123
124The concrete formatter must implement
125
126    new
127    parse_from_file
128
129=head1 SEE ALSO
130
131L<perldoc>
132
133=head1 COPYRIGHT AND DISCLAIMERS
134
135Copyright (c) 2002-2007 Sean M. Burke.
136
137This library is free software; you can redistribute it and/or modify it
138under the same terms as Perl itself.
139
140This program is distributed in the hope that it will be useful, but
141without any warranty; without even the implied warranty of
142merchantability or fitness for a particular purpose.
143
144=head1 AUTHOR
145
146Current maintainer: Mark Allen C<< <mallen@cpan.org> >>
147
148Past contributions from:
149brian d foy C<< <bdfoy@cpan.org> >>
150Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
151Sean M. Burke C<< <sburke@cpan.org> >>
152
153=cut
154