release 0.11016
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Role / Error.pm
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<Moo::Role> provides a method for getting and setting error on a
31 class or object.
32
33 =cut
34
35 use Moo::Role;
36 use Sub::Quote qw(quote_sub);
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<Class::Base>, 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         my $errref = do { no strict 'refs'; \${"${self}::ERROR"} };
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<Class::Base/Error Handling>
81
82 =back
83
84 =cut
85
86 1;