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