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