1 package SQL::Translator::Role::ListAttr;
5 SQL::Translator::Role::ListAttr - context-sensitive list attributes
11 use SQL::Translator::Role::ListAttr;
13 with ListAttr foo => ( uniq => 1, append => 1 );
17 This package provides a variable L<Moo::Role> for context-sensitive list
23 use SQL::Translator::Utils qw(parse_list_arg ex2err);
24 use List::MoreUtils qw(uniq);
25 use Sub::Quote qw(quote_sub);
27 use Package::Variant (
31 subs => [qw(has around)],
36 =head2 ListAttr $name => %parameters;
38 Returns a L<Moo::Role> providing an arrayref attribute named C<$name>,
39 and wrapping the accessor to provide context-sensitivity both for
40 setting and getting. If no C<builder> or C<default> is provided, the
41 default value is the empty list.
43 On setting, the arguments are parsed using
44 L<SQL::Translator::Utils/parse_list_arg>, and the accessor will return
45 an array reference or a list, depending on context.
53 If true, the setter will append arguments to the existing ones, rather
58 If true, duplicate items will be removed, keeping the first one seen.
62 If accessing the attribute might L<throw|SQL::Translator::Utils/throw>
63 an exception (e.g. from a C<builder> or C<isa> check), this should be
64 set to make the accessor store the exception using
65 L<SQL::Translator::Role::Error> and return undef.
69 If true, and the list is empty, the accessor will return C<undef>
70 instead of a reference to an empty in scalar context.
74 Unknown parameters are passed through to the has call L<has|Moo/has> for
80 my ($class, $target_package, $name, %arguments) = @_;
82 my $may_throw = delete $arguments{may_throw};
83 my $undef_if_empty = delete $arguments{undef_if_empty};
84 my $append = delete $arguments{append};
85 my $coerce = delete $arguments{uniq}
86 ? sub { [ uniq @{parse_list_arg($_[0])} ] }
91 (!$arguments{builder} ? (
92 default => quote_sub(q{ [] }),
99 my ($orig, $self) = (shift, shift);
100 my $list = parse_list_arg(@_);
101 $self->$orig([ @{$append ? $self->$orig : []}, @$list ])
106 $return = ex2err($orig, $self) or return;
109 $return = $self->$orig;
111 my $scalar_return = !@{$return} && $undef_if_empty ? undef : $return;
112 return wantarray ? @{$return} : $scalar_return;
120 =item L<SQL::Translator::Utils>
122 =item L<SQL::Translator::Role::Error>