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