File Coverage

blib/lib/Data/Object/Exception.pm
Criterion Covered Total %
statement 61 61 100.0
branch 13 18 72.2
condition 6 10 60.0
subroutine 11 11 100.0
pod 3 5 60.0
total 94 105 89.5


line stmt bran cond sub pod time code
1             package Data::Object::Exception;
2              
3 1     1   285011 use 5.014;
  1         5  
4              
5 1     1   5 use strict;
  1         2  
  1         25  
6 1     1   5 use warnings;
  1         2  
  1         29  
7 1     1   6 use routines;
  1         2  
  1         8  
8              
9 1     1   1854 use Moo;
  1         2  
  1         12  
10              
11             use overload (
12 1         9 '""' => 'explain',
13             '~~' => 'explain',
14             fallback => 1
15 1     1   368 );
  1         2  
16              
17             our $VERSION = '2.01'; # VERSION
18              
19             has id => (
20             is => 'ro'
21             );
22              
23             has context => (
24             is => 'ro'
25             );
26              
27             has frames => (
28             is => 'ro'
29             );
30              
31             has message => (
32             is => 'ro',
33             default => 'Exception!'
34             );
35              
36             # BUILD
37              
38 9     9 0 141 fun BUILD($self, $args) {
  9         15  
39              
40             # build stack trace
41 9 100       44 return $self->trace(2) if !$self->frames;
42             }
43              
44 9     9 0 83587 fun BUILDARGS($class, @args) {
  9         18  
45              
46             # constructor arguments
47             return {
48             @args == 1
49             # ...
50             ? !ref($args[0])
51             # single non-ref argument
52             ? (message => $args[0])
53             # ...
54             : 'HASH' eq ref($args[0])
55             # single hash-based argument
56 9 50       157 ? %{$args[0]}
  1 100       20  
    100          
57             # non hash-based argument
58             : ()
59             # multiple arguments
60             : @args
61             };
62             }
63              
64             # FUNCTIONS
65              
66 1     1 1 6 fun throw($self, $message, $context, $offset) {
  1         2  
67 1   33     6 my $class = ref $self || $self;
68              
69 1         2 my $id;
70             my $frames;
71              
72 1         3 my $args = {};
73              
74 1 50       3 if (ref $self) {
75 1         5 for my $name (keys %$self) {
76 2         4 $args->{$name} = $self->{$name};
77             }
78             }
79              
80 1 50       4 $args->{message} = $message if $message;
81 1 50       3 $args->{context} = $context if $context;
82              
83 1         38 my $exception = $self->new($args);
84              
85 1         4 die $exception->trace($offset);
86             }
87              
88             # METHODS
89              
90 9     9 1 1114 method explain() {
  9         15  
91 9 50       37 $self->trace(1, 1) if !$self->{frames};
92              
93 9         36 my $frames = $self->{frames};
94              
95 9         21 my $file = $frames->[0][1];
96 9         14 my $line = $frames->[0][2];
97 9         14 my $pack = $frames->[0][0];
98 9         14 my $subr = $frames->[0][3];
99              
100 9   50     24 my $message = $self->{message} || 'Exception!';
101              
102 9         29 my @stacktrace = ("$message in $file at line $line");
103              
104 9         22 for (my $i = 1; $i < @$frames; $i++) {
105 103         153 my $pack = $frames->[$i][0];
106 103         145 my $file = $frames->[$i][1];
107 103         136 my $line = $frames->[$i][2];
108 103         144 my $subr = $frames->[$i][3];
109              
110 103         312 push @stacktrace, "\t$subr in $file at line $line";
111             }
112              
113 9         87 return join "\n", @stacktrace, "";
114             }
115              
116 12     12 1 32 method trace($offset, $limit) {
  12         21  
  12         16  
117 12         58 $self->{frames} = my $frames = [];
118              
119 12   100     137 for (my $i = $offset // 1; my @caller = caller($i); $i++) {
120 154         430 push @$frames, [@caller];
121              
122 154 100 66     950 last if defined $limit && $i + 1 == $offset + $limit;
123             }
124              
125 12         200 return $self;
126             }
127              
128             1;
129              
130             =encoding utf8
131              
132             =head1 NAME
133              
134             Data::Object::Exception
135              
136             =cut
137              
138             =head1 ABSTRACT
139              
140             Exception Class for Perl 5
141              
142             =cut
143              
144             =head1 SYNOPSIS
145              
146             use Data::Object::Exception;
147              
148             my $exception = Data::Object::Exception->new;
149              
150             # $exception->throw
151              
152             =cut
153              
154             =head1 DESCRIPTION
155              
156             This package provides functionality for creating, throwing, and introspecting
157             exception objects.
158              
159             =cut
160              
161             =head1 SCENARIOS
162              
163             This package supports the following scenarios:
164              
165             =cut
166              
167             =head2 args-1
168              
169             use Data::Object::Exception;
170              
171             my $exception = Data::Object::Exception->new('Oops!');
172              
173             # $exception->throw
174              
175             The package allows objects to be instantiated with a single argument.
176              
177             =cut
178              
179             =head2 args-kv
180              
181             use Data::Object::Exception;
182              
183             my $exception = Data::Object::Exception->new(message => 'Oops!');
184              
185             # $exception->throw
186              
187             The package allows objects to be instantiated with key-value arguments.
188              
189             =cut
190              
191             =head1 METHODS
192              
193             This package implements the following methods:
194              
195             =cut
196              
197             =head2 explain
198              
199             explain() : Str
200              
201             The explain method returns an error message with stack trace.
202              
203             =over 4
204              
205             =item explain example #1
206              
207             use Data::Object::Exception;
208              
209             my $exception = Data::Object::Exception->new('Oops!');
210              
211             $exception->explain
212              
213             =back
214              
215             =cut
216              
217             =head2 throw
218              
219             throw(Str $class, Any $context, Maybe[Number] $offset) : Any
220              
221             The throw method throws an error with message.
222              
223             =over 4
224              
225             =item throw example #1
226              
227             use Data::Object::Exception;
228              
229             my $exception = Data::Object::Exception->new('Oops!');
230              
231             $exception->throw
232              
233             =back
234              
235             =cut
236              
237             =head2 trace
238              
239             trace(Int $offset, $Int $limit) : Object
240              
241             The trace method compiles a stack trace and returns the object. By default it
242             skips the first frame.
243              
244             =over 4
245              
246             =item trace example #1
247              
248             use Data::Object::Exception;
249              
250             my $exception = Data::Object::Exception->new('Oops!');
251              
252             $exception->trace(0)
253              
254             =back
255              
256             =over 4
257              
258             =item trace example #2
259              
260             use Data::Object::Exception;
261              
262             my $exception = Data::Object::Exception->new('Oops!');
263              
264             $exception->trace(1)
265              
266             =back
267              
268             =over 4
269              
270             =item trace example #3
271              
272             use Data::Object::Exception;
273              
274             my $exception = Data::Object::Exception->new('Oops!');
275              
276             $exception->trace(0,1)
277              
278             =back
279              
280             =cut
281              
282             =head1 AUTHOR
283              
284             Al Newkirk, C
285              
286             =head1 LICENSE
287              
288             Copyright (C) 2011-2019, Al Newkirk, et al.
289              
290             This is free software; you can redistribute it and/or modify it under the terms
291             of the The Apache License, Version 2.0, as elucidated in the L<"license
292             file"|https://github.com/iamalnewkirk/data-object-exception/blob/master/LICENSE>.
293              
294             =head1 PROJECT
295              
296             L
297              
298             L
299              
300             L
301              
302             L
303              
304             L
305              
306             L
307              
308             =cut