Module-Reader-0.003003/000755 000765 000024 00000000000 13122516417 014647 5ustar00gknopstaff000000 000000 Module-Reader-0.003003/Changes000644 000765 000024 00000003243 13122516407 016143 0ustar00gknopstaff000000 000000 Revision history for Module-Reader
0.003003 - 2017-06-21
- fix EACCES handling to match the current perl
- fix raw file handle access for unopened files
- call @INC hooks for ./, ../, and / paths if they weren't found directly
- add handling for a string reference prefix return from a hook
0.003002 - 2016-12-14
- releasing as stable
0.003_001 - 2016-11-30
- fix links and formatting in pod
- fix some edge cases with arrayref hooks
- fix tests on Win32
- fix 5.6 support
- fix cperl support
0.003_000 - 2016-11-27
* Features
- add new object based interface, with more controls
- result objects include more information, including found filenames and
the @INC entry found in
- searches can be performed by filename rather than module name
- handle ./ and ../ like perl core for file searches
- list of all findable files can be returned
* Bug Fixes
- fix @INC hook edge case
- adjust error messages to match perl core
- handle special files (character devices, fifos) correctly
- handle permission denied errors correctly
- support pmc files
- ignore -C/PERL_UNICODE layers, as perl does
0.002003 - 2014-08-21
- fix dist name in meta files
0.002002 - 2014-08-16
- include README in dist
- include additional metadata
0.002001 - Nov 23, 2013
- fix module NAME in Makefile.PL
- minor doc corrections
- fix in-memory file test on perl 5.6
0.002000 - Feb 11, 2013
- Improve documentation.
- Add 'found' option for always loading from specific files.
0.001002 - Feb 2, 2013
- fix copyright attribution
0.001001 - Feb 1, 2013
- fix version number format
0.001000 - Feb 1, 2013
- initial version
Module-Reader-0.003003/lib/000755 000765 000024 00000000000 13122516417 015415 5ustar00gknopstaff000000 000000 Module-Reader-0.003003/maint/000755 000765 000024 00000000000 13122516417 015757 5ustar00gknopstaff000000 000000 Module-Reader-0.003003/Makefile.PL000644 000765 000024 00000004653 13005616173 016631 0ustar00gknopstaff000000 000000 use strict;
use warnings FATAL => 'all';
use 5.006;
my %META = (
name => 'Module-Reader',
prereqs => {
configure => { requires => {
'ExtUtils::MakeMaker' => 0,
} },
test => { requires => {
'Test::More' => 0.88,
} },
runtime => { requires => {
'perl' => '5.006',
'Scalar::Util' => 0,
} },
},
resources => {
repository => {
url => 'git://github.com/haarg/Module-Reader',
web => 'https://github.com/haarg/Module-Reader',
type => 'git',
},
bugtracker => {
web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Reader',
mailto => 'bug-Module-Reader@rt.cpan.org',
},
license => [ 'http://dev.perl.org/licenses/' ],
},
);
my %MM_ARGS = (
PREREQ_PM => {
($] < 5.008 ? ('IO::String' => 0) : ()),
},
);
## BOILERPLATE ###############################################################
require ExtUtils::MakeMaker;
(do './maint/Makefile.PL.include' or die $@) unless -f 'META.yml';
# have to do this since old EUMM dev releases miss the eval $VERSION line
my $eumm_version = eval $ExtUtils::MakeMaker::VERSION;
my $mymeta = $eumm_version >= 6.57_02;
my $mymeta_broken = $mymeta && $eumm_version < 6.57_07;
($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g;
($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g;
$META{license} = [ $META{license} ]
if $META{license} && !ref $META{license};
$MM_ARGS{LICENSE} = $META{license}[0]
if $META{license} && $eumm_version >= 6.30;
$MM_ARGS{NO_MYMETA} = 1
if $mymeta_broken;
$MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META }
unless -f 'META.yml';
for (qw(configure build test runtime)) {
my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES';
my $r = $MM_ARGS{$key} = {
%{$META{prereqs}{$_}{requires} || {}},
%{delete $MM_ARGS{$key} || {}},
};
defined $r->{$_} or delete $r->{$_} for keys %$r;
}
$MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0;
delete $MM_ARGS{MIN_PERL_VERSION}
if $eumm_version < 6.47_01;
$MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}}
if $eumm_version < 6.63_03;
$MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}}
if $eumm_version < 6.55_01;
delete $MM_ARGS{CONFIGURE_REQUIRES}
if $eumm_version < 6.51_03;
ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS);
## END BOILERPLATE ###########################################################
Module-Reader-0.003003/MANIFEST000644 000765 000024 00000000651 13122516417 016002 0ustar00gknopstaff000000 000000 Changes
lib/Module/Reader.pm
maint/Makefile.PL.include
Makefile.PL
MANIFEST This list of files
t/file-types.t
t/lib/InlineModule.pm
t/main.t
t/memory.t
t/test-data/lib/MyTestModule.pm
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
README README file (added by Distar)
Module-Reader-0.003003/META.json000644 000765 000024 00000002645 13122516417 016277 0ustar00gknopstaff000000 000000 {
"abstract" : "Find and read perl modules like perl does",
"author" : [
"haarg - Graham Knop (cpan:HAARG) "
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "Module-Reader",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Scalar::Util" : "0",
"perl" : "5.006"
}
},
"test" : {
"requires" : {
"Test::More" : "0.88"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"mailto" : "bug-Module-Reader@rt.cpan.org",
"web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Reader"
},
"license" : [
"http://dev.perl.org/licenses/"
],
"repository" : {
"type" : "git",
"url" : "git://github.com/haarg/Module-Reader",
"web" : "https://github.com/haarg/Module-Reader"
}
},
"version" : "0.003003",
"x_serialization_backend" : "JSON::PP version 2.94"
}
Module-Reader-0.003003/META.yml000644 000765 000024 00000001421 13122516417 016116 0ustar00gknopstaff000000 000000 ---
abstract: 'Find and read perl modules like perl does'
author:
- 'haarg - Graham Knop (cpan:HAARG) '
build_requires:
Test::More: '0.88'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Module-Reader
no_index:
directory:
- t
- inc
requires:
Scalar::Util: '0'
perl: '5.006'
resources:
bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Reader
license: http://dev.perl.org/licenses/
repository: git://github.com/haarg/Module-Reader
version: '0.003003'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
Module-Reader-0.003003/README000644 000765 000024 00000017541 13122516417 015537 0ustar00gknopstaff000000 000000 NAME
Module::Reader - Find and read perl modules like perl does
SYNOPSIS
use Module::Reader;
my $reader = Module::Reader->new;
my $module = $reader->module("My::Module");
my $filename = $module->found_file;
my $content = $module->content;
my $file_handle = $module->handle;
# search options
my $other_reader = Module::Reader->new(inc => ["/some/lib/dir", "/another/lib/dir"]);
my $other_reader2 = Module::Reader->new(found => { 'My/Module.pm' => '/a_location.pm' });
# Functional Interface
use Module::Reader qw(module_handle module_content);
my $io = module_handle('My::Module');
my $content = module_content('My::Module');
DESCRIPTION
This module finds modules in @INC using the same algorithm perl does.
From that, it will give you the source content of a module, the file
name (where available), and how it was found. Searches (and content) are
based on the same internal rules that perl uses for
require|perlfunc/require and do|perlfunc/do.
EXPORTS
module_handle ( $module_name, @search_directories )
Returns an IO handle for the given module.
module_content ( $module_name, @search_directories )
Returns the content of a given module.
ATTRIBUTES
inc An array reference containing a list of directories or hooks to
search for modules or files. This will be used in the same manner
that require uses @INC. If not provided, @INC itself will be used.
found
A hash reference of module filenames (of "My/Module.pm" format>) to
files that exist on disk, working the same as %INC. The values can
optionally be an @INC hook. This option can also be 1, in which case
%INC will be used instead.
pmc A boolean controlling if ".pmc" files should be found in preference
to ".pm" files. If not specified, the same behavior perl was
compiled with will be used.
open
A boolean controlling if the files found will be opened immediately
when found. Defaults to true.
abort_on_eacces
A boolean controlling if an error should be thrown or if the path
should be skipped when encountering "EACCES" (access denied) errors.
Defaults to true on perl 5.18 and above, matching the behavior of
require.
check_hooks_for_nonsearchable
For non-searchable paths (absolute paths and those starting with
"./" or "../") attempt to check the hook items (and not the
directories) in @INC if the file cannot be found directly. This
matches the behavior of perl. Defaults to true.
METHODS
module
Returns a file object for the given module name. If the module can't be
found, an exception will be raised.
file
Returns a file object for the given file name. If the file can't be
found, an exception will be raised. For absolute paths, or files
starting with "./" or "../" (and ".\" or "..\" on Windows), no directory
search will be performed.
modules
Returns an array of file objects for a given module name. This will give
every file that could be loaded based on the "inc" options.
files
Returns an array of file objects for a given file name. This will give
every file that could be loaded based on the "inc" options.
FILE OBJECTS
The file objects returned represent an entry that could be found in
@INC. While they will generally be files that exist on the file system
somewhere, they may also represent files that only exist only in memory
or have arbitrary filters applied.
FILE METHODS
filename
The filename that was searched for.
module
If a module was searched for, or a file of the matching form
("My/Module.pm"), this will be the module searched for.
found_file
The path to the file found by require.
This may not represent an actual file that exists, but the file name
that perl will use for the file for things like caller or __FILE__.
For ".pmc" files, this will be the ".pm" form of the file.
For @INC hooks this will be a file name of the form
"/loader/0x123456abcdef/My/Module.pm", matching how perl treats them
internally.
disk_file
The path to the file that exists on disk. When the file is found via an
@INC hook, this will be undef.
content
The content of the found file.
handle
A file handle to the found file's content.
is_pmc
A boolean value representing if the file found was ".pmc" variant of the
file requested.
inc_entry
The directory or hook that was used to find the given file or module. If
"found" is used, this may be undef.
RAW HOOK DATA
File objects also have methods for the raw file handle and read
callbacks used to read a file. Interacting with the handle or callback
can impact the return values of "content" and "handle", and vice versa.
It should generally be avoided unless you are introspecting the @INC
hooks|perlfunc/require.
raw_filehandle
The raw file handle to the file found. This will be either a file handle
to a file found on disk, or something returned by an @INC
hook|perlfunc/require. The hook callback, if it exists, will not be
taken into account by this method.
read_callback
A callback used to read content, or modify a file handle from an @INC
hook.
read_callback_options
An array reference of arguments to send to the read callback whem
reading or modifying content from a file handle. Will contain either
zero or one entries.
SEE ALSO
Numerous other modules attempt to do @INC searches similar to this
module, but no other module accurately represents how perl itself uses
@INC. Most don't match perl's behavior regarding character and block
devices, directories, or permissions. Often, ".pmc" files are not taken
into account.
Some of these modules have other use cases. The following comments are
primarily related to their ability to search @INC.
App::moduleswhere
Only available as a command line utility. Inaccurately gives the
first file found on disk in @INC.
App::whichpm
Inaccurately gives the first file found on disk in @INC.
Class::Inspector
For unloaded modules, inaccurately checks if a module exists.
Module::Data
Same caveats as "Path::ScanINC".
Module::Filename
Inaccurately gives the first file found on disk in @INC.
Module::Finder
Inaccurately searches for ".pm" and ".pmc" files in subdirectories
of @INC.
Module::Info
Inaccurately searches @INC for files and gives inaccurate
information for the files that it finds.
Module::Locate
Inaccurately searches @INC for matching files. Attempts to handle
hooks, but handles most cases wrong.
Module::Mapper
Searches for ".pm" and ".pod" files in relatively unpredictable
fashion, based usually on the current directory. Optionally, can
inaccurately scan @INC.
Module::Metadata
Primarily designed as a version number extractor. Meant to find
files on disk, avoiding the nuance involved in perl's file loading.
Module::Path
Inaccurately gives the first file found on disk in @INC.
Module::Util
Inaccurately searches for modules, ignoring @INC hooks.
Path::ScanINC
Inaccurately searches for files, with confusing output for @INC
hooks.
Pod::Perldoc
Primarily meant for searching for related documentation. Finds
related module files, or sometimes ".pod" files. Unpredictable
search path.
AUTHOR
haarg - Graham Knop (cpan:HAARG)
CONTRIBUTORS
None yet.
COPYRIGHT
Copyright (c) 2013 the Module::Reader "AUTHOR" and "CONTRIBUTORS" as
listed above.
LICENSE
This library is free software and may be distributed under the same
terms as perl itself.
Module-Reader-0.003003/t/000755 000765 000024 00000000000 13122516417 015112 5ustar00gknopstaff000000 000000 Module-Reader-0.003003/t/file-types.t000644 000765 000024 00000007375 13077530344 017400 0ustar00gknopstaff000000 000000 use strict;
use warnings;
use Test::More 0.88;
use Module::Reader;
use File::Temp;
use File::Spec;
use Cwd;
my $dir = File::Temp->newdir('module-reader-XXXXXX', TMPDIR => 1);
my @inc;
my %types = (
file => sub {
open my $fh, '>', "$_[0]"
or die "can't create file $_[0]: $!";
print { $fh } "1;";
close $fh;
},
dir => sub {
mkdir $_[0];
},
);
if (eval { symlink 'target', "$dir/link-test" }) {
$types{link} = sub {
my ($fh, $file) = File::Temp::tempfile('linked-file-XXXXXX', DIR => $dir, UNLINK => 0);
print { $fh } "1;";
close $fh;
symlink $file, $_[0];
};
$types{badlink} = sub {
symlink "nonexistant", $_[0];
};
}
# root will bypass permissions, but double check that our chmod is working
if ($> != 0) {
my $unreadable = sub {
$types{file}->($_[0]);
chmod 0000, $_[0];
};
$unreadable->("$dir/unreadable-file");
if (!open my $fh, '<', "$dir/unreadable-file") {
$types{unreadable} = $unreadable;
}
}
my %type_act = (
file => 'pass',
dir => 'skip',
link => 'pass',
badlink => 'skip',
unreadable => 'error',
);
my $fallback = sub {
my $once;
sub {
return 0 if $once++;
$_ .= '1;';
return 1;
};
};
for my $type (keys %types) {
mkdir "$dir/$type";
$types{$type}->("$dir/$type/TestModule.pm");
$types{file}->("$dir/$type/TestModule.pmc");
}
for my $type_1 (sort keys %types) {
my $inc_1 = "$dir/$type_1";
for my $type_2 (sort keys %types) {
my $inc_2 = "$dir/$type_2";
my $reader = Module::Reader->new(inc => [$inc_1, $inc_2, $fallback], pmc => 0, abort_on_eacces => 1);
my $found = eval { $reader->module('TestModule') };
my ($want)
= map +($type_act{$_} eq 'pass' ? $_ : $type_act{$_}),
grep $type_act{$_} ne 'skip',
$type_1, $type_2;
$want ||= 'none';
my $got
= !defined $found ? 'error'
: ref $found->inc_entry ? 'none'
: $found->disk_file =~ m{^\Q$dir\E/(.*)/TestModule\.pm(c?)$} ? ($1.($2?' pmc':''))
: 'unknown';
is $got, $want, "search of $type_1, $type_2 found $want";
}
}
my $cwd = Cwd::cwd;
END { chdir $cwd }
for my $type (sort keys %types) {
for my $pmc_type (sort keys %types) {
my $inc = "$dir/$type/$pmc_type";
mkdir $inc;
chdir $inc;
$types{$type}->("$inc/TestModule.pm");
$types{$pmc_type}->("$inc/TestModule.pmc");
my $want
= $type_act{$pmc_type} eq 'pass' ? 'pmc'
: $type_act{$type} eq 'skip' ? 'none'
: $type_act{$type} eq 'pass' ? 'pm'
: 'error';
for my $read_opts (
['normal', {
inc => [$inc, $fallback],
pmc => 1,
abort_on_eacces => 1,
}, 'TestModule.pm'],
['found', {
found => { 'TestModule.pm' => "$inc/TestModule.pm" },
inc => [$fallback],
pmc => 1,
abort_on_eacces => 1,
}, 'TestModule.pm'],
['relative', {
inc => [$fallback],
pmc => 1,
abort_on_eacces => 1,
}, './TestModule.pm', $inc],
) {
my ($name, $opts, $file, $chdir) = @$read_opts;
chdir $chdir
if defined $chdir;
my $reader = Module::Reader->new(%$opts);
my $found = eval { $reader->file($file) };
my $error = $@;
my $want = $want eq 'none' && $file =~ /^\./ ? 'error' : $want;
my $got
= !defined $found ? 'error'
: ref $found->inc_entry ? 'none'
: $found->is_pmc ? 'pmc'
: 'pm';
my $ok = is $got, $want, "$name search of $type with $pmc_type pmc found $want";
if ($got eq 'error') {
if ($ok) {
note "Got error: ".$error;
}
else {
diag "Got error: ".$error;
}
}
chdir $cwd;
}
}
}
done_testing;
Module-Reader-0.003003/t/lib/000755 000765 000024 00000000000 13122516417 015660 5ustar00gknopstaff000000 000000 Module-Reader-0.003003/t/main.t000644 000765 000024 00000000520 13103335552 016216 0ustar00gknopstaff000000 000000 use strict;
use warnings;
use Test::More 0.88;
use Module::Reader qw(:all);
use lib 't/test-data/lib';
my $mod_content = do {
open my $fh, '<'.Module::Reader::_OPEN_LAYERS, 't/test-data/lib/MyTestModule.pm';
local $/;
<$fh>;
};
is module_content('MyTestModule'), $mod_content, 'correctly load module from disk';
done_testing;
Module-Reader-0.003003/t/memory.t000644 000765 000024 00000005733 13077432400 016615 0ustar00gknopstaff000000 000000 use strict;
use warnings;
no warnings 'once';
use Test::More 0.88;
use Module::Reader qw(:all);
use lib 't/lib';
use InlineModule;
BEGIN {
*_HAS_PERLIO = "$]" >= 5.008_000 ? sub(){1} : sub(){0};
}
my $mod_content = do {
open my $fh, (_HAS_PERLIO ? '<:' : '<'), 't/test-data/lib/MyTestModule.pm';
local $/;
<$fh>;
};
{
local @INC = (
InlineModule::inc_hook('MyTestModule' => $mod_content),
@INC,
);
is module_content('MyTestModule'), $mod_content,
'correctly load module from sub @INC hook';
require MyTestModule;
SKIP: {
skip 'found option doesn\'t work with @INC hooks in perl < 5.8', 2
if "$]" < 5.008;
local @INC = @INC;
my $content = '1;';
unshift @INC, InlineModule::inc_hook( MyTestModule => $content );
is module_content('MyTestModule'), '1;',
'loads overridden module from sub @INC hook';
is module_content('MyTestModule', { found => \%INC } ), $mod_content,
'found => \%INC loads mod as it was required';
}
{
local $TODO = "unable to accurately calculate fake filename on perl 5.6"
if "$]" < 5.008;
is +Module::Reader->new->module('MyTestModule')->found_file, $MyTestModule::FILENAME,
'calculated file matches loaded filename';
}
}
sub ParentHook::INC {
die "hook\n";
}
@ChildHook::ISA = qw(ParentHook);
{
my $base_hook = InlineModule::inc_hook( MyTestModule => $mod_content );
for my $fake_hook (
['hook returning an array ref' => sub { return [] }],
['hook returning a hash ref' => sub { return {} }],
) {
my $name = $fake_hook->[0];
my @inc = ($fake_hook->[1], $base_hook);
is module_content('MyTestModule', { inc => \@inc }), $mod_content,
"$name is ignored";
}
}
sub main::stringy_sub { return }
sub FQ::stringy_sub { return }
{
my $uniq = 0;
for my $hook (
['hash ref' => {}],
['scalar ref' => \(my $s)],
['regex' => qr/\./],
['class without INC' => bless {}, 'NonHook'],
['class with INC hook' => bless {}, 'ParentHook'],
['child class of INC hook' => bless {}, 'ChildHook'],
['array ref without code' => []],
['array ref with string' => ["welp"]],
['array ref with stringy main sub' => ["stringy_sub"]],
['array ref with stringy fully qualified sub' => ["FQ::stringy_sub"]],
['array ref with hash ref' => [{}]],
['array ref with code' => [sub { return }]],
) {
my $class = 'MyTestModule'.++$uniq;
my $name = $hook->[0];
my @inc = ($hook->[1], sub { return unless $_[1] eq "$class.pm"; inc_module($mod_content) });
eval {
local @INC = @inc;
no warnings 'uninitialized';
require "$class.pm";
};
(my $req_e = $@) =~ s/ at .*//s;
undef $req_e if $req_e eq "hook\n";
eval {
module_content($class, { inc => \@inc });
};
(my $e = $@) =~ s/ at .*//s;
undef $e if $e eq "hook\n";
is $e, $req_e,
$name . ($req_e ? ' fails' :' works') . ' the same as require';
}
}
done_testing;
Module-Reader-0.003003/t/test-data/000755 000765 000024 00000000000 13122516417 017000 5ustar00gknopstaff000000 000000 Module-Reader-0.003003/t/test-data/lib/000755 000765 000024 00000000000 13122516417 017546 5ustar00gknopstaff000000 000000 Module-Reader-0.003003/t/test-data/lib/MyTestModule.pm000644 000765 000024 00000000065 13077431277 022511 0ustar00gknopstaff000000 000000 package MyTestModule;
our $FILENAME = __FILE__;
1;
Module-Reader-0.003003/t/lib/InlineModule.pm000644 000765 000024 00000001746 13077432005 020611 0ustar00gknopstaff000000 000000 package InlineModule;
use strict;
use warnings;
BEGIN {
*_HAS_PERLIO = "$]" >= 5.008_000 ? sub(){1} : sub(){0};
}
sub import {
my ($class, %modules) = @_;
unshift @INC, inc_hook(%modules)
if %modules;
}
sub inc_hook {
my (%modules) = @_;
my %files = map {
(my $file = "$_.pm") =~ s{::}{/}g;
$file => $modules{$_};
} keys %modules;
sub {
return
unless exists $files{$_[1]};
my $module = $files{$_[1]};
if (!defined $module) {
die "Can't locate $_[1] in \@INC (hidden) (\@INC contains: @INC).\n";
}
inc_module($module);
}
}
sub inc_module {
my $code = $_[0];
if (_HAS_PERLIO) {
open my $fh, '<', \$code
or die "error loading module: $!";
return $fh;
}
else {
my $pos = 0;
my $last = length $code;
return (sub {
return 0 if $pos == $last;
my $next = (1 + index $code, "\n", $pos) || $last;
$_ .= substr $code, $pos, $next - $pos;
$pos = $next;
return 1;
});
}
}
1;
Module-Reader-0.003003/maint/Makefile.PL.include000644 000765 000024 00000000407 13103336042 021345 0ustar00gknopstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") }
use lib 'Distar/lib';
use Distar;
use ExtUtils::MakeMaker 6.58;
author 'haarg - Graham Knop (cpan:HAARG) ';
manifest_include 't/test-data/lib' => '.pm';
Module-Reader-0.003003/lib/Module/000755 000765 000024 00000000000 13122516417 016642 5ustar00gknopstaff000000 000000 Module-Reader-0.003003/lib/Module/Reader.pm000644 000765 000024 00000040670 13122516405 020406 0ustar00gknopstaff000000 000000 package Module::Reader;
BEGIN { require 5.006 }
use strict;
use warnings;
our $VERSION = '0.003003';
$VERSION = eval $VERSION;
use Exporter (); BEGIN { *import = \&Exporter::import }
our @EXPORT_OK = qw(module_content module_handle);
our %EXPORT_TAGS = (all => [@EXPORT_OK]);
use File::Spec ();
use Scalar::Util qw(reftype refaddr openhandle);
use Carp qw(croak);
use Config ();
use Errno qw(EACCES);
use constant _OPEN_LAYERS => "$]" >= 5.008_000 ? ':' : '';
use constant _ABORT_ON_EACCES => "$]" >= 5.017_001;
use constant _ALLOW_PREFIX => "$]" >= 5.008009;
use constant _VMS => $^O eq 'VMS' && !!require VMS::Filespec;
use constant _WIN32 => $^O eq 'MSWin32';
use constant _PMC_ENABLED => !(
exists &Config::non_bincompat_options
? grep { $_ eq 'PERL_DISABLE_PMC' } Config::non_bincompat_options()
: $Config::Config{ccflags} =~ /(?:^|\s)-DPERL_DISABLE_PMC\b/
);
use constant _FAKE_FILE_FORMAT => do {
my $uvx = $Config::Config{uvxformat} || '';
$uvx =~ tr/"\0//d;
$uvx ||= 'lx';
"/loader/0x%$uvx/%s"
};
sub _mod_to_file {
my $module = shift;
(my $file = "$module.pm") =~ s{::}{/}g;
$file;
}
sub module_content {
my $opts = ref $_[-1] eq 'HASH' && pop @_ || {};
my $module = shift;
$opts->{inc} = [@_]
if @_;
__PACKAGE__->new($opts)->module($module)->content;
}
sub module_handle {
my $opts = ref $_[-1] eq 'HASH' && pop @_ || {};
my $module = shift;
$opts->{inc} = [@_]
if @_;
__PACKAGE__->new($opts)->module($module)->handle;
}
sub new {
my $class = shift;
my %options;
if (@_ == 1 && ref $_[-1]) {
%options = %{(pop)};
}
elsif (@_ % 2 == 0) {
%options = @_;
}
else {
croak "Expected hash ref, or key value pairs. Got ".@_." arguments.";
}
$options{inc} ||= \@INC;
$options{found} = \%INC
if exists $options{found} && $options{found} eq 1;
$options{pmc} = _PMC_ENABLED
if !exists $options{pmc};
$options{open} = 1
if !exists $options{open};
$options{abort_on_eacces} = _ABORT_ON_EACCES
if !exists $options{abort_on_eacces};
$options{check_hooks_for_nonsearchable} = 1
if !exists $options{check_hooks_for_nonsearchable};
bless \%options, $class;
}
sub module {
my ($self, $module) = @_;
$self->file(_mod_to_file($module));
}
sub modules {
my ($self, $module) = @_;
$self->files(_mod_to_file($module));
}
sub file {
my ($self, $file) = @_;
$self->_find($file);
}
sub files {
my ($self, $file) = @_;
$self->_find($file, 1);
}
sub _searchable {
my $file = shift;
File::Spec->file_name_is_absolute($file) ? 0
: _WIN32 && $file =~ m{^\.\.?[/\\]} ? 0
: $file =~ m{^\.\.?/} ? 0
: 1
}
sub _find {
my ($self, $file, $all) = @_;
my @found;
eval {
if (my $found = $self->{found}) {
if (defined( my $full = $found->{$file} )) {
my $open = length ref $full ? $self->_open_ref($full, $file)
: $self->_open_file($full, $file);
push @found, $open
if $open;
}
}
};
if (!$all) {
return $found[0]
if @found;
die $@
if $@;
}
my $searchable = _searchable($file);
if (!$searchable) {
my $open = $self->_open_file($file);
if ($all) {
push @found, $open;
}
elsif ($open) {
return $open;
}
else {
croak "Can't locate $file";
}
}
my $search = $self->{inc};
for my $inc (@$search) {
my $open;
if (!$searchable) {
last
if !$self->{check_hooks_for_nonsearchable};
next
if !length ref $inc;
}
eval {
if (!length ref $inc) {
my $full = _VMS ? VMS::Filespec::unixpath($inc) : $inc;
$full =~ s{/?$}{/};
$full .= $file;
$open = $self->_open_file($full, $file, $inc);
}
else {
$open = $self->_open_ref($inc, $file);
}
push @found, $open
if $open;
};
if (!$all) {
return $found[0]
if @found;
die $@
if $@;
}
}
croak "Can't locate $file"
if !$all;
return @found;
}
sub _open_file {
my ($self, $full, $file, $inc) = @_;
$file = $full
if !defined $file;
for my $try (
($self->{pmc} && $file =~ /\.pm\z/ ? $full.'c' : ()),
$full,
) {
my $pmc = $full ne $try;
if (-e $try) {
next
if -d _ || -b _;
if (open my $fh, '<'._OPEN_LAYERS, $try) {
return Module::Reader::File->new(
filename => $file,
($self->{open} ? (raw_filehandle => $fh) : ()),
found_file => $full,
disk_file => $try,
is_pmc => $pmc,
(defined $inc ? (inc_entry => $inc) : ()),
);
}
}
croak "Can't locate $file: $full: $!"
if $self->{abort_on_eacces} && $! == EACCES && !$pmc;
}
return;
}
sub _open_ref {
my ($self, $inc, $file) = @_;
my @cb;
{
# strings in arrayrefs are taken as sub names relative to main
package
main;
no strict 'refs';
no warnings 'uninitialized';
@cb = defined Scalar::Util::blessed $inc ? $inc->INC($file)
: ref $inc eq 'ARRAY' ? $inc->[0]->($inc, $file)
: $inc->($inc, $file);
}
return
unless length ref $cb[0];
my $fake_file = sprintf _FAKE_FILE_FORMAT, refaddr($inc), $file;
my $fh;
my $prefix;
my $cb;
my $cb_options;
if (_ALLOW_PREFIX && reftype $cb[0] eq 'SCALAR') {
$prefix = shift @cb;
}
if ((reftype $cb[0]||'') eq 'GLOB' && openhandle $cb[0]) {
$fh = shift @cb;
}
if ((reftype $cb[0]||'') eq 'CODE') {
$cb = $cb[0];
# only one or zero callback options will be passed
$cb_options = @cb > 1 ? [ $cb[1] ] : undef;
}
elsif (!defined $fh && !defined $prefix) {
return;
}
return Module::Reader::File->new(
filename => $file,
found_file => $fake_file,
inc_entry => $inc,
(defined $prefix ? (prefix => $prefix) : ()),
(defined $fh ? (raw_filehandle => $fh) : ()),
(defined $cb ? (read_callback => $cb) : ()),
(defined $cb_options ? (read_callback_options => $cb_options) : ()),
);
}
sub inc { $_[0]->{inc} }
sub found { $_[0]->{found} }
sub pmc { $_[0]->{pmc} }
sub open { $_[0]->{open} }
{
package Module::Reader::File;
use constant _OPEN_STRING => "$]" >= 5.008 || !require IO::String;
use Carp 'croak';
sub new {
my ($class, %opts) = @_;
my $filename = $opts{filename};
if (!exists $opts{module} && $opts{filename}
&& $opts{filename} =~ m{\A(\w+(?:/\w+)?)\.pm\z}) {
my $module = $1;
$module =~ s{/}{::}g;
$opts{module} = $module;
}
bless \%opts, $class;
}
sub filename { $_[0]->{filename} }
sub module { $_[0]->{module} }
sub found_file { $_[0]->{found_file} }
sub disk_file { $_[0]->{disk_file} }
sub is_pmc { $_[0]->{is_pmc} }
sub inc_entry { $_[0]->{inc_entry} }
sub read_callback { $_[0]->{read_callback} }
sub read_callback_options { $_[0]->{read_callback_options} }
sub raw_filehandle {
$_[0]->{raw_filehandle} ||= !$_[0]->{disk_file} ? undef : do {
open my $fh, '<'.Module::Reader::_OPEN_LAYERS, $_[0]->{disk_file}
or croak "Can't locate $_[0]->{disk_file}";
$fh;
};
}
sub content {
my $self = shift;
return $self->{content}
if exists $self->{content};
my $fh = $self->raw_filehandle;
my $cb = $self->read_callback;
my $content = defined $self->{prefix} ? ${$self->{prefix}} : '';
if ($fh && !$cb) {
local $/;
$content .= <$fh>;
}
if ($cb) {
my @params = @{$self->read_callback_options||[]};
while (1) {
local $_ = $fh ? <$fh> : '';
$_ = ''
if !defined;
# perlfunc/require says that the first parameter will be a reference the
# sub itself. this is wrong. 0 will be passed.
last if !$cb->(0, @params);
$content .= $_;
}
}
return $self->{content} = $content;
}
sub handle {
my $self = shift;
my $fh = $self->raw_filehandle;
if ($fh && !$self->read_callback && -f $fh) {
open my $dup, '<&', $fh
or croak "can't dup file handle: $!";
return $dup;
}
my $content = $self->content;
if (_OPEN_STRING) {
open my $fh, '<', \$content;
return $fh;
}
else {
return IO::String->new($content);
}
}
}
1;
__END__
=head1 NAME
Module::Reader - Find and read perl modules like perl does
=head1 SYNOPSIS
use Module::Reader;
my $reader = Module::Reader->new;
my $module = $reader->module("My::Module");
my $filename = $module->found_file;
my $content = $module->content;
my $file_handle = $module->handle;
# search options
my $other_reader = Module::Reader->new(inc => ["/some/lib/dir", "/another/lib/dir"]);
my $other_reader2 = Module::Reader->new(found => { 'My/Module.pm' => '/a_location.pm' });
# Functional Interface
use Module::Reader qw(module_handle module_content);
my $io = module_handle('My::Module');
my $content = module_content('My::Module');
=head1 DESCRIPTION
This module finds modules in C<@INC> using the same algorithm perl does. From
that, it will give you the source content of a module, the file name (where
available), and how it was found. Searches (and content) are based on the same
internal rules that perl uses for F and
F.
=head1 EXPORTS
=head2 module_handle ( $module_name, @search_directories )
Returns an IO handle for the given module.
=head2 module_content ( $module_name, @search_directories )
Returns the content of a given module.
=head1 ATTRIBUTES
=over 4
=item inc
An array reference containing a list of directories or hooks to search for
modules or files. This will be used in the same manner that
L uses L<< C<@INC>|perlvar/@INC >>. If not provided,
L<< C<@INC>|perlvar/@INC >> itself will be used.
=item found
A hash reference of module filenames (of C format>) to files that
exist on disk, working the same as L<< C<%INC>|perlvar/%INC >>. The values can
optionally be an L<< C<@INC> hook|perlfunc/require >>. This option can also be
1, in which case L<< C<%INC>|perlfunc/%INC >> will be used instead.
=item pmc
A boolean controlling if C<.pmc> files should be found in preference to C<.pm>
files. If not specified, the same behavior perl was compiled with will be used.
=item open
A boolean controlling if the files found will be opened immediately when found.
Defaults to true.
=item abort_on_eacces
A boolean controlling if an error should be thrown or if the path should be
skipped when encountering C (access denied) errors. Defaults to true
on perl 5.18 and above, matching the behavior of L.
=item check_hooks_for_nonsearchable
For non-searchable paths (absolute paths and those starting with C<./> or
C<../>) attempt to check the hook items (and not the directories) in C<@INC> if
the file cannot be found directly. This matches the behavior of perl. Defaults
to true.
=back
=head1 METHODS
=head2 module
Returns a L for the given module name. If the module
can't be found, an exception will be raised.
=head2 file
Returns a L for the given file name. If the file
can't be found, an exception will be raised. For absolute paths, or files
starting with C<./> or C<../> (and C<.\> or C<..\> on Windows), no directory
search will be performed.
=head2 modules
Returns an array of L for a given module name. This
will give every file that could be loaded based on the L options.
=head2 files
Returns an array of L for a given file name. This
will give every file that could be loaded based on the L options.
=head1 FILE OBJECTS
The file objects returned represent an entry that could be found in
L<< C<@INC>|perlvar/@INC >>. While they will generally be files that exist on
the file system somewhere, they may also represent files that only exist only in
memory or have arbitrary filters applied.
=head2 FILE METHODS
=head3 filename
The filename that was searched for.
=head3 module
If a module was searched for, or a file of the matching form (C),
this will be the module searched for.
=head3 found_file
The path to the file found by L.
This may not represent an actual file that exists, but the file name that perl
will use for the file for things like L or
L<__FILE__|perlfunc/__FILE__>.
For C<.pmc> files, this will be the C<.pm> form of the file.
For L<< C<@INC> hooks|perlfunc/require >> this will be a file name of the form
C, matching how perl treats them internally.
=head3 disk_file
The path to the file that exists on disk. When the file is found via an
L<< C<@INC> hook|perlfunc/require >>, this will be undef.
=head3 content
The content of the found file.
=head3 handle
A file handle to the found file's content.
=head3 is_pmc
A boolean value representing if the file found was C<.pmc> variant of the file
requested.
=head3 inc_entry
The directory or L that was used to find the given file
or module. If L is used, this may be undef.
=head2 RAW HOOK DATA
File objects also have methods for the raw file handle and read callbacks used
to read a file. Interacting with the handle or callback can impact the return
values of L and L, and vice versa. It should generally be
avoided unless you are introspecting the F<< C<@INC> hooks|perlfunc/require >>.
=head3 raw_filehandle
The raw file handle to the file found. This will be either a file handle to a
file found on disk, or something returned by an
F<< C<@INC> hook|perlfunc/require >>. The hook callback, if it exists, will not
be taken into account by this method.
=head3 read_callback
A callback used to read content, or modify a file handle from an C<@INC> hook.
=head3 read_callback_options
An array reference of arguments to send to the read callback whem reading or
modifying content from a file handle. Will contain either zero or one entries.
=head1 SEE ALSO
Numerous other modules attempt to do C<@INC> searches similar to this module,
but no other module accurately represents how perl itself uses
L<< C<@INC>|perlvar/@INC >>. Most don't match perl's behavior regarding
character and block devices, directories, or permissions. Often, C<.pmc> files
are not taken into account.
Some of these modules have other use cases. The following comments are
primarily related to their ability to search C<@INC>.
=over 4
=item L
Only available as a command line utility. Inaccurately gives the first file
found on disk in C<@INC>.
=item L
Inaccurately gives the first file found on disk in C<@INC>.
=item L
For unloaded modules, inaccurately checks if a module exists.
=item L
Same caveats as L.
=item L
Inaccurately gives the first file found on disk in C<@INC>.
=item L
Inaccurately searches for C<.pm> and C<.pmc> files in subdirectories of C<@INC>.
=item L
Inaccurately searches C<@INC> for files and gives inaccurate information for the
files that it finds.
=item L
Inaccurately searches C<@INC> for matching files. Attempts to handle hooks, but
handles most cases wrong.
=item L
Searches for C<.pm> and C<.pod> files in relatively unpredictable fashion,
based usually on the current directory. Optionally, can inaccurately scan
C<@INC>.
=item L
Primarily designed as a version number extractor. Meant to find files on disk,
avoiding the nuance involved in perl's file loading.
=item L
Inaccurately gives the first file found on disk in C<@INC>.
=item L
Inaccurately searches for modules, ignoring C<@INC> hooks.
=item L
Inaccurately searches for files, with confusing output for C<@INC> hooks.
=item L
Primarily meant for searching for related documentation. Finds related module
files, or sometimes C<.pod> files. Unpredictable search path.
=back
=head1 AUTHOR
haarg - Graham Knop (cpan:HAARG)
=head2 CONTRIBUTORS
None yet.
=head1 COPYRIGHT
Copyright (c) 2013 the Module::Reader L and L
as listed above.
=head1 LICENSE
This library is free software and may be distributed under the same terms
as perl itself.
=cut