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;