| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package RPC::ExtDirect::EventProvider; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 4 |  |  | 4 |  | 1851 | use strict; | 
|  | 4 |  |  |  |  | 4 |  | 
|  | 4 |  |  |  |  | 94 |  | 
| 4 | 4 |  |  | 4 |  | 12 | use warnings; | 
|  | 4 |  |  |  |  | 6 |  | 
|  | 4 |  |  |  |  | 82 |  | 
| 5 | 4 |  |  | 4 |  | 13 | no  warnings 'uninitialized';           ## no critic | 
|  | 4 |  |  |  |  | 5 |  | 
|  | 4 |  |  |  |  | 99 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 4 |  |  | 4 |  | 15 | use RPC::ExtDirect::Util::Accessor; | 
|  | 4 |  |  |  |  | 4 |  | 
|  | 4 |  |  |  |  | 63 |  | 
| 8 | 4 |  |  | 4 |  | 13 | use RPC::ExtDirect::Config; | 
|  | 4 |  |  |  |  | 5 |  | 
|  | 4 |  |  |  |  | 62 |  | 
| 9 | 4 |  |  | 4 |  | 12 | use RPC::ExtDirect; | 
|  | 4 |  |  |  |  | 3 |  | 
|  | 4 |  |  |  |  | 15 |  | 
| 10 | 4 |  |  | 4 |  | 1364 | use RPC::ExtDirect::NoEvents; | 
|  | 4 |  |  |  |  | 5 |  | 
|  | 4 |  |  |  |  | 2246 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | ### PACKAGE GLOBAL VARIABLE ### | 
| 13 |  |  |  |  |  |  | # | 
| 14 |  |  |  |  |  |  | # Turn this on for debugging. | 
| 15 |  |  |  |  |  |  | # | 
| 16 |  |  |  |  |  |  | # DEPRECATED. Use `debug_eventprovider` Config option instead. | 
| 17 |  |  |  |  |  |  | # See RPC::ExtDirect::Config. | 
| 18 |  |  |  |  |  |  | # | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | our $DEBUG; | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | ### PACKAGE GLOBAL VARIABLE ### | 
| 23 |  |  |  |  |  |  | # | 
| 24 |  |  |  |  |  |  | # Set Serializer class name so it could be configured | 
| 25 |  |  |  |  |  |  | # | 
| 26 |  |  |  |  |  |  | # DEPRECATED. Use `serializer_class_eventprovider` or `serializer_class` | 
| 27 |  |  |  |  |  |  | # Config options instead. | 
| 28 |  |  |  |  |  |  | # | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | our $SERIALIZER_CLASS; | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | ### PACKAGE GLOBAL VARIABLE ### | 
| 33 |  |  |  |  |  |  | # | 
| 34 |  |  |  |  |  |  | # DEPRECATED. This option did nothing in previous versions of | 
| 35 |  |  |  |  |  |  | # RPC::ExtDirect library, and is ignored in 3.x+ | 
| 36 |  |  |  |  |  |  | # | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | our $EVENT_CLASS; | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | ### PACKAGE GLOBAL VARIABLE ### | 
| 41 |  |  |  |  |  |  | # | 
| 42 |  |  |  |  |  |  | # Set Request class name so it could be configured | 
| 43 |  |  |  |  |  |  | # | 
| 44 |  |  |  |  |  |  | # DEPRECATED. Use `request_class_eventprovider` Config option instead. | 
| 45 |  |  |  |  |  |  | # | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | our $REQUEST_CLASS; | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | ### PUBLIC CLASS METHOD (CONSTRUCTOR) ### | 
| 50 |  |  |  |  |  |  | # | 
| 51 |  |  |  |  |  |  | # Create a new EventProvider object with default API and Config | 
| 52 |  |  |  |  |  |  | # | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  | sub new { | 
| 55 | 9 |  |  | 9 | 0 | 30 | my ($class, %arg) = @_; | 
| 56 |  |  |  |  |  |  |  | 
| 57 | 9 |  | 66 |  |  | 32 | $arg{config} ||= RPC::ExtDirect::Config->new(); | 
| 58 | 9 |  | 33 |  |  | 45 | $arg{api}    ||= RPC::ExtDirect->get_api(); | 
| 59 |  |  |  |  |  |  |  | 
| 60 | 9 |  |  |  |  | 31 | return bless { %arg }, $class; | 
| 61 |  |  |  |  |  |  | } | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  | ### PUBLIC CLASS/INSTANCE METHOD ### | 
| 64 |  |  |  |  |  |  | # | 
| 65 |  |  |  |  |  |  | # Run all poll handlers in succession, collect the Events returned | 
| 66 |  |  |  |  |  |  | # by them and return serialized representation suitable for passing | 
| 67 |  |  |  |  |  |  | # on to client side. | 
| 68 |  |  |  |  |  |  | # | 
| 69 |  |  |  |  |  |  | # Note that the preferred way to call this method is on the EventProvider | 
| 70 |  |  |  |  |  |  | # object instance, but we support the class-based way for backwards | 
| 71 |  |  |  |  |  |  | # compatibility. | 
| 72 |  |  |  |  |  |  | # | 
| 73 |  |  |  |  |  |  | # Be aware that the only supported way to configure the EventProvider | 
| 74 |  |  |  |  |  |  | # is to pass a Config object to the constructor and then call poll() | 
| 75 |  |  |  |  |  |  | # on the instance. | 
| 76 |  |  |  |  |  |  | # | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | sub poll { | 
| 79 | 9 |  |  | 9 | 0 | 5339 | my ($class, $env) = @_; | 
| 80 |  |  |  |  |  |  |  | 
| 81 | 9 | 100 |  |  |  | 23 | my $self = ref($class) ? $class : $class->new(); | 
| 82 |  |  |  |  |  |  |  | 
| 83 | 9 |  |  |  |  | 17 | my @poll_requests = $self->_get_poll_requests(); | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | # Even if we have nothing to poll, we must return a stub Event | 
| 86 |  |  |  |  |  |  | # or client side will throw an unhandled JavaScript exception | 
| 87 | 9 | 50 |  |  |  | 14 | return $self->_no_events unless @poll_requests; | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  | # Run all the requests and collect their results | 
| 90 | 9 |  |  |  |  | 24 | my @results = $self->_run_requests($env, \@poll_requests); | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | # No events returned by the handlers? We still gotta return something. | 
| 93 | 9 | 100 |  |  |  | 23 | return $self->_no_events unless @results; | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | # Polling results are always JSON; no content type needed | 
| 96 | 5 |  |  |  |  | 10 | my $serialized = $self->_serialize_results(@results); | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | # And if serialization fails we have to return something positive | 
| 99 | 5 |  | 66 |  |  | 39 | return $serialized || $self->_no_events; | 
| 100 |  |  |  |  |  |  | } | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | ### PUBLIC INSTANCE METHODS ### | 
| 103 |  |  |  |  |  |  | # | 
| 104 |  |  |  |  |  |  | # Simple read-write accessors | 
| 105 |  |  |  |  |  |  | # | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | RPC::ExtDirect::Util::Accessor::mk_accessors( | 
| 108 |  |  |  |  |  |  | simple => [qw/ api config /], | 
| 109 |  |  |  |  |  |  | ); | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | ############## PRIVATE METHODS BELOW ############## | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | ### PRIVATE INSTANCE METHOD ### | 
| 114 |  |  |  |  |  |  | # | 
| 115 |  |  |  |  |  |  | # Return a list of Request::PollHandler objects | 
| 116 |  |  |  |  |  |  | # | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | sub _get_poll_requests { | 
| 119 | 9 |  |  | 9 |  | 11 | my ($self) = @_; | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | # Compile the list of poll handler Methods | 
| 122 | 9 |  |  |  |  | 165 | my @handlers = $self->api->get_poll_handlers(); | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | # Now create the corresponding Request objects | 
| 125 | 9 |  |  |  |  | 9 | my @poll_requests; | 
| 126 | 9 |  |  |  |  | 11 | for my $handler ( @handlers ) { | 
| 127 | 9 |  |  |  |  | 15 | my $req = $self->_create_request($handler); | 
| 128 |  |  |  |  |  |  |  | 
| 129 | 9 | 50 |  |  |  | 23 | push @poll_requests, $req if $req; | 
| 130 |  |  |  |  |  |  | }; | 
| 131 |  |  |  |  |  |  |  | 
| 132 | 9 |  |  |  |  | 19 | return @poll_requests; | 
| 133 |  |  |  |  |  |  | } | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | ### PRIVATE INSTANCE METHOD ### | 
| 136 |  |  |  |  |  |  | # | 
| 137 |  |  |  |  |  |  | # Create Request off a poll handler | 
| 138 |  |  |  |  |  |  | # | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | sub _create_request { | 
| 141 | 9 |  |  | 9 |  | 12 | my ($self, $handler) = @_; | 
| 142 |  |  |  |  |  |  |  | 
| 143 | 9 |  |  |  |  | 166 | my $config      = $self->config; | 
| 144 | 9 |  |  |  |  | 156 | my $api         = $self->api; | 
| 145 | 9 |  |  |  |  | 156 | my $action_name = $handler->action; | 
| 146 | 9 |  |  |  |  | 154 | my $method_name = $handler->name; | 
| 147 |  |  |  |  |  |  |  | 
| 148 | 9 |  |  |  |  | 157 | my $request_class = $config->request_class_eventprovider; | 
| 149 |  |  |  |  |  |  |  | 
| 150 | 9 |  |  |  |  | 409 | eval "require $request_class"; | 
| 151 |  |  |  |  |  |  |  | 
| 152 | 9 |  |  |  |  | 56 | my $req = $request_class->new({ | 
| 153 |  |  |  |  |  |  | config => $config, | 
| 154 |  |  |  |  |  |  | api    => $api, | 
| 155 |  |  |  |  |  |  | action => $action_name, | 
| 156 |  |  |  |  |  |  | method => $method_name, | 
| 157 |  |  |  |  |  |  | }); | 
| 158 |  |  |  |  |  |  |  | 
| 159 | 9 |  |  |  |  | 11 | return $req; | 
| 160 |  |  |  |  |  |  | } | 
| 161 |  |  |  |  |  |  |  | 
| 162 |  |  |  |  |  |  | ### PRIVATE INSTANCE METHOD ### | 
| 163 |  |  |  |  |  |  | # | 
| 164 |  |  |  |  |  |  | # Run poll requests and collect results | 
| 165 |  |  |  |  |  |  | # | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | sub _run_requests { | 
| 168 | 9 |  |  | 9 |  | 12 | my ($self, $env, $requests) = @_; | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  | # Run the requests | 
| 171 | 9 |  |  |  |  | 31 | $_->run($env) for @$requests; | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | # Collect responses | 
| 174 | 9 |  |  |  |  | 11 | my @results = map { $_->result } @$requests; | 
|  | 9 |  |  |  |  | 18 |  | 
| 175 |  |  |  |  |  |  |  | 
| 176 | 9 |  |  |  |  | 14 | return @results; | 
| 177 |  |  |  |  |  |  | } | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | ### PRIVATE CLASS METHOD ### | 
| 180 |  |  |  |  |  |  | # | 
| 181 |  |  |  |  |  |  | # Serialize results | 
| 182 |  |  |  |  |  |  | # | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | sub _serialize_results { | 
| 185 | 5 |  |  | 5 |  | 7 | my ($self, @results) = @_; | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | # Fortunately, client side does understand more than on event | 
| 188 |  |  |  |  |  |  | # batched as array | 
| 189 | 5 | 100 |  |  |  | 16 | my $final_result = @results > 1 ? [ @results ] | 
| 190 |  |  |  |  |  |  | :                  $results[0] | 
| 191 |  |  |  |  |  |  | ; | 
| 192 |  |  |  |  |  |  |  | 
| 193 | 5 |  |  |  |  | 89 | my $config = $self->config; | 
| 194 | 5 |  |  |  |  | 84 | my $api    = $self->api; | 
| 195 | 5 |  |  |  |  | 83 | my $debug  = $config->debug_eventprovider; | 
| 196 |  |  |  |  |  |  |  | 
| 197 | 5 |  |  |  |  | 98 | my $serializer_class = $config->serializer_class_eventprovider; | 
| 198 |  |  |  |  |  |  |  | 
| 199 | 5 |  |  |  |  | 242 | eval "require $serializer_class"; | 
| 200 |  |  |  |  |  |  |  | 
| 201 | 5 |  |  |  |  | 24 | my $serializer = $serializer_class->new( | 
| 202 |  |  |  |  |  |  | config => $config, | 
| 203 |  |  |  |  |  |  | api    => $api, | 
| 204 |  |  |  |  |  |  | ); | 
| 205 |  |  |  |  |  |  |  | 
| 206 | 5 |  |  |  |  | 4 | my $json = eval { | 
| 207 | 5 |  |  |  |  | 18 | $serializer->serialize( | 
| 208 |  |  |  |  |  |  | mute_exceptions => 1, | 
| 209 |  |  |  |  |  |  | debug           => $debug, | 
| 210 |  |  |  |  |  |  | data            => [$final_result], | 
| 211 |  |  |  |  |  |  | ) | 
| 212 |  |  |  |  |  |  | }; | 
| 213 |  |  |  |  |  |  |  | 
| 214 | 5 |  |  |  |  | 19 | return $json; | 
| 215 |  |  |  |  |  |  | } | 
| 216 |  |  |  |  |  |  |  | 
| 217 |  |  |  |  |  |  | ### PRIVATE CLASS METHOD ### | 
| 218 |  |  |  |  |  |  | # | 
| 219 |  |  |  |  |  |  | # Serializes and returns a NoEvents object. | 
| 220 |  |  |  |  |  |  | # | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | sub _no_events { | 
| 223 | 5 |  |  | 5 |  | 4 | my ($self) = @_; | 
| 224 |  |  |  |  |  |  |  | 
| 225 | 5 |  |  |  |  | 92 | my $config = $self->config; | 
| 226 | 5 |  |  |  |  | 83 | my $api    = $self->api; | 
| 227 | 5 |  |  |  |  | 84 | my $debug  = $config->debug_eventprovider; | 
| 228 |  |  |  |  |  |  |  | 
| 229 | 5 |  |  |  |  | 83 | my $serializer_class = $config->serializer_class_eventprovider; | 
| 230 |  |  |  |  |  |  |  | 
| 231 | 5 |  |  |  |  | 208 | eval "require $serializer_class"; | 
| 232 |  |  |  |  |  |  |  | 
| 233 | 5 |  |  |  |  | 22 | my $serializer = $serializer_class->new( | 
| 234 |  |  |  |  |  |  | config => $config, | 
| 235 |  |  |  |  |  |  | api    => $api, | 
| 236 |  |  |  |  |  |  | ); | 
| 237 |  |  |  |  |  |  |  | 
| 238 | 5 |  |  |  |  | 18 | my $no_events  = RPC::ExtDirect::NoEvents->new(); | 
| 239 | 5 |  |  |  |  | 15 | my $result     = $no_events->result(); | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | # NoEvents result can't blow up, hence no eval | 
| 242 | 5 |  |  |  |  | 14 | my $serialized = $serializer->serialize( | 
| 243 |  |  |  |  |  |  | mute_exceptions => !1, | 
| 244 |  |  |  |  |  |  | debug           => $debug, | 
| 245 |  |  |  |  |  |  | data            => [$result], | 
| 246 |  |  |  |  |  |  | ); | 
| 247 |  |  |  |  |  |  |  | 
| 248 | 5 |  |  |  |  | 57 | return $serialized; | 
| 249 |  |  |  |  |  |  | } | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | 1; |