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