| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package RPC::ExtDirect::Router; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 4 |  |  | 4 |  | 1595 | use strict; | 
|  | 4 |  |  |  |  | 4 |  | 
|  | 4 |  |  |  |  | 87 |  | 
| 4 | 4 |  |  | 4 |  | 11 | use warnings; | 
|  | 4 |  |  |  |  | 4 |  | 
|  | 4 |  |  |  |  | 78 |  | 
| 5 | 4 |  |  | 4 |  | 15 | no  warnings 'uninitialized';       ## no critic | 
|  | 4 |  |  |  |  | 4 |  | 
|  | 4 |  |  |  |  | 88 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 4 |  |  | 4 |  | 314 | use RPC::ExtDirect::Util::Accessor; | 
|  | 4 |  |  |  |  | 108 |  | 
|  | 4 |  |  |  |  | 73 |  | 
| 8 | 4 |  |  | 4 |  | 334 | use RPC::ExtDirect::Config; | 
|  | 4 |  |  |  |  | 4 |  | 
|  | 4 |  |  |  |  | 68 |  | 
| 9 | 4 |  |  | 4 |  | 976 | use RPC::ExtDirect; | 
|  | 4 |  |  |  |  | 3 |  | 
|  | 4 |  |  |  |  | 13 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | ### PACKAGE GLOBAL VARIABLE ### | 
| 12 |  |  |  |  |  |  | # | 
| 13 |  |  |  |  |  |  | # Turn this on for debug output | 
| 14 |  |  |  |  |  |  | # | 
| 15 |  |  |  |  |  |  | # DEPRECATED. Use `debug_router` or `debug` Config options instead. | 
| 16 |  |  |  |  |  |  | # | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | our $DEBUG; | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | ### PACKAGE GLOBAL VARIABLE ### | 
| 21 |  |  |  |  |  |  | # | 
| 22 |  |  |  |  |  |  | # Set Serializer class name so it could be configured | 
| 23 |  |  |  |  |  |  | # | 
| 24 |  |  |  |  |  |  | # DEPRECATED. Use `serializer_class_router` or `serializer_class` | 
| 25 |  |  |  |  |  |  | # Config options instead. | 
| 26 |  |  |  |  |  |  | # | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | our $SERIALIZER_CLASS; | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | ### PACKAGE GLOBAL VARIABLE ### | 
| 31 |  |  |  |  |  |  | # | 
| 32 |  |  |  |  |  |  | # Set Deserializer class name so it could be configured | 
| 33 |  |  |  |  |  |  | # | 
| 34 |  |  |  |  |  |  | # DEPRECATED. Use `deserializer_class_router` or `deserializer_class` | 
| 35 |  |  |  |  |  |  | # Config options instead. | 
| 36 |  |  |  |  |  |  | # | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | our $DESERIALIZER_CLASS; | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | ### PACKAGE GLOBAL VARIABLE ### | 
| 41 |  |  |  |  |  |  | # | 
| 42 |  |  |  |  |  |  | # Set Exception class name so it could be configured | 
| 43 |  |  |  |  |  |  | # | 
| 44 |  |  |  |  |  |  | # DEPRECATED. Use `exception_class_deserialize` or `exception_class` | 
| 45 |  |  |  |  |  |  | # Config options instead. | 
| 46 |  |  |  |  |  |  | # | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | our $EXCEPTION_CLASS; | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | ### PACKAGE GLOBAL VARIABLE ### | 
| 51 |  |  |  |  |  |  | # | 
| 52 |  |  |  |  |  |  | # Set Request class name so it could be configured | 
| 53 |  |  |  |  |  |  | # | 
| 54 |  |  |  |  |  |  | # DEPRECATED. Use `request_class_deserialize` or `request_class` | 
| 55 |  |  |  |  |  |  | # Config options instead. | 
| 56 |  |  |  |  |  |  | # | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | our $REQUEST_CLASS; | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | ### PUBLIC CLASS METHOD (CONSTRUCTOR) ### | 
| 61 |  |  |  |  |  |  | # | 
| 62 |  |  |  |  |  |  | # Create a new Router object with default API and Config | 
| 63 |  |  |  |  |  |  | # | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | sub new { | 
| 66 | 30 |  |  | 30 | 0 | 95 | my ($class, %arg) = @_; | 
| 67 |  |  |  |  |  |  |  | 
| 68 | 30 |  | 66 |  |  | 83 | $arg{config} ||= RPC::ExtDirect::Config->new(); | 
| 69 | 30 |  | 33 |  |  | 123 | $arg{api}    ||= RPC::ExtDirect->get_api(); | 
| 70 |  |  |  |  |  |  |  | 
| 71 | 30 |  |  |  |  | 96 | return bless { %arg }, $class; | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | ### PUBLIC CLASS/INSTANCE METHOD ### | 
| 75 |  |  |  |  |  |  | # | 
| 76 |  |  |  |  |  |  | # Route the request(s) and return serialized responses | 
| 77 |  |  |  |  |  |  | # | 
| 78 |  |  |  |  |  |  | # Note that the preferred way to call this method is on the Router | 
| 79 |  |  |  |  |  |  | # object instance, but we support the class-based way for backwards | 
| 80 |  |  |  |  |  |  | # compatibility. | 
| 81 |  |  |  |  |  |  | # | 
| 82 |  |  |  |  |  |  | # Be aware that the only supported way to configure the Router | 
| 83 |  |  |  |  |  |  | # is to pass a Config object to the constructor and then call route() | 
| 84 |  |  |  |  |  |  | # on the instance. | 
| 85 |  |  |  |  |  |  | # | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | sub route { | 
| 88 | 30 |  |  | 30 | 0 | 8855 | my ($class, $input, $env) = @_; | 
| 89 |  |  |  |  |  |  |  | 
| 90 | 30 | 100 |  |  |  | 53 | my $self = ref($class) ? $class : $class->new(); | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | # Decode requests | 
| 93 | 30 |  |  |  |  | 52 | my ($has_upload, $requests) = $self->_decode_requests($input); | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | # Run requests and collect responses | 
| 96 | 30 |  |  |  |  | 54 | my $responses = $self->_run_requests($env, $requests); | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | # Serialize responses | 
| 99 | 30 |  |  |  |  | 49 | my $result = $self->_serialize_responses($responses); | 
| 100 |  |  |  |  |  |  |  | 
| 101 | 30 |  |  |  |  | 50 | my $http_response = $self->_format_response($result, $has_upload); | 
| 102 |  |  |  |  |  |  |  | 
| 103 | 30 |  |  |  |  | 190 | return $http_response; | 
| 104 |  |  |  |  |  |  | } | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | ### PUBLIC INSTANCE METHODS ### | 
| 107 |  |  |  |  |  |  | # | 
| 108 |  |  |  |  |  |  | # Read-write accessors. | 
| 109 |  |  |  |  |  |  | # | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | RPC::ExtDirect::Util::Accessor::mk_accessors( | 
| 112 |  |  |  |  |  |  | simple => [qw/ api config /], | 
| 113 |  |  |  |  |  |  | ); | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | ############## PRIVATE METHODS BELOW ############## | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | ### PRIVATE INSTANCE METHOD ### | 
| 118 |  |  |  |  |  |  | # | 
| 119 |  |  |  |  |  |  | # Decode requests | 
| 120 |  |  |  |  |  |  | # | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | sub _decode_requests { | 
| 123 | 30 |  |  | 30 |  | 27 | my ($self, $input) = @_; | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | # $input can be scalar containing POST data, | 
| 126 |  |  |  |  |  |  | # or a hashref containing form data | 
| 127 | 30 |  |  |  |  | 35 | my $has_form   = ref $input eq 'HASH'; | 
| 128 | 30 |  | 100 |  |  | 66 | my $has_upload = $has_form && $input->{extUpload} eq 'true'; | 
| 129 |  |  |  |  |  |  |  | 
| 130 | 30 |  |  |  |  | 546 | my $config = $self->config; | 
| 131 | 30 |  |  |  |  | 491 | my $api    = $self->api; | 
| 132 | 30 |  |  |  |  | 484 | my $debug  = $config->debug_router; | 
| 133 |  |  |  |  |  |  |  | 
| 134 | 30 |  |  |  |  | 503 | my $deserializer_class = $config->deserializer_class_router; | 
| 135 |  |  |  |  |  |  |  | 
| 136 | 30 |  |  |  |  | 1278 | eval "require $deserializer_class"; | 
| 137 |  |  |  |  |  |  |  | 
| 138 | 30 |  |  |  |  | 110 | my $dser = $deserializer_class->new( config => $config, api => $api ); | 
| 139 |  |  |  |  |  |  |  | 
| 140 | 30 | 100 |  |  |  | 82 | my $requests | 
| 141 |  |  |  |  |  |  | = $has_form ? $dser->decode_form(data => $input, debug => $debug) | 
| 142 |  |  |  |  |  |  | :             $dser->decode_post(data => $input, debug => $debug) | 
| 143 |  |  |  |  |  |  | ; | 
| 144 |  |  |  |  |  |  |  | 
| 145 | 30 |  |  |  |  | 88 | return ($has_upload, $requests); | 
| 146 |  |  |  |  |  |  | } | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | ### PRIVATE INSTANCE METHOD ### | 
| 149 |  |  |  |  |  |  | # | 
| 150 |  |  |  |  |  |  | # Run the requests and return their results | 
| 151 |  |  |  |  |  |  | # | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | sub _run_requests { | 
| 154 | 30 |  |  | 30 |  | 26 | my ($self, $env, $requests) = @_; | 
| 155 |  |  |  |  |  |  |  | 
| 156 | 30 |  |  |  |  | 26 | my @responses; | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | # Run the requests, collect the responses | 
| 159 | 30 |  |  |  |  | 43 | for my $request ( @$requests ) { | 
| 160 | 32 |  |  |  |  | 63 | $request->run($env); | 
| 161 | 32 |  |  |  |  | 57 | push @responses, $request->result(); | 
| 162 |  |  |  |  |  |  | } | 
| 163 |  |  |  |  |  |  |  | 
| 164 | 30 |  |  |  |  | 41 | return \@responses; | 
| 165 |  |  |  |  |  |  | } | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | ### PRIVATE INSTANCE METHOD ### | 
| 168 |  |  |  |  |  |  | # | 
| 169 |  |  |  |  |  |  | # Serialize the responses and return result | 
| 170 |  |  |  |  |  |  | # | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | sub _serialize_responses { | 
| 173 | 30 |  |  | 30 |  | 28 | my ($self, $responses) = @_; | 
| 174 |  |  |  |  |  |  |  | 
| 175 | 30 |  |  |  |  | 521 | my $api    = $self->api; | 
| 176 | 30 |  |  |  |  | 490 | my $config = $self->config; | 
| 177 | 30 |  |  |  |  | 488 | my $debug  = $config->debug_router; | 
| 178 |  |  |  |  |  |  |  | 
| 179 | 30 |  |  |  |  | 536 | my $serializer_class = $config->serializer_class_router; | 
| 180 |  |  |  |  |  |  |  | 
| 181 | 30 |  |  |  |  | 1238 | eval "require $serializer_class"; | 
| 182 |  |  |  |  |  |  |  | 
| 183 | 30 |  |  |  |  | 116 | my $serializer | 
| 184 |  |  |  |  |  |  | = $serializer_class->new( config => $config, api => $api ); | 
| 185 |  |  |  |  |  |  |  | 
| 186 | 30 |  |  |  |  | 70 | my $result = $serializer->serialize( | 
| 187 |  |  |  |  |  |  | mute_exceptions => !1, | 
| 188 |  |  |  |  |  |  | debug           => $debug, | 
| 189 |  |  |  |  |  |  | data            => $responses, | 
| 190 |  |  |  |  |  |  | ); | 
| 191 |  |  |  |  |  |  |  | 
| 192 | 30 |  |  |  |  | 79 | return $result; | 
| 193 |  |  |  |  |  |  | } | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  | ### PRIVATE INSTANCE METHOD ### | 
| 196 |  |  |  |  |  |  | # | 
| 197 |  |  |  |  |  |  | # Format Plack-compatible HTTP response | 
| 198 |  |  |  |  |  |  | # | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | sub _format_response { | 
| 201 | 30 |  |  | 30 |  | 37 | my ($self, $result, $has_upload) = @_; | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  | # Wrap in HTML if that was form upload request | 
| 204 | 30 | 100 |  |  |  | 57 | $result = "" | 
| 205 |  |  |  |  |  |  | if $has_upload; | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | # Form upload responses are JSON wrapped in HTML, not plain JSON | 
| 208 | 30 | 100 |  |  |  | 42 | my $content_type = $has_upload ? 'text/html' : 'application/json'; | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | # We need content length in octets | 
| 211 | 4 |  |  | 4 |  | 17 | my $content_length = do { no warnings; use bytes; length $result }; | 
|  | 4 |  |  | 4 |  | 6 |  | 
|  | 4 |  |  |  |  | 96 |  | 
|  | 4 |  |  |  |  | 2061 |  | 
|  | 4 |  |  |  |  | 30 |  | 
|  | 4 |  |  |  |  | 15 |  | 
|  | 30 |  |  |  |  | 23 |  | 
|  | 30 |  |  |  |  | 32 |  | 
| 212 |  |  |  |  |  |  |  | 
| 213 |  |  |  |  |  |  | return [ | 
| 214 | 30 |  |  |  |  | 75 | 200, | 
| 215 |  |  |  |  |  |  | [ | 
| 216 |  |  |  |  |  |  | 'Content-Type',   $content_type, | 
| 217 |  |  |  |  |  |  | 'Content-Length', $content_length, | 
| 218 |  |  |  |  |  |  | ], | 
| 219 |  |  |  |  |  |  | [ $result ], | 
| 220 |  |  |  |  |  |  | ]; | 
| 221 |  |  |  |  |  |  | } | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | 1; |