lib/SQL/Translator/Role/ListAttr.pm

   1 package SQL::Translator::Role::ListAttr;
   2 use strictures 1;
   3 use SQL::Translator::Utils qw(parse_list_arg ex2err);
   4 use List::MoreUtils qw(uniq);
   5
   6 use Package::Variant (
   7     importing => {
   8         'Moo::Role' => [],
   9     },
  10     subs => [qw(has around)],
  11 );
  12
  13
  14 sub make_variant {
  15     my ($class, $target_package, $name, %arguments) = @_;
  16
  17     my $may_throw = delete $arguments{may_throw};
  18     my $undef_if_empty = delete $arguments{undef_if_empty};
  19     my $append = delete $arguments{append};
  20     my $coerce = delete $arguments{uniq}
  21         ? sub { [ uniq @{parse_list_arg($_[0])} ] }
  22         : \&parse_list_arg;
  23
  24     has($name => (
  25         is => 'rw',
  26         (!$arguments{builder} ? (
  27             default => sub { [] },
  28         ) : ()),
  29         coerce => $coerce,
  30         %arguments,
  31     ));
  32
  33     around($name => sub {
  34         my ($orig, $self) = (shift, shift);
  35         my $list = parse_list_arg(@_);
  36         $self->$orig([ @{$append ? $self->$orig : []}, @$list ])
  37             if @$list;
  38
  39         my $return;
  40         if ($may_throw) {
  41             $return = ex2err($orig, $self) or return;
  42         }
  43         else {
  44             $return = $self->$orig;
  45         }
  46         my $scalar_return = !@{$return} && $undef_if_empty ? undef : $return;
  47         return wantarray ? @{$return} : $scalar_return;
  48     });
  49 }
  50
  51 1;