File Coverage

blib/lib/RPC/ExtDirect/Test/Pkg/Foo.pm
Criterion Covered Total %
statement 39 42 92.8
branch n/a
condition n/a
subroutine 16 17 94.1
pod 0 8 0.0
total 55 67 82.0


line stmt bran cond sub pod time code
1             #
2             # WARNING WARNING WARNING
3             #
4             # DO NOT CHANGE ANYTHING IN THIS MODULE. OTHERWISE, A LOT OF API
5             # AND OTHER TESTS MAY BREAK.
6             #
7             # This module is here to test certain behaviors. If you need
8             # to test something else, add another test module.
9             # It's that simple.
10             #
11              
12             # This does not need to be indexed by PAUSE
13             package
14             RPC::ExtDirect::Test::Pkg::Foo;
15              
16 9     9   3100 use strict;
  9         11  
  9         817  
17 9     9   624 use warnings;
  9         13  
  9         256  
18 9     9   40 no warnings 'uninitialized';
  9         6  
  9         246  
19              
20 9     9   1456 use RPC::ExtDirect;
  9         12  
  9         34  
21              
22             # Return scalar result
23             sub foo_foo : ExtDirect(1, before => \&foo_before) {
24 7     7 0 32 return "foo! '${_[1]}'"
25 9     9   36 }
  9         9  
  9         40  
26              
27             # Return arrayref result
28             sub foo_bar
29             : ExtDirect(2, instead => \&foo_instead)
30             {
31 3     3 0 21 return [ 'foo! bar!', @_[1, 2], ];
32 9     9   1308 }
  9         12  
  9         38  
33              
34             # Return hashref result
35             sub foo_baz : ExtDirect( params => [foo, bar, baz], before => \&foo_before, after => \&foo_after) {
36 5     5 0 7 my $class = shift;
37 5         13 my %param = @_;
38              
39             my $ret = { msg => 'foo! bar! baz!', foo => $param{foo},
40             bar => $param{bar}, baz => $param{baz},
41 5         17 };
42              
43 5         12 delete @param{ qw(foo bar baz) };
44 5         12 @$ret{ keys %param } = values %param;
45              
46 5         14 return $ret;
47 9     9   1457 }
  9         11  
  9         26  
48              
49             # Testing zero parameters
50             sub foo_zero : ExtDirect(0) {
51 0     0 0 0 my ($class) = @_;
52              
53 0         0 my $ret = [ @_ ];
54              
55 0         0 return $ret;
56 9     9   1143 }
  9         13  
  9         31  
57              
58             # Testing blessed object return
59             sub foo_blessed : ExtDirect {
60 1     1 0 11 return bless {}, 'foo';
61 9     9   1021 }
  9         13  
  9         28  
62              
63             # Testing hooks
64             sub foo_before {
65 3     3 0 40 return 1;
66             }
67              
68             sub foo_instead {
69 1     1 0 7 my ($class, %params) = @_;
70              
71 1         3 return $params{orig}->();
72             }
73              
74       2 0   sub foo_after {
75             }
76              
77             1;