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