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

package SQL::Translator::Role::Error;

=head1 NAME

SQL::Translator::Role::Error - Error setter/getter for objects and classes

=head1 SYNOPSIS

In the class consuming the role:

    package Foo;
    use Moo;
    with qw(SQL::Translator::Role::Error);

    sub foo {
        ...
        return $self->error("Something failed")
            unless $some_condition;
        ...
    }

In code using the class:

    Foo->foo or die Foo->error;
    # or
    $foo->foo or die $foo->error;

=head1 DESCRIPTION

This L provides a method for getting and setting error on a
class or object.

=cut

use Moo::Role;
use Sub::Quote qw(quote_sub);

has _ERROR => (
    is => 'rw',
    accessor => 'error',
    init_arg => undef,
    default => quote_sub(q{ '' }),
);

=head1 METHODS

=head2 $object_or_class->error([$message])

If called with an argument, sets the error message and returns undef,
otherwise returns the message.

As an implementation detail, for compatibility with L, the
message is stored in C<< $object->{_ERROR} >> or C<< $Class::ERROR >>,
depending on whether the invocant is an object.

=cut

around error => sub {
    my ($orig, $self) = (shift, shift);

    # Emulate horrible Class::Base API
    unless (ref($self)) {
        my $errref = do { no strict 'refs'; \${"${self}::ERROR"} };
        return $$errref unless @_;
        $$errref = $_[0];
        return undef;
    }

    return $self->$orig unless @_;
    $self->$orig(@_);
    return undef;
};

=head1 SEE ALSO

=over

=item *

L

=back

=cut

1;