File Coverage

blib/lib/RMI/ProxyObject.pm
Criterion Covered Total %
statement 46 51 90.2
branch 15 26 57.6
condition 8 15 53.3
subroutine 10 10 100.0
pod 2 2 100.0
total 81 104 77.8


line stmt bran cond sub pod time code
1             package RMI::ProxyObject;
2              
3 24     24   479 use strict;
  24         45  
  24         1080  
4 24     24   120 use warnings;
  24         40  
  24         625  
5              
6 24     24   119 use RMI;
  24         32  
  24         1438  
7             our $VERSION = $RMI::VERSION;
8             our %OPTS;
9              
10             sub AUTOLOAD {
11 24     24   117 no strict;
  24         38  
  24         2522  
12 40     40   19838 my $object = shift;
13 40         165 my $method = $AUTOLOAD;
14 40         581 my ($class,$subname) = ($method =~ /^(.*)::(.*?)$/);
15 40         91 $method = $subname;
16 24     24   136 no warnings;
  24         53  
  24         20825  
17 40   66     232 my $node = $RMI::Node::node_for_object{$object} || $RMI::proxied_classes{$class};
18 40 50       116 unless ($node) {
19 0         0 die "no node for object $object: cannot call $method(@_)?" . Data::Dumper::Dumper(\%RMI::Node::node_for_object);
20             }
21 40 50       342 print "$RMI::DEBUG_MSG_PREFIX O: $$ $object $method redirecting to node $node\n" if $RMI::DEBUG;
22 40 100 66     543 $node->send_request_and_receive_response((ref($object) ? 'call_object_method' : 'call_class_method'), ($object||$class), $method, @_);
23              
24             }
25              
26             sub can {
27 4     4 1 3529 my $object = shift;
28 4   66     36 my $node = $RMI::Node::node_for_object{$object} || $RMI::proxied_classes{$object};
29 4 50       32 unless ($node) {
30 0         0 die "no node for object $object: cannot call can (@_)" . Data::Dumper::Dumper(\%RMI::Node::node_for_object);
31             }
32 4 50       17 print "$RMI::DEBUG_MSG_PREFIX O: $$ $object 'can' redirecting to node $node\n" if $RMI::DEBUG;
33 4 100       54 $node->send_request_and_receive_response((ref($object) ? 'call_object_method' : 'call_class_method'), $object, 'can', @_);
34             }
35              
36             sub isa {
37 5     5 1 4140 my $object = shift;
38 5   33     72 my $node = $RMI::Node::node_for_object{$object} || $RMI::proxied_classes{$object};
39 5 50       35 unless ($node) {
40 0         0 die "no node for object $object: cannot call isa (@_)" . Data::Dumper::Dumper(\%RMI::Node::node_for_object);
41             }
42 5 50       16 print "$RMI::DEBUG_MSG_PREFIX O: $$ $object 'isa' redirecting to node $node\n" if $RMI::DEBUG;
43 5 50       93 $node->send_request_and_receive_response((ref($object) ? 'call_object_method' : 'call_class_method'), $object, 'isa', @_);
44             }
45              
46             END {
47 24     24   4183 $RMI::process_is_ending = 1;
48             }
49              
50             sub DESTROY {
51 24     24   5762 my $self = $_[0];
52 24         80 my $id = "$self";
53 24         72 my $node = delete $RMI::Node::node_for_object{$id};
54 24         75 my $remote_id = delete $RMI::Node::remote_id_for_object{$id};
55 24 100       101 if (not defined $remote_id) {
56 6 50       15 if ($RMI::DEBUG) {
57 0         0 warn "$RMI::DEBUG_MSG_PREFIX O: $$ DESTROYING $id wrapping $node but NO REMOTE ID FOUND DURING DESTRUCTION?!\n"
58             . Data::Dumper::Dumper($node->{_received_objects});
59             }
60 6         86 return;
61             }
62 18 50       208 print "$RMI::DEBUG_MSG_PREFIX O: $$ DESTROYING $id wrapping $remote_id from $node\n" if $RMI::DEBUG;
63 18         78 my $other_ref = delete $node->{_received_objects}{$remote_id};
64 18 0 33     85 if (!$other_ref and !$RMI::process_is_ending) {
65 0         0 warn "$RMI::DEBUG_MSG_PREFIX O: $$ DESTROYING $id wrapping $remote_id from $node NOT ON RECORD AS RECEIVED DURING DESTRUCTION?!\n"
66             . Data::Dumper::Dumper($node->{_received_objects});
67             }
68 18         37 push @{ $node->{_received_and_destroyed_ids} }, $remote_id;
  18         245  
69             }
70              
71             1;
72              
73             =pod
74              
75             =head1 NAME
76              
77             RMI::ProxyObject - used internally by RMI for "stub" objects
78              
79             =head1 VERSION
80              
81             This document describes RMI::ProxyObject v0.10.
82              
83             =head1 DESCRIPTION
84              
85             This class is the real class of all transparent proxy objects, though
86             objects of this class will attempt to hide that fact.
87              
88             This is an internal class used by B and B
89             nodes. Objects of this class are never constructed explicitly by
90             applications. They are made as a side effect of data passing
91             between client and server. Any time an RMI::Client or RMI::Server
92             "passes" an object as a parameter or a return value, an RMI::ProxyObject
93             is created on the other side.
94              
95             Note that RMI::ProxyObjects are also "tied" to the package
96             B, which handles attempts to use the reference
97             as a plain Perl reference.
98              
99             The full explanation of how references, blessed and otherwise, are
100             proxied across an RMI::Client/RMI::Server pair (or any RMI::Node pair)
101             is in B.
102              
103             =head1 METHODS
104              
105             The goal of objects of this class is to simulate a specific object
106             on the other side of a specific RMI::Node (RMI::Client or RMI::Server).
107             As such, this does not have its own API.
108              
109             This class does, however, overridefour special Perl methods in ways which
110             are key to its ability to proxy method calls:
111              
112             =head2 AUTOLOAD
113              
114             AUTOLOAD directs all method calls across the connection which created it
115             to the remote side for actual execution.
116              
117             =head2 isa
118              
119             Since calls to isa() will not fire AUTOLOAD, isa() is explicitly overridden
120             to redirect through the RMI::Node which owns the object in question.
121              
122             =head2 can
123              
124             Since calls to can() will also not fire AUTOLOAD, we override can() explicitly
125             as well to redirect through the RMI::Node which owns the object in question.
126              
127             =head2 DESTROY
128              
129             The DESTROY handler manages ensuring that the remote side reduces its reference
130             count and can do correct garbage collection. The destroy handler on the other
131             side will fire as well at that time to do regular cleanup.
132              
133             =head1 BUGS AND CAVEATS
134              
135             =head2 the proxy object is only MOSTLY transparent
136              
137             Ways to detect that an object is an RMI::ProxyObject are:
138              
139             1. ref($obj) will return "RMI::ProxyObject" unless the entire class
140             has been proxied (with $client->use_remote('SomeClass').
141              
142             2. "$obj" will stringify to "RMI::ProxyObject=SOMETYPE(...)", though
143             this will probaby be changed at a future date.
144              
145             See general bugs in B for general system limitations of proxied objects.
146              
147             =head1 SEE ALSO
148              
149             B, B, B,B, B
150              
151             =head1 AUTHORS
152              
153             Scott Smith
154              
155             =head1 COPYRIGHT
156              
157             Copyright (c) 2008 - 2009 Scott Smith All rights reserved.
158              
159             =head1 LICENSE
160              
161             This program is free software; you can redistribute it and/or modify it under
162             the same terms as Perl itself.
163              
164             The full text of the license can be found in the LICENSE file included with this
165             module.
166              
167             =cut
168