From: Matt S Trout 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?p=scpubgit%2FObject-Remote.git;a=commitdiff_plain;h=7462160ed87d1eb2c10cb4c9e37e51dbdcb4d3f4;hp=6ed5d5804fa1e932a18619c971e4704a34b85dc8 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;