Module-Reader-0.002003HEADModule-Reader-0.002003master

1 files changed, 174 insertions, 0 deletions

diff --git a/lib/Module/Reader.pm b/lib/Module/Reader.pm
new file mode 100644
index 0000000..f263915
--- /dev/null
+++ b/lib/Module/Reader.pm
@@ -0,0 +1,174 @@
+package Module::Reader;
+BEGIN { require 5.006 }
+use strict;
+use warnings;
+
+our $VERSION = '0.002003';
+$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