File Coverage

blib/lib/Venus/Role/Deferrable.pm
Criterion Covered Total %
statement 19 20 95.0
branch 3 4 75.0
condition n/a
subroutine 8 8 100.0
pod 1 2 50.0
total 31 34 91.1


line stmt bran cond sub pod time code
1             package Venus::Role::Deferrable;
2              
3 87     87   1479 use 5.018;
  87         308  
4              
5 87     87   450 use strict;
  87         180  
  87         1745  
6 87     87   411 use warnings;
  87         171  
  87         2140  
7              
8 87     87   434 use Venus::Role 'fault';
  87         207  
  87         512  
9              
10             # METHODS
11              
12             sub defer {
13 45     45 1 253 my ($self, $name, @args) = @_;
14              
15 45 100   1   119 return sub {$self} if !$name;
  1         6  
16              
17 44 50       204 my $code = $self->can($name)
18 0         0 or fault "Unable to defer $name: can't find $name in @{[ref $self]}";
19              
20 44     19   426 return sub {@_ = ($self, @args, @_); goto $code};
  19         85  
  19         152  
21             }
22              
23             # EXPORTS
24              
25             sub EXPORT {
26 91     91 0 345 ['defer']
27             }
28              
29             1;
30              
31              
32              
33             =head1 NAME
34              
35             Venus::Role::Deferrable - Deferrable Role
36              
37             =cut
38              
39             =head1 ABSTRACT
40              
41             Deferrable Role for Perl 5
42              
43             =cut
44              
45             =head1 SYNOPSIS
46              
47             package Example;
48              
49             use Venus::Class;
50              
51             with 'Venus::Role::Deferrable';
52              
53             sub test {
54             my ($self, @args) = @_;
55              
56             return $self->okay(@args);
57             }
58              
59             sub okay {
60             my ($self, @args) = @_;
61              
62             return [@args];
63             }
64              
65             package main;
66              
67             my $example = Example->new;
68              
69             # my $code = $example->defer('test');
70              
71             # sub {...}
72              
73             # $code->();
74              
75             # [...]
76              
77             =cut
78              
79             =head1 DESCRIPTION
80              
81             This package provides a mechanism for returning callbacks (i.e. closures) that
82             dispatches method calls.
83              
84             =cut
85              
86             =head1 METHODS
87              
88             This package provides the following methods:
89              
90             =cut
91              
92             =head2 defer
93              
94             defer(Str $method, Any @args) (CodeRef)
95              
96             The defer method returns the named method as a callback (i.e. closure) which
97             dispatches to the method call specified.
98              
99             I>
100              
101             =over 4
102              
103             =item defer example 1
104              
105             # given: synopsis
106              
107             package main;
108              
109             $example = Example->new;
110              
111             # bless({}, 'Example')
112              
113             # my $result = $example->defer('test', 1..4);
114              
115             # $result->();
116              
117             # [1..4]
118              
119             =back
120              
121             =over 4
122              
123             =item defer example 2
124              
125             # given: synopsis
126              
127             package main;
128              
129             $example = Example->new;
130              
131             # bless({}, 'Example')
132              
133             # my $result = $example->defer('test', 1..4);
134              
135             # $result->(1..4);
136              
137             # [1..4, 1..4]
138              
139             =back
140              
141             =over 4
142              
143             =item defer example 3
144              
145             # given: synopsis
146              
147             package main;
148              
149             $example = Example->new;
150              
151             # bless({}, 'Example')
152              
153             # my $result = $example->defer;
154              
155             # $result->();
156              
157             # bless({}, 'Example')
158              
159             =back
160              
161             =cut
162              
163             =head1 AUTHORS
164              
165             Awncorp, C
166              
167             =cut
168              
169             =head1 LICENSE
170              
171             Copyright (C) 2000, Al Newkirk.
172              
173             This program is free software, you can redistribute it and/or modify it under
174             the terms of the Apache license version 2.0.
175              
176             =cut