OK, patch attached which allows delegation to filehandles.
diff --git a/lib/Moose/Meta/Method/Delegation.pm b/lib/Moose/Meta/Method/Delegation.pm
index 32436d6..e8cbb2e 100644
--- a/lib/Moose/Meta/Method/Delegation.pm
+++ b/lib/Moose/Meta/Method/Delegation.pm
@@ -90,17 +90,44 @@ sub _initialize_body {
: ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')}
: undef;
+ unshift @_, @{ $self->curried_arguments };
+
if ($error) {
- $self->throw_error(
- "Cannot delegate $handle_name to $method_to_call because "
- . "the value of "
- . $self->associated_attribute->name
- . $error,
- method_name => $method_to_call,
- object => $instance
- );
+ local $@;
+ my @return;
+ if (wantarray) {
+ @return = eval { $proxy->$method_to_call(@_) };
+ }
+ elsif (defined wantarray) {
+ push @return, scalar eval { $proxy->$method_to_call(@_) };
+ }
+ else {
+ eval { $proxy->$method_to_call(@_); 1 };
+ }
+
+ if (not $@) {
+ return @return;
+ }
+
+ # These errors we don't want to catch and rethrow. We want
+ # to substitute a more Moose-specific error message.
+ my $r1 = qr{^Can't locate object method "$method_to_call" via package};
+ my $r2 = qr{^Can't call method "$method_to_call" on (unblessed reference|an undefined value)};
+
+ if ($@ =~ $r1 or $@ =~ $r2) {
+ $self->throw_error(
+ "Cannot delegate $handle_name to $method_to_call because "
+ . "the value of "
+ . $self->associated_attribute->name
+ . $error,
+ method_name => $method_to_call,
+ object => $instance
+ );
+ }
+
+ die $@;
}
- unshift @_, @{ $self->curried_arguments };
+
$proxy->$method_to_call(@_);
};
}
diff --git a/t/attributes/attribute_delegation.t b/t/attributes/attribute_delegation.t
index 733542c..2a557b4 100644
--- a/t/attributes/attribute_delegation.t
+++ b/t/attributes/attribute_delegation.t
@@ -482,4 +482,20 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
);
}
+{
+ use IO::Handle;
+
+ {
+ package Local::Delegation::Test;
+ use Moose;
+ has attr => (is => 'ro', handles => [qw/ print /]);
+ }
+
+ my $d;
+ open my $fh, '>', \$d;
+ Local::Delegation::Test->new(attr => $fh)->attr->print("1");
+ Local::Delegation::Test->new(attr => $fh)->print("2");
+ is($d, "12", "can delegate to non-blessed references");
+}
+
done_testing;