File Coverage

blib/lib/SQL/Translator/Role/Error.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package SQL::Translator::Role::Error;
2              
3             =head1 NAME
4              
5             SQL::Translator::Role::Error - Error setter/getter for objects and classes
6              
7             =head1 SYNOPSIS
8              
9             In the class consuming the role:
10              
11             package Foo;
12             use Moo;
13             with qw(SQL::Translator::Role::Error);
14              
15             sub foo {
16             ...
17             return $self->error("Something failed")
18             unless $some_condition;
19             ...
20             }
21              
22             In code using the class:
23              
24             Foo->foo or die Foo->error;
25             # or
26             $foo->foo or die $foo->error;
27              
28             =head1 DESCRIPTION
29              
30             This L provides a method for getting and setting error on a
31             class or object.
32              
33             =cut
34              
35 72     72   656026 use Moo::Role;
  72         219  
  72         454  
36 72     72   26611 use Sub::Quote qw(quote_sub);
  72         231  
  72         8829  
37              
38             has _ERROR => (
39             is => 'rw',
40             accessor => 'error',
41             init_arg => undef,
42             default => quote_sub(q{ '' }),
43             );
44              
45             =head1 METHODS
46              
47             =head2 $object_or_class->error([$message])
48              
49             If called with an argument, sets the error message and returns undef,
50             otherwise returns the message.
51              
52             As an implementation detail, for compatibility with L, the
53             message is stored in C<< $object->{_ERROR} >> or C<< $Class::ERROR >>,
54             depending on whether the invocant is an object.
55              
56             =cut
57              
58             around error => sub {
59             my ($orig, $self) = (shift, shift);
60              
61             # Emulate horrible Class::Base API
62             unless (ref($self)) {
63 72     72   565 my $errref = do { no strict 'refs'; \${"${self}::ERROR"} };
  72         243  
  72         9350  
64             return $$errref unless @_;
65             $$errref = $_[0];
66             return undef;
67             }
68              
69             return $self->$orig unless @_;
70             $self->$orig(@_);
71             return undef;
72             };
73              
74             =head1 SEE ALSO
75              
76             =over
77              
78             =item *
79              
80             L
81              
82             =back
83              
84             =cut
85              
86             1;