/Pod-Perldoc-3.17/lib/Pod/Perldoc/BaseTo.pm

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