SL/Controller/Helper/ParseFilter.pm

   1 package SL::Controller::Helper::ParseFilter;
   2
   3 use strict;
   4
   5 use Exporter qw(import);
   6 our @EXPORT = qw(parse_filter);
   7
   8 use DateTime;
   9 use SL::Helper::DateTime;
  10 use List::MoreUtils qw(uniq);
  11 use SL::Util qw(trim);
  12 use SL::MoreCommon qw(listify);
  13 use Data::Dumper;
  14 use Text::ParseWords;
  15
  16 sub _lazy_bool_eq {
  17   my ($key, $value) = @_;
  18
  19   return ()                                   if ($value // '') eq '';
  20   return (or => [ $key => undef, $key => 0 ]) if !$value;
  21   return ($key => 1);
  22 }
  23
  24 my %filters = (
  25   date    => sub { DateTime->from_lxoffice($_[0]) },
  26   number  => sub { $::form->parse_amount(\%::myconfig, $_[0]) },
  27   percent => sub { $::form->parse_amount(\%::myconfig, $_[0]) / 100 },
  28   head    => sub { trim($_[0]) . '%' },
  29   tail    => sub { '%' . trim($_[0]) },
  30   substr  => sub { '%' . trim($_[0]) . '%' },
  31   trim    => sub { trim($_[0]) },
  32 );
  33
  34 my %methods = (
  35   enable => sub { ;;;; },
  36   eq_ignore_empty => sub { ($_[0] // '') eq '' ? () : +{ eq => $_[0] } },
  37   map {
  38     # since $_ is an alias it can't be used in a closure. even "".$_ or "$_"
  39     # does not work, we need a real copy.
  40     my $_copy = "$_";
  41     $_   => sub { +{ $_copy    => $_[0] } },
  42   } qw(similar match imatch regex regexp like ilike rlike is is_not ne eq lt gt le ge),
  43 );
  44
  45 my %complex_methods = (
  46   lazy_bool_eq => \&_lazy_bool_eq,
  47 );
  48
  49 sub parse_filter {
  50   my ($filter, %params) = @_;
  51
  52   my $objects      = $params{with_objects} || [];
  53
  54   my ($flattened, $auto_objects) = flatten($filter, '', %params);
  55
  56   if (!$params{class}) {
  57     _add_uniq($objects, $_) for @$auto_objects;
  58   }
  59
  60   _launder_keys($filter, $params{launder_to}) unless $params{no_launder};
  61
  62   my $query = _parse_filter($flattened, $objects, %params);
  63
  64   return
  65     ($query   && @$query   ? (query => $query) : ()),
  66     ($objects && @$objects ? ( with_objects => [ uniq @$objects ]) : ());
  67 }
  68
  69 sub _launder_keys {
  70   my ($filter, $launder_to) = @_;
  71   $launder_to ||= $filter;
  72   return unless ref $filter eq 'HASH';
  73   for my $key (keys %$filter) {
  74     my $orig = $key;
  75     $key =~ s/:/_/g;
  76     if ('' eq ref $filter->{$orig}) {
  77       $launder_to->{$key} = $filter->{$orig};
  78     } elsif ('ARRAY' eq ref $filter->{$orig}) {
  79       $launder_to->{"${key}_"} = { map { $_ => 1 } @{ $filter->{$orig} } };
  80     } else {
  81       $launder_to->{$key} ||= { };
  82       _launder_keys($filter->{$key}, $launder_to->{$key});
  83     }
  84   };
  85 }
  86
  87 sub flatten {
  88   my ($filter, $prefix, %params) = @_;
  89
  90   return (undef, []) unless 'HASH'  eq ref $filter;
  91   my $with_objects = [];
  92
  93   my @result;
  94
  95   while (my ($key, $value) = each %$filter) {
  96     next if !defined $value || $value eq ''; # 0 is fine
  97     if ('HASH' eq ref $value) {
  98       my ($query, $more_objects) = flatten($value, _prefix($prefix, $key));
  99       push @result, @$query        if  $query;
 100       _add_uniq($with_objects, $_) for _prefix($prefix, $key), @$more_objects;
 101     } else {
 102       push @result, _prefix($prefix, $key) => $value;
 103     }
 104   }
 105
 106   return \@result, $with_objects;
 107 }
 108
 109 sub _parse_filter {
 110   my ($flattened, $with_objects, %params) = @_;
 111
 112   return () unless 'ARRAY' eq ref $flattened;
 113
 114   $flattened = _collapse_indirect_filters($flattened);
 115
 116   my $all_filters = { %filters,         %{ $params{filters}         || {} } };
 117   my $all_methods = { %methods,         %{ $params{methods}         || {} } };
 118   my $all_complex = { %complex_methods, %{ $params{complex_methods} || {} } };
 119
 120   my @result;
 121   for (my $i = 0; $i < scalar @$flattened; $i += 2) {
 122     my (@args, @filters, $method);
 123
 124     my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]);
 125     my ($type, $op)   = $key =~ m{:(.+)::(.+)};
 126
 127     my $is_multi      = $key =~ s/:multi//;
 128     my $is_any        = $key =~ s/:any//;
 129     my @value_tokens  = $is_multi || $is_any ? parse_line('\s+', 0, $value) : ($value);
 130
 131     ($key, $method)   = split m{::}, $key, 2;
 132     ($key, @filters)  = split m{:},  $key;
 133
 134     my $orig_key      = $key;
 135
 136     for my $value_token (@value_tokens) {
 137       $key                 = $orig_key;
 138
 139       $value_token         = _apply($value_token, $_, $all_filters) for @filters;
 140       $value_token         = _apply($value_token, $method, $all_methods)                                 if $method && exists $all_methods->{$method};
 141       ($key, $value_token) = _apply_complex($key, $value_token, $method, $all_complex)                   if $method && exists $all_complex->{$method};
 142       ($key, $value_token) = _dispatch_custom_filters($params{class}, $with_objects, $key, $value_token) if $params{class};
 143       ($key, $value_token) = _apply_value_filters($key, $value_token, $type, $op);
 144
 145       push @args, $key, $value_token;
 146     }
 147
 148     next unless defined $key;
 149
 150     push @result, $is_multi ? (and => [ @args ]) : $is_any ? (or => [ @args ]) : @args;
 151   }
 152   return \@result;
 153 }
 154
 155 sub _apply_value_filters {
 156   my ($key, $value, $type, $op) = @_;
 157
 158   return ($key, $value) unless $key && $value && $type && $op && (ref($value) eq 'HASH');
 159
 160   if (($type eq 'date') && ($op eq 'le')) {
 161     my $date     = delete $value->{le};
 162     $value->{lt} = $date->add(days => 1);
 163   }
 164
 165   return ($key, $value);
 166 }
 167
 168 sub _dispatch_custom_filters {
 169   my ($class, $with_objects, $key, $value) = @_;
 170
 171   # the key should by now have no filters left
 172   # if it has, catch it here:
 173   die 'unrecognized filters' if $key =~ /:/;
 174
 175   my @tokens     = split /\./, $key;
 176   my $curr_class = $class->object_class;
 177
 178   # our key will consist of dot-delimited tokens
 179   # like this: order.part.unit.name
 180   # each of these tokens except the last one is one of:
 181   #  - a relationship in the parent object
 182   #  - a custom filter
 183   #
 184   # the last token must be
 185   #  - a custom filter
 186   #  - a column in the parent object
 187   #
 188   # find first token which is not a relationship,
 189   # so we can pass the rest on
 190   my $i = 0;
 191    while ($i < $#tokens) {
 192     eval {
 193       $curr_class = $curr_class->meta->relationship($tokens[$i])->class;
 194       ++$i;
 195     } or do {
 196       last;
 197     }
 198   }
 199
 200   my $manager    = $curr_class->meta->convention_manager->auto_manager_class_name;
 201   my $obj_path   = join '.', @tokens[0..$i-1];
 202   my $obj_prefix = join '.', @tokens[0..$i-1], '';
 203   my $key_token  = $tokens[$i];
 204   my @additional_tokens = @tokens[$i+1..$#tokens];
 205
 206   if ($manager->can('filter')) {
 207     ($key, $value, my $obj) = $manager->filter($key_token, $value, $obj_prefix, $obj_path, @additional_tokens);
 208     _add_uniq($with_objects, $obj) if $obj;
 209   } else {
 210     _add_uniq($with_objects, $obj_path) if $obj_path;
 211   }
 212
 213   return ($key, $value);
 214 }
 215
 216 sub _add_uniq {
 217    my ($array, $what) = @_;
 218
 219    $array //= [];
 220    @$array = (uniq @$array, listify($what));
 221 }
 222
 223 sub _collapse_indirect_filters {
 224   my ($flattened) = @_;
 225
 226   die 'flattened filter array length is uneven, should be possible to use as hash' if @$flattened % 2;
 227
 228   my (%keys_to_delete, %keys_to_move, @collapsed);
 229
 230   # search keys matching /::$/;
 231   for (my $i = 0; $i < scalar @$flattened; $i += 2) {
 232     my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]);
 233
 234     next unless $key =~ /^(.*\b)::$/;
 235
 236     $keys_to_delete{$key}++;
 237     $keys_to_move{$1} = $1 . '::' . $value;
 238   }
 239
 240   for (my $i = 0; $i < scalar @$flattened; $i += 2) {
 241     my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]);
 242
 243     if ($keys_to_move{$key}) {
 244       push @collapsed, $keys_to_move{$key}, $value;
 245       next;
 246     }
 247     if (!$keys_to_delete{$key}) {
 248       push @collapsed, $key, $value;
 249     }
 250   }
 251
 252   return \@collapsed;
 253 }
 254
 255 sub _prefix {
 256   join '.', grep $_, @_;
 257 }
 258
 259 sub _apply {
 260   my ($value, $name, $filters) = @_;
 261   return $value unless $name && $filters->{$name};
 262   return [ map { _apply($_, $name, $filters) } @$value ] if 'ARRAY' eq ref $value;
 263   return $filters->{$name}->($value);
 264 }
 265
 266 sub _apply_complex {
 267   my ($key, $value, $name, $filters) = @_;
 268   return $key, $value unless $name && $filters->{$name};
 269   return $filters->{$name}->($key, $value);
 270 }
 271
 272 1;
 273
 274 __END__
 275
 276 =pod
 277
 278 =encoding utf8
 279
 280 =head1 NAME
 281
 282 SL::Controller::Helper::ParseFilter - Convert a form filter spec into a RDBO get_all filter
 283
 284 =head1 SYNOPSIS
 285
 286   use SL::Controller::Helper::ParseFilter;
 287   SL::DB::Manager::Object->get_all(parse_filter($::form->{filter}));
 288
 289   # or more complex
 290   SL::DB::Manager::Object->get_all(parse_filter($::form->{filter},
 291     with_objects => [ qw(part customer) ]));
 292
 293 =head1 DESCRIPTION
 294
 295 A search filter will usually search for things in relations of the actual
 296 search target. A search for sales orders may be filtered by the name of the
 297 customer. L<Rose::DB::Object> allows you to search for these by filtering them prefixed with their table:
 298
 299   query => [
 300     'customer.name'          => 'John Doe',
 301     'department.description' => { ilike => '%Sales%' },
 302     'orddate'                => { lt    => DateTime->today },
 303   ]
 304
 305 Unfortunately, if you specify them in your form as these strings, the form
 306 parser will convert them into nested structures like this:
 307
 308   $::form = bless {
 309     filter => {
 310       customer => {
 311         name => 'John Doe',
 312       },
 313     },
 314   }, Form;
 315
 316 And the substring match requires you to recognize the ilike, and modify the value.
 317
 318 C<parse_filter> tries to ease this by recognizing these structures and
 319 providing suffixes for common search patterns.
 320
 321 =head1 FUNCTIONS
 322
 323 =over 4
 324
 325 =item C<parse_filter \%FILTER, [ %PARAMS ]>
 326
 327 First argument is the filter from form. It is highly recommended that you put
 328 all filter attributes into a named container as to not confuse them with the
 329 rest of your form.
 330
 331 Nested structures will be parsed and interpreted as foreign references. For
 332 example if you search for L<Order>s, this input will search for those with a
 333 specific L<Salesman>:
 334
 335   [% L.select_tag('filter.salesman.id', ...) %]
 336
 337 Additionally you can add a modifier to the name to set a certain method:
 338
 339   [% L.input_tag('filter.department.description:substr::ilike', ...) %]
 340
 341 This will add the "% .. %" wildcards for substr matching in SQL, and add an
 342 C<< ilike => $value >> block around it to match case insensitively.
 343
 344 As a rule all value filters require a single colon and must be placed before
 345 match method suffixes, which are appended with 2 colons. See below for a full
 346 list of modifiers.
 347
 348 =back
 349
 350 =head1 LAUNDERING
 351
 352 Unfortunately Template cannot parse the postfixes if you want to
 353 rerender the filter. For this reason all colon filter keys are by
 354 default laundered into underscores, so you can use them like this:
 355
 356   [% L.input_tag('filter.price:number::lt', filter.price_number__lt) %]
 357
 358 Also Template has trouble when looking up the contents of arrays, so
 359 these will get copied into a _ suffixed version as hashes:
 360
 361   [% L.checkbox_tag('filter.ids[]', value=15, checked=filter.ids_.15) %]
 362
 363 All of your original entries will stay intact. If you don't want this to
 364 happen pass C<< no_launder => 1 >> as a parameter.  Additionally you can pass a
 365 different target for the laundered values with the C<launder_to>  parameter. It
 366 takes a hashref and will deep copy all values in your filter to the target. So
 367 if you have a filter that looks like this:
 368
 369   $filter = {
 370     'price:number::lt' => '2,30',
 371     closed             => '1',
 372     type               => [ 'part', 'assembly' ],
 373   }
 374
 375 and parse it with
 376
 377   parse_filter($filter, launder_to => $laundered_filter = { })
 378
 379 the original filter will be unchanged, and C<$laundered_filter> will end up
 380 like this:
 381
 382   $filter = {
 383     'price_number__lt' => '2,30',
 384      closed            => '1',
 385     'type_'            => { part => 1, assembly => 1 },
 386   }
 387
 388 =head1 INDIRECT FILTER METHODS
 389
 390 The reason for the method being last is that it is possible to specify the
 391 method in another input. Suppose you want a date input and a separate
 392 before/after/equal select, you can use the following:
 393
 394   [% L.date_tag('filter.appointed_date:date', ... ) %]
 395
 396 and later
 397
 398   [% L.select_tag('filter.appointed_date:date::', ... ) %]
 399
 400 The special empty method will be used to set the method for the previous
 401 method-less input.
 402
 403 =head1 CUSTOM FILTERS FROM OBJECTS
 404
 405 If the L<parse_filter> call contains a parameter C<class>, custom filters will
 406 be honored. Suppose you have added a custom filter 'all' for parts which
 407 expands to search both description and partnumber, the following
 408
 409   $filter = {
 410     'part.all:substr::ilike' => 'A1',
 411   }
 412
 413 will expand to:
 414
 415   query => [
 416     or => [
 417       part.description => { ilike => '%A1%' },
 418       part.partnumber  => { ilike => '%A1%' },
 419     ]
 420   ]
 421
 422 For more about custom filters, see L<SL::DB::Helper::Filtered>.
 423
 424 =head1 FILTERS (leading with :)
 425
 426 The following filters are built in, and can be used.
 427
 428 =over 4
 429
 430 =item date
 431
 432 Parses the input string with C<< DateTime->from_lxoffice >>
 433
 434 =item number
 435
 436 Pasres the input string with C<< Form->parse_amount >>
 437
 438 =item percent
 439
 440 Parses the input string with C<< Form->parse_amount / 100 >>
 441
 442 =item trim
 443
 444 Removes whitespace characters (to be precice, characters with the \p{WSpace}
 445 property from beginning and end of the value.
 446
 447 =item head
 448
 449 Adds "%" at the end of the string and applies C<trim>.
 450
 451 =item tail
 452
 453 Adds "%" at the end of the string and applies C<trim>.
 454
 455 =item substr
 456
 457 Adds "% .. %" around the search string and applies C<trim>.
 458
 459 =back
 460
 461 =head2 METHODS (leading with ::)
 462
 463 =over 4
 464
 465 =item lt
 466
 467 =item gt
 468
 469 =item ilike
 470
 471 =item like
 472
 473 All these are recognized like the L<Rose::DB::Object> methods.
 474
 475 =item lazy_bool_eq
 476
 477 If the value is undefined or an empty string then this parameter will
 478 be completely removed from the query. Otherwise a falsish filter value
 479 will match for C<NULL> and C<FALSE>; trueish values will only match
 480 C<TRUE>.
 481
 482 =item eq_ignore_empty
 483
 484 Ignores this item if it's empty. Otherwise compares it with the
 485 standard SQL C<=> operator.
 486
 487 =back
 488
 489 =head1 BUGS AND CAVEATS
 490
 491 This will not properly handle multiple versions of the same object in different
 492 context.
 493
 494 Suppose you want all L<SL::DB::Order>s which have either themselves a certain
 495 customer, or are linked to a L<SL::DB::Invoice> with this customer, the
 496 following will not work as you expect:
 497
 498   # does not work!
 499   L.input_tag('customer.name:substr::ilike', ...)
 500   L.input_tag('invoice.customer.name:substr::ilike', ...)
 501
 502 This will search for orders whose invoice has the _same_ customer, which matches
 503 both inputs. This is because tables are aliased by their name and not by their
 504 position in with_objects.
 505
 506 =head1 TODO
 507
 508 =over 4
 509
 510 =item *
 511
 512 Additional filters should be pluggable.
 513
 514 =back
 515
 516 =head1 AUTHOR
 517
 518 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 519
 520 =cut