/usr/share/perl5/POD2/Base.pm is in libpod2-base-perl 0.043-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | package POD2::Base;
use 5.005;
use strict;
use warnings;
use vars qw( $VERSION );
$VERSION = '0.043';
use File::Spec ();
sub new {
my $proto = shift;
my $class = ref $proto || $proto;
my $obj = bless {}, $class;
return $obj->_init( @_ );
}
# instance variables:
# lang - the preferred language of the POD documents
# inc - alternate library dirs (if given, replaces the ones in @INC)
sub _init {
my $self = shift;
my %args = @_ ? %{$_[0]} : ();
if ( !exists $args{lang} ) {
$args{lang} = _extract_lang( ref $self );
}
#croak "???" unless $args{lang};
my $lang = uc $args{lang};
$self->{lang} = $lang;
$self->{inc} = $args{inc}; # XXX croak ?! must be array ref
return $self;
}
# $lang = _extract_lang($module);
sub _extract_lang {
my $module = shift;
return $module eq __PACKAGE__ ? undef
: $module =~ /::(\w+)\z/ ? $1
: undef
;
}
sub _lib_dirs {
my $self = shift;
return $self->{inc} ? @{$self->{inc}} : @INC;
}
sub pod_dirs {
my $self = shift;
my %options = @_ ? %{$_[0]} : ();
$options{test} = 1 unless exists $options{test};
my $lang = $self->{lang};
my @candidates = map { File::Spec->catdir( $_, 'POD2', $lang ) } $self->_lib_dirs; # XXX the right thing to do
if ( $options{test} ) {
return grep { -d } @candidates;
}
return @candidates;
}
#sub search_perlfunc_re {
# shift;
# return 'Alphabetical Listing of Perl Functions';
#}
sub pod_info {
shift;
return {};
}
sub print_pods {
my $self = shift;
$self->print_pod(sort keys %{$self->pod_info});
}
sub print_pod {
my $self = shift;
my @args = @_ ? @_ : @ARGV;
my $pods = $self->pod_info;
while (@args) {
(my $pod = lc(shift @args)) =~ s/\.pod$//;
if ( exists $pods->{$pod} ) {
print "\t'$pod' translated from Perl $pods->{$pod}\n";
}
else {
print "\t'$pod' doesn't yet exists\n";
}
}
}
1;
|