1 package SQL::Translator::Role::ListAttr;
8 SQL::Translator::Role::ListAttr - context-sensitive list attributes
14 use SQL::Translator::Role::ListAttr;
16 with ListAttr foo => ( uniq => 1, append => 1 );
20 This package provides a variable L<Moo::Role> for context-sensitive list
25 use SQL::Translator::Utils qw(parse_list_arg ex2err uniq);
26 use Sub::Quote qw(quote_sub);
28 use Package::Variant (
32 subs => [qw(has around)],
37 =head2 ListAttr $name => %parameters;
39 Returns a L<Moo::Role> providing an arrayref attribute named C<$name>,
40 and wrapping the accessor to provide context-sensitivity both for
41 setting and getting. If no C<builder> or C<default> is provided, the
42 default value is the empty list.
44 On setting, the arguments are parsed using
45 L<SQL::Translator::Utils/parse_list_arg>, and the accessor will return
46 an array reference or a list, depending on context.
54 If true, the setter will append arguments to the existing ones, rather
59 If true, duplicate items will be removed, keeping the first one seen.
63 If accessing the attribute might L<throw|SQL::Translator::Utils/throw>
64 an exception (e.g. from a C<builder> or C<isa> check), this should be
65 set to make the accessor store the exception using
66 L<SQL::Translator::Role::Error> and return undef.
70 If true, and the list is empty, the accessor will return C<undef>
71 instead of a reference to an empty in scalar context.
75 Unknown parameters are passed through to the L<has|Moo/has> call for
81 my ($class, $target_package, $name, %arguments) = @_;
83 my $may_throw = delete $arguments{may_throw};
84 my $undef_if_empty = delete $arguments{undef_if_empty};
85 my $append = delete $arguments{append};
86 my $coerce = delete $arguments{uniq}
87 ? sub { [ uniq @{parse_list_arg($_[0])} ] }
92 (!$arguments{builder} ? (
93 default => quote_sub(q{ [] }),
100 my ($orig, $self) = (shift, shift);
101 my $list = parse_list_arg(@_);
102 $self->$orig([ @{$append ? $self->$orig : []}, @$list ])
107 $return = ex2err($orig, $self) or return;
110 $return = $self->$orig;
112 my $scalar_return = !@{$return} && $undef_if_empty ? undef : $return;
113 return wantarray ? @{$return} : $scalar_return;
121 =item L<SQL::Translator::Utils>
123 =item L<SQL::Translator::Role::Error>