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

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