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