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