/usr/share/perl5/Module/Reader.pm is in libmodule-reader-perl 0.002001-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 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | package Module::Reader;
BEGIN { require 5.006 }
use strict;
use warnings;
our $VERSION = '0.002001';
$VERSION = eval $VERSION;
use base 'Exporter';
our @EXPORT_OK = qw(module_content module_handle);
our %EXPORT_TAGS = (all => [@EXPORT_OK]);
use File::Spec;
use Scalar::Util qw(blessed reftype openhandle);
use Carp;
use constant _OPEN_STRING => $] >= 5.008;
BEGIN {
require IO::String
if !_OPEN_STRING;
}
sub module_content {
my $module = _get_module(@_);
if (ref $module) {
local $/;
return scalar <$module>;
}
else {
return $module;
}
}
sub module_handle {
my $module = _get_module(@_);
if (ref $module) {
return $module;
}
elsif (_OPEN_STRING) {
open my $fh, '<', \$module;
return $fh;
}
else {
return IO::String->new($module);
}
}
sub _get_module {
my ($package, @inc) = @_;
(my $module = "$package.pm") =~ s{::}{/}g;
my $opts = ref $_[-1] && ref $_[-1] eq 'HASH' && pop @inc || {};
if (!@inc) {
@inc = @INC;
}
if (my $found = $opts->{found}) {
if (my $full_module = $found->{$module}) {
if (ref $full_module) {
@inc = $full_module;
}
elsif (-f $full_module) {
open my $fh, '<', $full_module
or die "Couldn't open ${full_module} for ${module}: $!";
return $fh;
}
}
}
for my $inc (@inc) {
if (!ref $inc) {
my $full_module = File::Spec->catfile($inc, $module);
next unless -f $full_module;
open my $fh, '<', $full_module
or die "Couldn't open ${full_module} for ${module}: $!";
return $fh;
}
my @cb = ref $inc eq 'ARRAY' ? $inc->[0]->($inc, $module)
: blessed $inc ? $inc->INC($module)
: $inc->($inc, $module);
next
unless ref $cb[0];
my $fh;
if (reftype $cb[0] eq 'GLOB' && openhandle $cb[0]) {
$fh = shift @cb;
}
if (ref $cb[0] eq 'CODE') {
my $cb = shift @cb;
# require docs are wrong, perl sends 0 as the first param
my @params = (0, @cb ? $cb[0] : ());
my $module = '';
while (1) {
local $_ = $fh ? <$fh> : '';
$_ = ''
if !defined;
last if !$cb->(@params);
$module .= $_;
}
return $module;
}
elsif ($fh) {
return $fh;
}
}
croak "Can't find module $module";
}
1;
__END__
=head1 NAME
Module::Reader - Read the source of a module like perl does
=head1 SYNOPSIS
use Module::Reader qw(:all);
my $io = module_handle('My::Module');
my $content = module_content('My::Module');
my $io = module_handle('My::Module', @search_dirs);
my $io = module_handle('My::Module', @search_dirs, { found => \%INC });
=head1 DESCRIPTION
Reads the content of perl modules the same way perl does. This
includes reading modules available only by L<@INC hooks|perlfunc/require>, or filtered
through them.
=head1 EXPORTS
=head2 module_handle( $module_name, @search_dirs, \%options )
Returns an IO handle to the given module. Searches the directories
specified, or L<@INC|perlvar/@INC> if none are.
=head3 Options
=over 4
=item found
A reference to a hash like L<%INC|perlvar/%INC> with module file names (in the
style 'F<My/Module.pm>') as keys and full file paths as values.
Modules listed in this will be used in preference to searching
through directories.
=back
=head2 module_content( $module_name, @search_dirs, \%options )
Returns the content of the given module. Accepts the same options as C<module_handle>.
=head1 AUTHOR
haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
=head2 CONTRIBUTORS
None yet.
=head1 COPYRIGHT
Copyright (c) 2013 the Module::Reader L</AUTHOR> and L</CONTRIBUTORS>
as listed above.
=head1 LICENSE
This library is free software and may be distributed under the same terms
as perl itself.
=cut
|