1# $Id: Upward.pm 184 2009-06-11 06:44:27Z rcaputo $ 2 3=head1 NAME 4 5POE::Request::Upward - internal base class for POE::Stage response messages 6 7=head1 SYNOPSIS 8 9 This module isn't meant to be used directly. 10 11=head1 DESCRIPTION 12 13POE::Stage messages are generally asynchronous, which means that 14multiple "calls" can be in play at once. To track them, POE::Stage 15uses a call tree rather than a call stack. 16 17POE::Request::Upward is a base class for POE::Request messages that 18flow up from sub-stages (closer to leaf nodes) to their parents 19(closer to the root node). Both POE::Request::Emit and 20POE::Request::Returns are subclasses of POE::Request::Upward. 21 22The Emit and Return message classes share a lot of common code. That 23code has been hoisted into this base class. 24 25Upward messages are automatically created and dispatched as a side 26effect of calling POE::Request's emit() and return() methods. 27 28=cut 29 30package POE::Request::Upward; 31 32use warnings; 33use strict; 34 35use POE::Request qw( 36 REQ_CREATE_STAGE 37 REQ_DELIVERY_REQ 38 REQ_DELIVERY_RSP 39 REQ_ID 40 REQ_PARENT_REQUEST 41 REQ_TARGET_METHOD 42 REQ_TARGET_STAGE 43 REQ_TYPE 44 @EXPORT_OK 45); 46 47use base qw(POE::Request); 48use Carp qw(croak confess); 49use Scalar::Util qw(weaken); 50 51use constant DEBUG => 0; 52 53=head1 PUBLIC METHODS 54 55These methods are called directly on the class or object. 56 57=head2 new ARGUMENT_PAIRS 58 59POE::Request::Upward's new() constructor is almost always called 60internally by POE::Request->emit() or POE::Request->return(). Most 61parameters to emit() and return() are passed directly to this 62constructor. 63 64POE::Request::Upward has one mandatory parameter: "type". This 65defines the type of response being created. If specified, the 66optional "args" parameter must contain a hashref with response 67payloads. The contents of "args" are passed unchanged to the 68response's handler as lexicals with names prefixed by "arg_". 69 70Response types are mapped to methods in the original requester's stage 71through POE::Request's "on_$type" parameters. In this example, 72responses of type "success" are mapped to the requester's 73continue_on() method. Likewise "error" responses are mapped to the 74requester's log_and_stop() method. 75 76 my $req_connect = POE::Request->new( 77 stage => $tcp_client, 78 method => "connect", 79 on_success => "continue_on", 80 on_error => "log_and_stop", 81 ); 82 83How an asynchronous TCP connector might return success and error 84messages (although we're not sure yet): 85 86 my $req; 87 $req->return( 88 type => "success", 89 args => { 90 socket => $socket, 91 }, 92 ); 93 94 $req->return( 95 type => "error", 96 args => { 97 function => "connect", 98 errno => $!+0, 99 errstr => "$!", 100 }, 101 ); 102 103Optionally, POE::Request objects may contain roles. Responses come 104back as "on_${role}_${type}" messages. For example, one stage might 105call another (a socket "factory") to create a TCP client socket. In 106this example, the call's role is "connect", and the two previous 107return() calls are used to return a socket on success or error info on 108failure: 109 110 my $req_connect = POE::Request->new( 111 stage => $tcp_client, 112 method => "connect", 113 role => "connect", 114 ); 115 116If the factor returns "success", the on_connect_success() method will 117be called upon to handle it: 118 119 sub on_connect_success { 120 my $arg_socket; # contains the "socket" argument 121 } 122 123Likewise, on_connect_failure() will be called if the connection 124failed: 125 126 sub on_connect_failure { 127 my ($arg_function, $arg_errno, $arg_errstr); 128 } 129 130=cut 131 132sub new { 133 my ($class, %args) = @_; 134 135 # Instantiate the base request. 136 my $self = $class->_request_constructor(\%args); 137 138 # Upward requests are in response to downward ones. Therefore a 139 # current request must exist. 140 # 141 # XXX - Only for the reference. 142 my $current_request = POE::Request->_get_current_request(); 143 confess "should always have a current request" unless $current_request; 144 145 # Record the stage that created this request. 146 $self->[REQ_CREATE_STAGE] = $current_request->[REQ_TARGET_STAGE]; 147 weaken $self->[REQ_CREATE_STAGE]; 148 149 # Upward requests target the current request's parent request. 150 $self->[REQ_DELIVERY_REQ] = $current_request->[REQ_PARENT_REQUEST]; 151 152 # Upward requests' "rsp" values point to the current request at the 153 # time the upward one is created. 154 $self->[REQ_DELIVERY_RSP] = $self; 155 156 # The main difference between upward requests is their parents. 157 $self->_init_subclass($current_request); 158 159 # Context is the delivery req's context. It may not always exist, 160 # as in the case of an upward request leaving the top-level 161 # "application" stage and returning to the outside. 162 if ($self->[REQ_DELIVERY_REQ]) { 163 my $delivery_data = $self->[REQ_DELIVERY_REQ]; 164# $self->[REQ_CONTEXT] = $current_request->[REQ_CONTEXT]; 165 } 166# else { 167# $self->[REQ_CONTEXT] = { }; 168# } 169 170 $self->[REQ_ID] = $self->_reallocate_request_id( 171 $current_request->[REQ_ID] 172 ); 173 174 # Upward requests can be of various types. 175 $self->[REQ_TYPE] = delete $args{type}; 176 177 DEBUG and warn( 178 "$current_request created ", ref($self), " $self:\n", 179 "\tMy parent request = $self->[REQ_PARENT_REQUEST]\n", 180 "\tDelivery request = $self->[REQ_DELIVERY_REQ]\n", 181 "\tDelivery response = $self->[REQ_DELIVERY_RSP]\n", 182 ); 183 184 $self->_assimilate_args($args{args} || {}); 185 $self->_send_to_target(); 186 187 return $self; 188} 189 190# Deliver the request to its destination. This happens when the event 191# carrying the request is dispatched. 192# TODO - It's not public. Consider prefixing it with an underscore. 193 194sub deliver { 195 my $self = shift; 196 197 my $target_stage = $self->[REQ_TARGET_STAGE]; 198 $target_stage->_set_req_rsp( 199 $self->[REQ_DELIVERY_REQ], 200 $self->[REQ_DELIVERY_RSP], 201 ); 202 203 $self->_push( 204 $self->[REQ_DELIVERY_REQ], 205 $self->[REQ_TARGET_STAGE], 206 $self->[REQ_TARGET_METHOD], 207 ); 208 209 $self->_invoke($self->[REQ_TARGET_METHOD]); 210 211 $self->_pop( 212 $self->[REQ_DELIVERY_REQ], 213 $self->[REQ_TARGET_STAGE], 214 $self->[REQ_TARGET_METHOD], 215 ); 216 217 $target_stage->_set_req_rsp(0, 0); 218 219 # Break circular references. 220 $self->[REQ_DELIVERY_RSP] = undef; 221 $self->[REQ_DELIVERY_REQ] = undef; 222} 223 224# Rules for all upward messages. These methods are not supported by 225# POE::Request::Upward. The guard methods here are required to ensure 226# that POE::Request's versions are inaccessible. 227 228sub return { 229 my $class = ref(shift()); 230 croak "cannot return from upward $class"; 231} 232 233sub cancel { 234 my $class = ref(shift()); 235 croak "cannot cancel upward $class"; 236} 237 238sub emit { 239 my $class = ref(shift()); 240 croak "cannot emit from upward $class"; 241} 242 243sub recall { 244 my $class = ref(shift()); 245 croak "cannot recall from upward $class"; 246} 247 2481; 249 250=head1 BUGS 251 252See L<http://thirdlobe.com/projects/poe-stage/report/1> for known 253issues. See L<http://thirdlobe.com/projects/poe-stage/newticket> to 254report one. 255 256POE::Stage is too young for production use. For example, its syntax 257is still changing. You probably know what you don't like, or what you 258need that isn't included, so consider fixing or adding that, or at 259least discussing it with the people on POE's mailing list or IRC 260channel. Your feedback and contributions will bring POE::Stage closer 261to usability. We appreciate it. 262 263=head1 SEE ALSO 264 265POE::Request::Upward has two subclasses: L<POE::Request::Emit> for 266emitting multiple responses to a single request, and 267L<POE::Request::Return> for sending a final response to end a request. 268 269POE::Request::Upward inherits from L<POE::Request>. 270 271=head1 AUTHORS 272 273Rocco Caputo <rcaputo@cpan.org>. 274 275=head1 LICENSE 276 277POE::Request::Upward is Copyright 2005-2006 by Rocco Caputo. All 278rights are reserved. You may use, modify, and/or distribute this 279module under the same terms as Perl itself. 280 281=cut 282