From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 17 Jul 2012 15:29:53 +0000 (+0000)
Subject: FromData
X-Git-Tag: v0.002002~16
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7462160ed87d1eb2c10cb4c9e37e51dbdcb4d3f4;p=scpubgit%2FObject-Remote.git

FromData
---

diff --git a/Changes b/Changes
index b00d9ea..6402a03 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - allow loading of classes and packages from __DATA__
   - allow transfer of scalar references
 
 0.001001 - 2012-07-12
diff --git a/lib/Object/Remote/FromData.pm b/lib/Object/Remote/FromData.pm
new file mode 100644
index 0000000..3738b66
--- /dev/null
+++ b/lib/Object/Remote/FromData.pm
@@ -0,0 +1,37 @@
+package Object::Remote::FromData;
+
+use strictures 1;
+use Object::Remote;
+
+our %Modules;
+our %Not_Loaded_Yet;
+our %Seen;
+
+sub import {
+  my $target = caller;
+  return if $Seen{$target};
+  $Seen{$target} = $Not_Loaded_Yet{$target} = 1;
+}
+
+sub flush_loaded {
+  foreach my $key (keys %Not_Loaded_Yet) {
+    my $data_fh = do { no strict 'refs'; *{"${key}::DATA"} };
+    my $data = do { local $/; <$data_fh> };
+    my %modules = reverse(
+      $data =~ m/(^package ([^;]+);\n.*?(?:(?=^package)|\Z))/msg
+    );
+    $_ .= "\n1;\n" for values %modules;
+    @Modules{keys %modules} = values %modules;
+    delete $Not_Loaded_Yet{$key};
+  }
+}
+
+sub find_module {
+  flush_loaded;
+  my ($module) = @_;
+  $module =~ s/\//::/g;
+  $module =~ s/\.pm$//;
+  return $Modules{$module};
+}
+
+1;
diff --git a/lib/Object/Remote/ModuleSender.pm b/lib/Object/Remote/ModuleSender.pm
index 87f75f1..0129b88 100644
--- a/lib/Object/Remote/ModuleSender.pm
+++ b/lib/Object/Remote/ModuleSender.pm
@@ -14,6 +14,11 @@ sub _build_dir_list {
 
 sub source_for {
   my ($self, $module) = @_;
+  if (my $find = Object::Remote::FromData->can('find_module')) {
+    if (my $source = $find->($module)) {
+      return $source;
+    }
+  }
   my ($found) = first {  -f $_ }
                   map File::Spec->catfile($_, $module),
                     @{$self->dir_list};
diff --git a/t/basic_data.t b/t/basic_data.t
new file mode 100644
index 0000000..081305d
--- /dev/null
+++ b/t/basic_data.t
@@ -0,0 +1,36 @@
+use strictures 1;
+use Test::More;
+use Sys::Hostname qw(hostname);
+
+use Object::Remote::FromData;
+
+my $connection = Object::Remote->connect('-');
+
+my $remote = My::Data::TestClass->new::on($connection);
+
+is($remote->counter, 0, 'Counter at 0');
+
+is($remote->increment, 1, 'Increment to 1');
+
+is($remote->counter, 1, 'Counter at 1');
+
+is(
+  My::Data::TestPackage->can::on($connection, 'hostname')->(),
+  hostname(),
+  'Remote sub call ok'
+);
+
+done_testing;
+
+__DATA__
+package My::Data::TestClass;
+
+use Moo;
+
+has counter => (is => 'rwp', default => sub { 0 });
+
+sub increment { $_[0]->_set_counter($_[0]->counter + 1); }
+
+package My::Data::TestPackage;
+
+use Sys::Hostname;