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