1 package SL::Controller::Helper::ParseFilter;
5 use Exporter qw(import);
6 our @EXPORT = qw(parse_filter);
9 use SL::Helper::DateTime;
10 use List::MoreUtils qw(uniq);
11 use SL::MoreCommon qw(listify);
16 date => sub { DateTime->from_lxoffice($_[0]) },
17 number => sub { $::form->parse_amount(\%::myconfig, $_[0]) },
18 percent => sub { $::form->parse_amount(\%::myconfig, $_[0]) / 100 },
19 head => sub { $_[0] . '%' },
20 tail => sub { '%' . $_[0] },
21 substr => sub { '%' . $_[0] . '%' },
25 enable => sub { ;;;; },
26 eq_ignore_empty => sub { ($_[0] // '') eq '' ? () : +{ eq => $_[0] } },
28 # since $_ is an alias it can't be used in a closure. even "".$_ or "$_"
29 # does not work, we need a real copy.
31 $_ => sub { +{ $_copy => $_[0] } },
32 } qw(similar match imatch regex regexp like ilike rlike is is_not ne eq lt gt le ge),
36 my ($filter, %params) = @_;
38 my $objects = $params{with_objects} || [];
40 my ($flattened, $auto_objects) = flatten($filter, '', %params);
42 if (!$params{class}) {
43 _add_uniq($objects, $_) for @$auto_objects;
46 _launder_keys($filter, $params{launder_to}) unless $params{no_launder};
48 my $query = _parse_filter($flattened, $objects, %params);
51 ($query && @$query ? (query => $query) : ()),
52 ($objects && @$objects ? ( with_objects => [ uniq @$objects ]) : ());
56 my ($filter, $launder_to) = @_;
57 $launder_to ||= $filter;
58 return unless ref $filter eq 'HASH';
59 for my $key (keys %$filter) {
62 if ('' eq ref $filter->{$orig}) {
63 $launder_to->{$key} = $filter->{$orig};
64 } elsif ('ARRAY' eq ref $filter->{$orig}) {
65 $launder_to->{"${key}_"} = { map { $_ => 1 } @{ $filter->{$orig} } };
67 $launder_to->{$key} ||= { };
68 _launder_keys($filter->{$key}, $launder_to->{$key});
74 my ($filter, $prefix, %params) = @_;
76 return (undef, []) unless 'HASH' eq ref $filter;
77 my $with_objects = [];
81 while (my ($key, $value) = each %$filter) {
82 next if !defined $value || $value eq ''; # 0 is fine
83 if ('HASH' eq ref $value) {
84 my ($query, $more_objects) = flatten($value, _prefix($prefix, $key));
85 push @result, @$query if $query;
86 _add_uniq($with_objects, $_) for _prefix($prefix, $key), @$more_objects;
88 push @result, _prefix($prefix, $key) => $value;
92 return \@result, $with_objects;
96 my ($flattened, $with_objects, %params) = @_;
98 return () unless 'ARRAY' eq ref $flattened;
100 $flattened = _collapse_indirect_filters($flattened);
103 for (my $i = 0; $i < scalar @$flattened; $i += 2) {
104 my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]);
105 my ($type, $op) = $key =~ m{:(.+)::(.+)};
107 if ($key =~ s/:multi//) {
110 for my $value (parse_line('\s+', 0, $value)) {
111 ($key, $value) = _apply_all($key, $value, qr/\b:(\w+)/, { %filters, %{ $params{filters} || {} } });
112 ($key, $value) = _apply_all($key, $value, qr/\b::(\w+)/, { %methods, %{ $params{methods} || {} } });
113 ($key, $value) = _dispatch_custom_filters($params{class}, $with_objects, $key, $value) if $params{class};
114 ($key, $value) = _apply_value_filters($key, $value, $type, $op);
115 push @multi, $key, $value;
118 ($key, $value) = (and => \@multi);
120 ($key, $value) = _apply_all($key, $value, qr/\b:(\w+)/, { %filters, %{ $params{filters} || {} } });
121 ($key, $value) = _apply_all($key, $value, qr/\b::(\w+)/, { %methods, %{ $params{methods} || {} } });
122 ($key, $value) = _dispatch_custom_filters($params{class}, $with_objects, $key, $value) if $params{class};
123 ($key, $value) = _apply_value_filters($key, $value, $type, $op);
126 push @result, $key, $value if defined $key;
131 sub _apply_value_filters {
132 my ($key, $value, $type, $op) = @_;
134 return ($key, $value) unless $key && $value && $type && $op && (ref($value) eq 'HASH');
136 if (($type eq 'date') && ($op eq 'le')) {
137 my $date = delete $value->{le};
138 $value->{lt} = $date->add(days => 1);
141 return ($key, $value);
144 sub _dispatch_custom_filters {
145 my ($class, $with_objects, $key, $value) = @_;
147 # the key should by now have no filters left
148 # if it has, catch it here:
149 die 'unrecognized filters' if $key =~ /:/;
151 my @tokens = split /\./, $key;
152 my $curr_class = $class->object_class;
154 # our key will consist of dot-delimited tokens
155 # like this: order.part.unit.name
156 # each of these tokens except the last one is one of:
157 # - a relationship in the parent object
160 # the last token must be
162 # - a column in the parent object
164 # find first token which is not a relationship,
165 # so we can pass the rest on
167 while ($i < $#tokens) {
169 $curr_class = $curr_class->meta->relationship($tokens[$i])->class;
176 my $manager = $curr_class->meta->convention_manager->auto_manager_class_name;
177 my $obj_path = join '.', @tokens[0..$i-1];
178 my $obj_prefix = join '.', @tokens[0..$i-1], '';
179 my $key_token = $tokens[$i];
180 my @additional_tokens = @tokens[$i+1..$#tokens];
182 if ($manager->can('filter')) {
183 ($key, $value, my $obj) = $manager->filter($key_token, $value, $obj_prefix, $obj_path, @additional_tokens);
184 _add_uniq($with_objects, $obj) if $obj;
186 _add_uniq($with_objects, $obj_path) if $obj_path;
189 return ($key, $value);
193 my ($array, $what) = @_;
196 @$array = (uniq @$array, listify($what));
199 sub _collapse_indirect_filters {
200 my ($flattened) = @_;
202 die 'flattened filter array length is uneven, should be possible to use as hash' if @$flattened % 2;
204 my (%keys_to_delete, %keys_to_move, @collapsed);
206 # search keys matching /::$/;
207 for (my $i = 0; $i < scalar @$flattened; $i += 2) {
208 my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]);
210 next unless $key =~ /^(.*\b)::$/;
212 $keys_to_delete{$key}++;
213 $keys_to_move{$1} = $1 . '::' . $value;
216 for (my $i = 0; $i < scalar @$flattened; $i += 2) {
217 my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]);
219 if ($keys_to_move{$key}) {
220 push @collapsed, $keys_to_move{$key}, $value;
223 if (!$keys_to_delete{$key}) {
224 push @collapsed, $key, $value;
232 join '.', grep $_, @_;
236 my ($value, $name, $filters) = @_;
237 return $value unless $name && $filters->{$name};
238 return [ map { _apply($_, $name, $filters) } @$value ] if 'ARRAY' eq ref $value;
239 return $filters->{$name}->($value);
243 my ($key, $value, $re, $subs) = @_;
245 while ($key =~ s/$re//) {
246 $value = _apply($value, $1, $subs);
258 SL::Controller::Helper::ParseFilter - Convert a form filter spec into a RDBO get_all filter
262 use SL::Controller::Helper::ParseFilter;
263 SL::DB::Object->get_all(parse_filter($::form->{filter}));
266 SL::DB::Object->get_all(parse_filter($::form->{filter},
267 with_objects => [ qw(part customer) ]));
271 A search filter will usually search for things in relations of the actual
272 search target. A search for sales orders may be filtered by the name of the
273 customer. L<Rose::DB::Object> allows you to search for these by filtering them prefixed with their table:
276 'customer.name' => 'John Doe',
277 'department.description' => [ ilike => '%Sales%' ],
278 'orddate' => [ lt => DateTime->today ],
281 Unfortunately, if you specify them in your form as these strings, the form
282 parser will convert them into nested structures like this:
292 And the substring match requires you to recognize the ilike, and modify the value.
294 C<parse_filter> tries to ease this by recognizing these structures and
295 providing suffixes for common search patterns.
301 =item C<parse_filter \%FILTER, [ %PARAMS ]>
303 First argument is the filter from form. It is highly recommended that you put
304 all filter attributes into a named container as to not confuse them with the
307 Nested structures will be parsed and interpreted as foreign references. For
308 example if you search for L<Order>s, this input will search for those with a
309 specific L<Salesman>:
311 [% L.select_tag('filter.salesman.id', ...) %]
313 Additionally you can add a modifier to the name to set a certain method:
315 [% L.input_tag('filter.department.description:substr::ilike', ...) %]
317 This will add the "% .. %" wildcards for substr matching in SQL, and add an
318 C<< ilike => $value >> block around it to match case insensitively.
320 As a rule all value filters require a single colon and must be placed before
321 match method suffixes, which are appended with 2 colons. See below for a full
328 Unfortunately Template cannot parse the postfixes if you want to
329 rerender the filter. For this reason all colon filter keys are by
330 default laundered into underscores, so you can use them like this:
332 [% L.input_tag('filter.price:number::lt', filter.price_number__lt) %]
334 Also Template has trouble when looking up the contents of arrays, so
335 these will get copied into a _ suffixed version as hashes:
337 [% L.checkbox_tag('filter.ids[]', value=15, checked=filter.ids_.15) %]
339 All of your original entries will stay intact. If you don't want this to
340 happen pass C<< no_launder => 1 >> as a parameter. Additionally you can pass a
341 different target for the laundered values with the C<launder_to> parameter. It
342 takes a hashref and will deep copy all values in your filter to the target. So
343 if you have a filter that looks like this:
346 'price:number::lt' => '2,30',
348 type => [ 'part', 'assembly' ],
353 parse_filter($filter, launder_to => $laundered_filter = { })
355 the original filter will be unchanged, and C<$laundered_filter> will end up
359 'price_number__lt' => '2,30',
361 'type_' => { part => 1, assembly => 1 },
364 =head1 INDIRECT FILTER METHODS
366 The reason for the method being last is that it is possible to specify the
367 method in another input. Suppose you want a date input and a separate
368 before/after/equal select, you can use the following:
370 [% L.date_tag('filter.appointed_date:date', ... ) %]
374 [% L.select_tag('filter.appointed_date:date::', ... ) %]
376 The special empty method will be used to set the method for the previous
379 =head1 CUSTOM FILTERS FROM OBJECTS
381 If the L<parse_filter> call contains a parameter C<class>, custom filters will
382 be honored. Suppose you have added a custom filter 'all' for parts which
383 expands to search both description and partnumber, the following
386 'part.all:substr::ilike' => 'A1',
393 part.description => { ilike => '%A1%' },
394 part.partnumber => { ilike => '%A1%' },
398 For more about custom filters, see L<SL::DB::Helper::Filtered>.
400 =head1 FILTERS (leading with :)
402 The following filters are built in, and can be used.
408 Parses the input string with C<< DateTime->from_lxoffice >>
412 Pasres the input string with C<< Form->parse_amount >>
416 Parses the input string with C<< Form->parse_amount / 100 >>
420 Adds "%" at the end of the string.
424 Adds "%" at the end of the string.
428 Adds "% .. %" around the search string.
430 =item eq_ignore_empty
432 Ignores this item if it's empty. Otherwise compares it with the
433 standard SQL C<=> operator.
437 =head2 METHODS (leading with ::)
449 All these are recognized like the L<Rose::DB::Object> methods.
453 =head1 BUGS AND CAVEATS
455 This will not properly handle multiple versions of the same object in different
458 Suppose you want all L<SL::DB::Order>s which have either themselves a certain
459 customer, or are linked to a L<SL::DB::Invoice> with this customer, the
460 following will not work as you expect:
463 L.input_tag('customer.name:substr::ilike', ...)
464 L.input_tag('invoice.customer.name:substr::ilike', ...)
466 This will search for orders whose invoice has the _same_ customer, which matches
467 both inputs. This is because tables are aliased by their name and not by their
468 position in with_objects.
476 Additional filters should be pluggable.
482 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>