File Coverage

blib/lib/Venus/Role/Throwable.pm
Criterion Covered Total %
statement 49 55 89.0
branch 26 32 81.2
condition 2 3 66.6
subroutine 7 7 100.0
pod 2 3 66.6
total 86 100 86.0


line stmt bran cond sub pod time code
1             package Venus::Role::Throwable;
2              
3 87     87   1478 use 5.018;
  87         318  
4              
5 87     87   454 use strict;
  87         194  
  87         1737  
6 87     87   407 use warnings;
  87         219  
  87         2610  
7              
8 87     87   515 use Venus::Role 'with';
  87         220  
  87         591  
9              
10             # METHODS
11              
12             sub error {
13 89     89 1 598 my ($self, $data) = @_;
14              
15 89         296 my @args = $data;
16              
17 89 100       565 unshift @args, delete $data->{throw} if $data->{throw};
18              
19 89         339 @_ = ($self, @args);
20              
21 89         680 goto $self->can('throw');
22             }
23              
24             sub throw {
25 114     114 1 463 my ($self, $data, @args) = @_;
26              
27 114         11541 require Venus::Throw;
28              
29 114         1546 my $throw = Venus::Throw->new(context => (caller(1))[3])->do(
30             frame => 1,
31             );
32              
33 114 100       511 if (!$data) {
34 20         169 return $throw->do(
35             'package', join('::', map ucfirst, ref($self), 'error')
36             );
37             }
38 94 100       431 if (ref $data ne 'HASH') {
39 91 100 66     1178 if ($data =~ /^\w+$/ && $self->can($data)) {
40 90         637 $data = $self->$data(@args);
41             }
42             else {
43 1         5 return $throw->do(
44             'package', $data,
45             );
46             }
47             }
48              
49 93 50       434 if (exists $data->{as}) {
50 0         0 $throw->as($data->{as});
51             }
52 93 100       337 if (exists $data->{capture}) {
53 6         11 $throw->capture(@{$data->{capture}});
  6         25  
54             }
55 93 50       298 if (exists $data->{context}) {
56 0         0 $throw->context($data->{context});
57             }
58 93 50       286 if (exists $data->{error}) {
59 0         0 $throw->error($data->{error});
60             }
61 93 50       271 if (exists $data->{frame}) {
62 0         0 $throw->frame($data->{frame});
63             }
64 93 100       299 if (exists $data->{message}) {
65 86         452 $throw->message($data->{message});
66             }
67 93 100       700 if (exists $data->{name}) {
68 92         642 $throw->name($data->{name});
69             }
70 93 100       528 if (exists $data->{package}) {
71 1         6 $throw->package($data->{package});
72             }
73             else {
74 92         993 $throw->package(join('::', map ucfirst, ref($self), 'error'));
75             }
76 93 50       502 if (exists $data->{parent}) {
77 0         0 $throw->parent($data->{parent});
78             }
79 93 100       331 if (exists $data->{stash}) {
80 87         241 $throw->stash($_, $data->{stash}->{$_}) for keys %{$data->{stash}};
  87         715  
81             }
82 93 50       402 if (exists $data->{on}) {
83 0         0 $throw->on($data->{on});
84             }
85 93 100       349 if (exists $data->{raise}) {
86 88         222 @_ = ($throw);
87 88         810 goto $throw->can('error');
88             }
89              
90 5         52 return $throw;
91             }
92              
93             # EXPORTS
94              
95             sub EXPORT {
96 179     179 0 663 ['error', 'throw']
97             }
98              
99             1;
100              
101              
102              
103             =head1 NAME
104              
105             Venus::Role::Throwable - Throwable Role
106              
107             =cut
108              
109             =head1 ABSTRACT
110              
111             Throwable Role for Perl 5
112              
113             =cut
114              
115             =head1 SYNOPSIS
116              
117             package Example;
118              
119             use Venus::Class;
120              
121             with 'Venus::Role::Throwable';
122              
123             package main;
124              
125             my $example = Example->new;
126              
127             # $example->throw;
128              
129             =cut
130              
131             =head1 DESCRIPTION
132              
133             This package modifies the consuming package and provides a mechanism for
134             throwing context-aware errors (exceptions).
135              
136             =cut
137              
138             =head1 METHODS
139              
140             This package provides the following methods:
141              
142             =cut
143              
144             =head2 error
145              
146             error(HashRef $data) (Any)
147              
148             The error method dispatches to the L method, excepts a hashref of
149             options to be provided to the L method, and returns the result unless
150             an exception is raised automatically. If the C argument
151             is provided it is excepte to be the name of a method used as a callback to
152             provide arguments to the thrower.
153              
154             I>
155              
156             =over 4
157              
158             =item error example 1
159              
160             package main;
161              
162             my $example = Example->new;
163              
164             my $throw = $example->error;
165              
166             # bless({ "package" => "Example::Error", ..., }, "Venus::Throw")
167              
168             # $throw->error;
169              
170             =back
171              
172             =over 4
173              
174             =item error example 2
175              
176             package main;
177              
178             my $example = Example->new;
179              
180             my $throw = $example->error({package => 'Example::Error::Unknown'});
181              
182             # bless({ "package" => "Example::Error::Unknown", ..., }, "Venus::Throw")
183              
184             # $throw->error;
185              
186             =back
187              
188             =over 4
189              
190             =item error example 3
191              
192             package main;
193              
194             my $example = Example->new;
195              
196             my $throw = $example->error({
197             name => 'on.example',
198             capture => [$example],
199             stash => {
200             time => time,
201             },
202             });
203              
204             # bless({ "package" => "Example::Error", ..., }, "Venus::Throw")
205              
206             # $throw->error;
207              
208             =back
209              
210             =over 4
211              
212             =item error example 4
213              
214             # given: synopsis
215              
216             package Example;
217              
218             # ...
219              
220             sub error_on_example {
221             my ($self) = @_;
222              
223             return {
224             name => 'on.example',
225             capture => [$example],
226             stash => {
227             time => time,
228             },
229             };
230             }
231              
232             package main;
233              
234             my $throw = $example->error({throw => 'error_on_example'});
235              
236             # bless({ "package" => "Example::Error", ..., }, "Venus::Throw")
237              
238             # $throw->error;
239              
240             =back
241              
242             =over 4
243              
244             =item error example 5
245              
246             # given: synopsis
247              
248             package Example;
249              
250             # ...
251              
252             sub error_on_example {
253             my ($self) = @_;
254              
255             return {
256             name => 'on.example',
257             capture => [$example],
258             stash => {
259             time => time,
260             },
261             raise => 1,
262             };
263             }
264              
265             package main;
266              
267             my $throw = $example->error({throw => 'error_on_example'});
268              
269             # Exception! (isa Example::Error)
270              
271             =back
272              
273             =cut
274              
275             =head2 throw
276              
277             throw(Maybe[Str | HashRef] $data, Any @args) (Any)
278              
279             The throw method builds a L object, which can raise errors
280             (exceptions). If passed a string representing a package name, the throw object
281             will be configured to throw an exception using that package name. If passed a
282             string representing a method name, the throw object will call that method
283             expecting a hashref to be returned which will be provided to L as
284             arguments to configure the thrower. If passed a hashref, the keys and values
285             are expected to be method names and arguments which will be called to configure
286             the L object returned. If passed additional arguments, assuming
287             they are preceeded by a string representing a method name, the additional
288             arguments will be supplied to the method when called. If the C argument
289             is provided (or returned from the callback), the thrower will automatically
290             throw the exception.
291              
292             I>
293              
294             =over 4
295              
296             =item throw example 1
297              
298             package main;
299              
300             my $example = Example->new;
301              
302             my $throw = $example->throw;
303              
304             # bless({ "package" => "Example::Error", ..., }, "Venus::Throw")
305              
306             # $throw->error;
307              
308             =back
309              
310             =over 4
311              
312             =item throw example 2
313              
314             package main;
315              
316             my $example = Example->new;
317              
318             my $throw = $example->throw('Example::Error::Unknown');
319              
320             # bless({ "package" => "Example::Error::Unknown", ..., }, "Venus::Throw")
321              
322             # $throw->error;
323              
324             =back
325              
326             =over 4
327              
328             =item throw example 3
329              
330             package main;
331              
332             my $example = Example->new;
333              
334             my $throw = $example->throw({
335             name => 'on.example',
336             capture => [$example],
337             stash => {
338             time => time,
339             },
340             });
341              
342             # bless({ "package" => "Example::Error", ..., }, "Venus::Throw")
343              
344             # $throw->error;
345              
346             =back
347              
348             =over 4
349              
350             =item throw example 4
351              
352             # given: synopsis
353              
354             package Example;
355              
356             # ...
357              
358             sub error_on_example {
359             my ($self) = @_;
360              
361             return {
362             name => 'on.example',
363             capture => [$example],
364             stash => {
365             time => time,
366             },
367             };
368             }
369              
370             package main;
371              
372             my $throw = $example->throw('error_on_example');
373              
374             # bless({ "package" => "Example::Error", ..., }, "Venus::Throw")
375              
376             # $throw->error;
377              
378             =back
379              
380             =over 4
381              
382             =item throw example 5
383              
384             # given: synopsis
385              
386             package Example;
387              
388             # ...
389              
390             sub error_on_example {
391             my ($self) = @_;
392              
393             return {
394             name => 'on.example',
395             capture => [$example],
396             stash => {
397             time => time,
398             },
399             raise => 1,
400             };
401             }
402              
403             package main;
404              
405             my $throw = $example->throw('error_on_example');
406              
407             # Exception! (isa Example::Error)
408              
409             =back
410              
411             =cut
412              
413             =head1 AUTHORS
414              
415             Awncorp, C
416              
417             =cut
418              
419             =head1 LICENSE
420              
421             Copyright (C) 2000, Al Newkirk.
422              
423             This program is free software, you can redistribute it and/or modify it under
424             the terms of the Apache license version 2.0.
425              
426             =cut