From: Graham Knop <haarg@haarg.org>
Date: Tue, 13 Nov 2012 21:39:20 +0000 (-0500)
Subject: allow sourcing modules from subrefs in @INC
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e8ba60924fac37498f6f8b83b6c934a29d60da85;p=scpubgit%2FObject-Remote.git

allow sourcing modules from subrefs in @INC
---

diff --git a/lib/Object/Remote/ModuleSender.pm b/lib/Object/Remote/ModuleSender.pm
index 6624d6b..ca088cd 100644
--- a/lib/Object/Remote/ModuleSender.pm
+++ b/lib/Object/Remote/ModuleSender.pm
@@ -25,15 +25,64 @@ sub source_for {
     }
   }
   log_trace { "Searching for module in library directories" };
-  my ($found) = first {  -f $_ }
-                  map File::Spec->catfile($_, $module),
-                    @{$self->dir_list};
+
+  for my $inc (@{$self->dir_list}) {
+    if (!ref $inc) {
+      my $full_module = File::Spec->catfile($inc, $module);
+      next unless -f $full_module;
+      log_debug { "found '$module' at '$found'" };
+      open my $fh, '<', $full_module or die "Couldn't open ${full_module} for ${module}: $!";
+      return do { local $/; <$fh> };
+    }
+    else {
+      my $data = _read_dynamic_inc($inc, $module);
+      return $data
+        if defined $data;
+    }
+  }
   die "Couldn't find ${module} in remote \@INC. dir_list contains:\n"
-      .join("\n", @{$self->dir_list})
-    unless $found;
-  log_debug { "found '$module' at '$found'" };
-  open my $fh, '<', $found or die "Couldn't open ${found} for ${module}: $!";
-  return do { local $/; <$fh> };
+      .join("\n", @{$self->dir_list});
+}
+
+sub _read_dynamic_inc {
+  my ($inc, $module) = @_;
+
+  my ($fh, $cb, $state);
+  if (ref $inc eq 'CODE') {
+    ($fh, $cb, $state) = $inc->($inc, $module);
+  }
+  elsif (ref $inc eq 'ARRAY') {
+    ($fh, $cb, $state) = $inc->[0]->($inc, $module);
+  }
+  elsif ($inc->can('INC')) {
+    ($fh, $cb, $state) = $inc->INC($module);
+  }
+
+  if ($cb && $fh) {
+    my $data = '';
+    while (1) {
+      local $_ = <$fh>;
+      last unless defined;
+      my $res = $cb->($cb, $state);
+      $data .= $_;
+      last unless $res;
+    }
+    return $data;
+  }
+  elsif ($cb) {
+    my $data = '';
+    while (1) {
+      local $_;
+      my $res = $cb->($cb, $state);
+      $data .= $_;
+      last unless $res;
+    }
+    return $data;
+  }
+  elsif ($fh) {
+    return do { local $/; <$fh> };
+  }
+  return;
 }
 
 1;
diff --git a/t/sender.t b/t/sender.t
index 6d50e50..de163df 100644
--- a/t/sender.t
+++ b/t/sender.t
@@ -11,25 +11,68 @@ $ENV{PERL5LIB} = join(
   ':', ($ENV{PERL5LIB} ? $ENV{PERL5LIB} : ()), qw(lib)
 );
 
-my $ms = Object::Remote::ModuleSender->new(
-  dir_list => [ 't/lib' ]
-);
+my $mod_content = do {
+  open my $fh, '<', 't/lib/ORTestClass.pm'
+    or die "can't read ORTestClass.pm: $!";
+  local $/;
+  <$fh>
+};
+my $modules = {
+  'ORTestClass.pm' => $mod_content,
+};
 
-my $connection = Object::Remote::Connector::Local->new(
-                   module_sender => $ms,
-                 )->connect;
+sub TestModuleProvider::INC {
+  my ($self, $module) = @_;
+  if (my $data = $self->{modules}{$module}) {
+    open my $fh, '<', \$data
+      or die "welp $!";
+    return $fh;
+  }
+  return;
+}
 
-my $counter = Object::Remote->new(
-  connection => $connection,
-  class => 'ORTestClass'
+my %sources = (
+  basic => [ 't/lib' ],
+  sub => [ sub {
+    if (my $data = $modules->{$_[1]}) {
+      open my $fh, '<', \$data
+        or die "welp $!";
+      return $fh;
+    }
+    return;
+  } ],
+  dynamic_array => [ [ sub {
+    my $mods = $_[0][1];
+    if (my $data = $mods->{$_[1]}) {
+      open my $fh, '<', \$data
+        or die "welp $!";
+      return $fh;
+    }
+    return;
+  }, $modules ] ],
+  object => [ bless { modules => $modules }, 'TestModuleProvider' ],
 );
 
-isnt($$, $counter->pid, 'Different pid on the other side');
+for my $source (sort keys %sources) {
+  my $ms = Object::Remote::ModuleSender->new(
+    dir_list => $sources{$source},
+  );
+  my $connection = Object::Remote::Connector::Local->new(
+                  module_sender => $ms,
+                  )->connect;
+
+  my $counter = Object::Remote->new(
+    connection => $connection,
+    class => 'ORTestClass'
+  );
+
+  isnt($$, $counter->pid, "$source sender: Different pid on the other side");
 
-is($counter->counter, 0, 'Counter at 0');
+  is($counter->counter, 0, "$source sender: Counter at 0");
 
-is($counter->increment, 1, 'Increment to 1');
+  is($counter->increment, 1, "$source sender: Increment to 1");
 
-is($counter->counter, 1, 'Counter at 1');
+  is($counter->counter, 1, "$source sender: Counter at 1");
+}
 
 done_testing;