File Coverage

blib/lib/RPC/ExtDirect/API.pm
Criterion Covered Total %
statement 187 195 95.9
branch 58 76 76.3
condition 18 34 52.9
subroutine 25 25 100.0
pod 14 14 100.0
total 302 344 87.7


line stmt bran cond sub pod time code
1             package RPC::ExtDirect::API;
2              
3 27     27   2857 use strict;
  27         30  
  27         623  
4 27     27   84 use warnings;
  27         28  
  27         565  
5 27     27   82 no warnings 'uninitialized'; ## no critic
  27         28  
  27         618  
6              
7 27     27   86 use Carp;
  27         26  
  27         1252  
8              
9 27     27   5128 use RPC::ExtDirect::Config;
  27         37  
  27         541  
10 27     27   9737 use RPC::ExtDirect::Serializer;
  27         45  
  27         541  
11 27     27   106 use RPC::ExtDirect::Util::Accessor;
  27         29  
  27         41942  
12              
13             ### PACKAGE GLOBAL VARIABLE ###
14             #
15             # Turn this on for debugging
16             #
17             # DEPRECATED. Use `debug_api` or `debug` Config options instead.
18             #
19              
20             our $DEBUG;
21              
22             ### PUBLIC PACKAGE SUBROUTINE ###
23             #
24             # Does not import anything to caller namespace but accepts
25             # configuration parameters. This method always operates on
26             # the "default" API object stored in RPC::ExtDirect
27             #
28              
29             sub import {
30 38     38   754 my ($class, @args) = @_;
31              
32             # Nothing to do
33 38 100       4733 return unless @args;
34              
35             # Only hash-like arguments are supported
36 8 50       27 croak 'Odd number of arguments in RPC::ExtDirect::API::import()'
37             unless (@args % 2) == 0;
38              
39 8         28 my %arg = @args;
40 8         22 %arg = map { lc $_ => delete $arg{ $_ } } keys %arg;
  28         61  
41            
42             # In most cases that's a formality since RPC::ExtDirect
43             # should be already required elsewhere; some test scripts
44             # may not load it on purpose so we guard against that
45             # just in case. We don't want to `use` RPC::ExtDirect above,
46             # because that would create a circular dependency.
47 8         36 require RPC::ExtDirect;
48              
49 8         25 my $api = RPC::ExtDirect->get_api;
50            
51 8         18 for my $type ( $class->HOOK_TYPES ) {
52 24         28 my $code = delete $arg{ $type };
53            
54 24 100       56 $api->add_hook( type => $type, code => $code )
55             if $code;
56             };
57            
58 8         192 my $api_config = $api->config;
59            
60 8         136 for my $option ( keys %arg ) {
61 18         14 my $value = $arg{$option};
62            
63 18         334 $api_config->$option($value);
64             }
65             }
66              
67             ### PUBLIC CLASS METHOD (ACCESSOR) ###
68             #
69             # Return the hook types supported by the API
70             #
71              
72 83     83 1 204 sub HOOK_TYPES { qw/ before instead after/ }
73              
74             ### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
75             #
76             # Init a new API object
77             #
78              
79             sub new {
80 26     26 1 42 my $class = shift;
81            
82 26 50 33     177 my %arg = @_ == 1 && 'HASH' eq ref($_[0]) ? %{ $_[0] } : @_;
  0         0  
83            
84 26   66     150 $arg{config} ||= RPC::ExtDirect::Config->new();
85            
86 26         128 return bless {
87             %arg,
88             actions => {},
89             }, $class;
90             }
91              
92             ### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
93             #
94             # Init a new API object and populate it from the supplied hashref
95             #
96              
97             sub new_from_hashref {
98 4     4 1 36 my ($class, %arg) = @_;
99            
100 4         8 my $api_href = delete $arg{api_href};
101            
102 4         12 my $self = $class->new(%arg);
103            
104 4         25 $self->init_from_hashref($api_href);
105            
106 4         13 return $self;
107             }
108              
109             ### PUBLIC INSTANCE METHOD ###
110             #
111             # Initialize the API from a hashref
112             #
113              
114             sub init_from_hashref {
115 4     4 1 8 my ($self, $api_href) = @_;
116            
117             # Global hooks go first
118 4         9 for my $type ( $self->HOOK_TYPES ) {
119             $self->add_hook( type => $type, code => delete $api_href->{$type} )
120 12 100       29 if exists $api_href->{$type};
121             }
122            
123 4         13 for my $key ( keys %$api_href ) {
124 14         16 my $action_def = $api_href->{ $key };
125 14         18 my $remote = $action_def->{remote};
126 14 100       22 my $package = $remote ? undef : $key;
127 14 100       23 my $action_name = $remote ? $key : $action_def->{action};
128            
129 14         30 my $action = $self->add_action(
130             action => $action_name,
131             package => $package,
132             no_overwrite => 1,
133             );
134            
135 14 100       32 for my $hook_type ( $remote ? () : $self->HOOK_TYPES ) {
136 18         18 my $hook_code = $action_def->{$hook_type};
137            
138 18 50       25 if ( $hook_code ) {
139 0         0 $self->add_hook(
140             package => $package,
141             type => $hook_type,
142             code => $hook_code,
143             );
144             }
145             }
146            
147 14         17 my $methods = $action_def->{methods};
148            
149 14         28 for my $method_name ( keys %$methods ) {
150 56         55 my $method_def = $methods->{ $method_name };
151            
152 56         135 $self->add_method(
153             action => $action_name,
154             package => $package,
155             method => $method_name,
156             %$method_def
157             );
158             }
159             }
160             }
161              
162             ### PUBLIC INSTANCE METHOD ###
163             #
164             # Returns the JavaScript chunk for REMOTING_API
165             #
166              
167             sub get_remoting_api {
168 8     8 1 3321 my ($class, %arg) = @_;
169            
170 8         11 my ($self, $config);
171            
172             # There is an option to pass config externally; mainly for testing
173 8         13 $config = $arg{config};
174            
175             # Environment object is optional
176 8         10 my $env = $arg{env};
177            
178             # Backwards compatibility: if called as a class method, operate on
179             # the "global" API object instead, and create a new Config instance
180             # as well to take care of possibly-modified-since global variables
181 8 100       22 if ( ref $class ) {
182 5         6 $self = $class;
183 5   33     113 $config ||= $self->config;
184             }
185             else {
186 3         12 require RPC::ExtDirect;
187              
188 3         16 $self = RPC::ExtDirect->get_api();
189 3   66     29 $config ||= $self->config->clone();
190            
191 3         27 $config->read_global_vars();
192             }
193            
194             # Get REMOTING_API hashref
195 8         26 my $remoting_api = $self->_get_remoting_api($config, $env);
196              
197             # Get POLLING_API hashref
198 8         26 my $polling_api = $self->_get_polling_api($config, $env);
199              
200             # Return empty string if we got nothing to declare
201 8 0 33     20 return '' if !$remoting_api && !$polling_api;
202              
203             # Shortcuts
204 8         141 my $remoting_var = $config->remoting_var;
205 8         136 my $polling_var = $config->polling_var;
206 8         141 my $auto_connect = $config->auto_connect;
207 8         154 my $no_polling = $config->no_polling;
208 8         160 my $s_class = $config->serializer_class_api;
209 8         154 my $debug_api = $config->debug_api;
210            
211 8         49 my $serializer = $s_class->new( config => $config );
212            
213 8         28 my $api_json = $serializer->serialize(
214             mute_exceptions => 1,
215             debug => $debug_api,
216             data => [$remoting_api],
217             );
218              
219             # Compile JavaScript for REMOTING_API
220 8   50     44 my $js_chunk = "$remoting_var = " . ($api_json || '{}') . ";\n";
221              
222             # If auto_connect is on, add client side initialization code
223 8 100       21 $js_chunk .= "Ext.direct.Manager.addProvider($remoting_var);\n"
224             if $auto_connect;
225              
226             # POLLING_API is added only when there's something in it
227 8 100 66     31 if ( $polling_api && !$no_polling ) {
228 5         18 $api_json = $serializer->serialize(
229             mute_exceptions => 1,
230             debug => $debug_api,
231             data => [$polling_api],
232             );
233            
234 5   50     43 $js_chunk .= "$polling_var = " . ($api_json || '{}' ) . ";\n";
235              
236             # Same initialization code for POLLING_API if auto connect is on
237 5 100       18 $js_chunk .= "Ext.direct.Manager.addProvider($polling_var);\n"
238             if $auto_connect;
239             };
240              
241 8         120 return $js_chunk;
242             }
243              
244             ### PUBLIC INSTANCE METHOD ###
245             #
246             # Get the list of all defined Actions' names
247             #
248              
249 3     3 1 4 sub actions { keys %{ $_[0]->{actions} } }
  3         22  
250              
251             ### PUBLIC INSTANCE METHOD ###
252             #
253             # Add an Action (class), or update if it exists
254             #
255              
256             sub add_action {
257 85     85 1 195 my ($self, %arg) = @_;
258            
259             $arg{action} = $self->_get_action_name( $arg{package} )
260 85 100       237 unless defined $arg{action};
261            
262 85         97 my $action_name = $arg{action};
263            
264             return $self->{actions}->{ $action_name }
265 85 100 66     270 if $arg{no_overwrite} && exists $self->{actions}->{ $action_name };
266            
267 84         1655 my $config = $self->config;
268 84         1816 my $a_class = $config->api_action_class();
269            
270             # This is to avoid hard binding on the Action class
271 84         3683 eval "require $a_class";
272            
273 84         419 my $action_obj = $a_class->new(
274             config => $config,
275             %arg,
276             );
277            
278 84         199 $self->{actions}->{ $action_name } = $action_obj;
279            
280 84         169 return $action_obj;
281             }
282              
283             ### PUBLIC INSTANCE METHOD ###
284             #
285             # Return Action object by its name
286             #
287              
288             sub get_action_by_name {
289 539     539 1 462 my ($self, $action_name) = @_;
290            
291 539         702 return $self->{actions}->{ $action_name };
292             }
293              
294             ### PUBLIC INSTANCE METHOD ###
295             #
296             # Return Action object by package name
297             #
298              
299             sub get_action_by_package {
300 396     396 1 342 my ($self, $package) = @_;
301            
302 396         290 for my $action ( values %{ $self->{actions} } ) {
  396         882  
303 650 100       12331 return $action if $action->package eq $package;
304             }
305            
306 33         59 return;
307             }
308              
309             ### PUBLIC INSTANCE METHOD ###
310             #
311             # Add a Method, or update if it exists.
312             # Also create the Method's Action if it doesn't exist yet
313             #
314              
315             sub add_method {
316 364     364 1 712 my ($self, %arg) = @_;
317            
318 364         396 my $package = delete $arg{package};
319 364         377 my $action_name = delete $arg{action};
320 364         314 my $method_name = $arg{method};
321            
322             # Try to find the Action by the package name
323 364 100       710 my $action = $action_name ? $self->get_action_by_name($action_name)
324             : $self->get_action_by_package($package)
325             ;
326            
327             # If Action is not found, create a new one
328 364 100       592 if ( !$action ) {
329 33 50       112 $action_name = $self->_get_action_name($package)
330             unless $action_name;
331            
332 33         97 $action = $self->add_action(
333             action => $action_name,
334             package => $package,
335             );
336             }
337            
338             # Usually redefining a Method means a typo or something
339 364 0       1675 croak "Attempting to redefine Method '$method_name' ".
    50          
340             ($package ? "in package $package" : "in Action '$action_name'")
341             if $action->can($method_name);
342            
343 364         792 $action->add_method(\%arg);
344             }
345              
346             ### PUBLIC INSTANCE METHOD ###
347             #
348             # Return the Method object by Action and Method name
349             #
350              
351             sub get_method_by_name {
352 93     93 1 135 my ($self, $action_name, $method_name) = @_;
353            
354 93         154 my $action = $self->get_action_by_name($action_name);
355            
356 93 100       178 return unless $action;
357            
358 90         207 return $action->method($method_name);
359             }
360              
361             ### PUBLIC INSTANCE METHOD ###
362             #
363             # Add a hook instance
364             #
365              
366             sub add_hook {
367 52     52 1 118 my ($self, %arg) = @_;
368            
369 52         65 my $package = $arg{package};
370 52         49 my $action_name = $arg{action};
371 52         52 my $method_name = $arg{method};
372 52         50 my $type = $arg{type};
373 52         47 my $code = $arg{code};
374            
375 52         1035 my $hook_class = $self->config->api_hook_class;
376            
377             # This is to avoid hard binding on RPC::ExtDirect::API::Hook
378 52         51 { local $@; eval "require $hook_class"; }
  52         54  
  52         2048  
379            
380 52         200 my $hook = $hook_class->new( type => $type, code => $code );
381            
382 52 100 66     162 if ( $package || $action_name ) {
383 40         40 my $action;
384            
385 40 50       65 if ( $package ) {
386 40         104 $action = $self->get_action_by_package($package);
387            
388 40 50       92 croak "Can't find the Action for package '$package'"
389             unless $action;
390             }
391             else {
392 0         0 $action = $self->get_action_by_name($action_name);
393            
394 0 0       0 croak "Can't find the '$action_name' Action"
395             unless $action;
396             }
397            
398 40 50       66 if ( $method_name ) {
399 0         0 my $method = $action->method($method_name);
400            
401 0 0       0 croak "Can't find Method '$method_name'"
402             unless $method;
403            
404 0         0 $method->$type($hook);
405             }
406             else {
407 40         726 $action->$type($hook);
408             }
409             }
410             else {
411 12         275 $self->$type($hook);
412             }
413            
414 52         502 return $hook;
415             }
416              
417             ### PUBLIC INSTANCE METHOD ###
418             #
419             # Return the hook object by Method name, Action or package, and type
420             #
421              
422             sub get_hook {
423 411     411 1 824 my ($self, %arg) = @_;
424            
425             my ($action_name, $package, $method_name, $type)
426 411         556 = @arg{qw/ action package method type/};
427            
428 411 100       756 my $action = $action_name ? $self->get_action_by_name($action_name)
429             : $self->get_action_by_package($package)
430             ;
431            
432 411 50 0     619 croak "Can't find action '", ($action_name || $package),
433             "' for Method $method_name"
434             unless $action;
435            
436 411         722 my $method = $action->method($method_name);
437            
438 411   100     7960 my $hook = $method->$type || $action->$type || $self->$type;
439            
440 411         2543 return $hook;
441             }
442              
443             ### PUBLIC INSTANCE METHOD ###
444             #
445             # Return the list of all installed poll handlers
446             #
447              
448             sub get_poll_handlers {
449 9     9 1 9 my ($self) = @_;
450            
451 9         8 my @handlers;
452            
453             ACTION:
454 9         10 for my $action ( values %{ $self->{actions} } ) {
  9         22  
455 17         41 my @methods = map { $action->method($_) }
  9         18  
456             $action->polling_methods();
457            
458 17         26 push @handlers, @methods;
459             }
460            
461 9         22 return @handlers;
462             }
463              
464             ### PUBLIC INSTANCE METHODS ###
465             #
466             # Simple read-write accessors
467             #
468              
469             my $accessors = [qw/
470             config
471             /,
472             __PACKAGE__->HOOK_TYPES,
473             ];
474              
475             RPC::ExtDirect::Util::Accessor::mk_accessors(
476             simple => $accessors,
477             );
478              
479             ############## PRIVATE METHODS BELOW ##############
480              
481             ### PRIVATE CLASS METHOD ###
482             #
483             # Prepare REMOTING_API hashref
484             #
485              
486             sub _get_remoting_api {
487 8     8   12 my ($self, $config, $env) = @_;
488              
489 8         7 my %api;
490            
491 8         10 my %actions = %{ $self->{actions} };
  8         39  
492            
493             ACTION:
494 8         29 foreach my $name (keys %actions) {
495 33         39 my $action = $actions{$name};
496              
497             # Get the list of methods for Action
498 33         69 my @methods = $action->remoting_api($env);
499              
500 33 100       81 next ACTION unless @methods;
501            
502 26         65 $api{ $name } = [ @methods ];
503             };
504              
505             # Compile hashref
506 8         148 my $remoting_api = {
507             url => $config->router_path,
508             type => 'remoting',
509             actions => { %api },
510             };
511              
512             # Add timeout if it's defined
513 8 100       151 $remoting_api->{timeout} = $config->timeout
514             if $config->timeout;
515              
516             # Add maxRetries if it's defined
517 8 100       140 $remoting_api->{maxRetries} = $config->max_retries
518             if $config->max_retries;
519              
520             # Add namespace if it's defined
521 8 100       139 $remoting_api->{namespace} = $config->namespace
522             if $config->namespace;
523              
524 8         21 return $remoting_api;
525             }
526              
527             ### PRIVATE CLASS METHOD ###
528             #
529             # Returns POLLING_API definition hashref
530             #
531              
532             sub _get_polling_api {
533 8     8   16 my ($self, $config, $env) = @_;
534            
535             # Check if we have any poll handlers in our definitions
536 8         7 my $has_poll_handlers;
537            
538 8         8 my %actions = %{ $self->{actions} };
  8         27  
539            
540             ACTION:
541 8         20 foreach my $name (keys %actions) {
542 26         220 my $action = $actions{$name};
543 26         50 $has_poll_handlers = $action->has_pollHandlers($env);
544              
545 26 100       56 last ACTION if $has_poll_handlers;
546             };
547              
548             # No sense in setting up polling if there ain't no Event providers
549 8 100       22 return undef unless $has_poll_handlers; ## no critic
550            
551             # Got poll handlers, return definition hashref
552             return {
553 5         94 type => 'polling',
554             url => $config->poll_path,
555             };
556             }
557              
558             ### PRIVATE INSTANCE METHOD ###
559             #
560             # Make an Action name from a package name (strip namespace)
561             #
562              
563             sub _get_action_name {
564 60     60   81 my ($self, $action_name) = @_;
565            
566 60 50       1363 if ( $self->config->api_full_action_names ) {
567 0         0 $action_name =~ s/::/./g;
568             }
569             else {
570 60         208 $action_name =~ s/^.*:://;
571             }
572            
573 60         112 return $action_name;
574             }
575              
576             1;