File Coverage

blib/lib/Venus/Role/Catchable.pm
Criterion Covered Total %
statement 21 22 95.4
branch 10 12 83.3
condition n/a
subroutine 8 8 100.0
pod 2 4 50.0
total 41 46 89.1


line stmt bran cond sub pod time code
1             package Venus::Role::Catchable;
2              
3 87     87   1579 use 5.018;
  87         310  
4              
5 87     87   478 use strict;
  87         194  
  87         1778  
6 87     87   465 use warnings;
  87         220  
  87         2748  
7              
8 87     87   529 use Venus::Role 'fault';
  87         189  
  87         537  
9              
10             # AUDITS
11              
12             sub AUDIT {
13 175     175 0 529 my ($self, $from) = @_;
14              
15 175 50       1084 if (!$from->does('Venus::Role::Tryable')) {
16 0         0 fault "${self} requires ${from} to consume Venus::Role::Tryable";
17             }
18              
19 175         539 return $self;
20             }
21              
22             # METHODS
23              
24             sub catch {
25 293     293 1 1246 my ($self, $method, @args) = @_;
26              
27 293         1957 my @result = $self->try($method, @args)->error(\my $error)->result;
28              
29 293 100       1718 return wantarray ? ($error ? ($error, undef) : ($error, @result)) : $error;
    100          
30             }
31              
32             sub maybe {
33 3     3 1 8 my ($self, $method, @args) = @_;
34              
35 3         10 my @result = $self->try($method, @args)->error(\my $error)->result;
36              
37 3 50       11 return wantarray ? ($error ? (undef) : (@result)) : ($error ? undef : $result[0]);
    100          
    100          
38             }
39              
40             # EXPORTS
41              
42             sub EXPORT {
43 175     175 0 661 ['catch', 'maybe']
44             }
45              
46             1;
47              
48              
49              
50             =head1 NAME
51              
52             Venus::Role::Catchable - Catchable Role
53              
54             =cut
55              
56             =head1 ABSTRACT
57              
58             Catchable Role for Perl 5
59              
60             =cut
61              
62             =head1 SYNOPSIS
63              
64             package Example;
65              
66             use Venus::Class;
67              
68             use Venus 'error';
69              
70             with 'Venus::Role::Tryable';
71             with 'Venus::Role::Catchable';
72              
73             sub pass {
74             true;
75             }
76              
77             sub fail {
78             error;
79             }
80              
81             package main;
82              
83             my $example = Example->new;
84              
85             # my $error = $example->catch('fail');
86              
87             =cut
88              
89             =head1 DESCRIPTION
90              
91             This package modifies the consuming package and provides methods for trapping
92             errors thrown from dispatched method calls.
93              
94             =cut
95              
96             =head1 METHODS
97              
98             This package provides the following methods:
99              
100             =cut
101              
102             =head2 catch
103              
104             catch(Str $method, Any @args) (Any)
105              
106             The catch method traps any errors raised by executing the dispatched method
107             call and returns the error string or error object. This method can return a
108             list of values in list-context. This method supports dispatching, i.e.
109             providing a method name and arguments whose return value will be acted on by
110             this method.
111              
112             I>
113              
114             =over 4
115              
116             =item catch example 1
117              
118             package main;
119              
120             my $example = Example->new;
121              
122             my $catch = $example->catch('fail');
123              
124             # bless({...}, "Venus::Error")
125              
126             =back
127              
128             =over 4
129              
130             =item catch example 2
131              
132             package main;
133              
134             my $example = Example->new;
135              
136             my $catch = $example->catch('pass');
137              
138             # undef
139              
140             =back
141              
142             =over 4
143              
144             =item catch example 3
145              
146             package main;
147              
148             my $example = Example->new;
149              
150             my ($catch, $result) = $example->catch('pass');
151              
152             # (undef, 1)
153              
154             =back
155              
156             =over 4
157              
158             =item catch example 4
159              
160             package main;
161              
162             my $example = Example->new;
163              
164             my ($catch, $result) = $example->catch('fail');
165              
166             # (bless({...}, "Venus::Error"), undef)
167              
168             =back
169              
170             =cut
171              
172             =head2 maybe
173              
174             maybe(Str $method, Any @args) (Any)
175              
176             The maybe method traps any errors raised by executing the dispatched method
177             call and returns undefined on error, effectively supressing the error. This
178             method can return a list of values in list-context. This method supports
179             dispatching, i.e. providing a method name and arguments whose return value
180             will be acted on by this method.
181              
182             I>
183              
184             =over 4
185              
186             =item maybe example 1
187              
188             package main;
189              
190             my $example = Example->new;
191              
192             my $maybe = $example->maybe('fail');
193              
194             # undef
195              
196             =back
197              
198             =over 4
199              
200             =item maybe example 2
201              
202             package main;
203              
204             my $example = Example->new;
205              
206             my $maybe = $example->maybe('pass');
207              
208             # true
209              
210             =back
211              
212             =over 4
213              
214             =item maybe example 3
215              
216             package main;
217              
218             my $example = Example->new;
219              
220             my (@maybe) = $example->maybe(sub {1..4});
221              
222             # (1..4)
223              
224             =back
225              
226             =cut
227              
228             =head1 AUTHORS
229              
230             Awncorp, C
231              
232             =cut
233              
234             =head1 LICENSE
235              
236             Copyright (C) 2000, Al Newkirk.
237              
238             This program is free software, you can redistribute it and/or modify it under
239             the terms of the Apache license version 2.0.
240              
241             =cut