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     ($key, $value) = _apply_all($key, $value, qr/\b:(\w+)/,  { %filters, %{ $params{filters} || {} } });
  99     ($key, $value) = _apply_all($key, $value, qr/\b::(\w+)/, { %methods, %{ $params{methods} || {} } });
 100     push @result, $key, $value;
 101   }
 102   return \@result;
 103 }
 104
 105 sub _collapse_indirect_filters {
 106   my ($flattened) = @_;
 107
 108   die 'flattened filter array length is uneven, should be possible to use as hash' if @$flattened % 2;
 109
 110   my (%keys_to_delete, %keys_to_move, @collapsed);
 111
 112   # search keys matching /::$/;
 113   for (my $i = 0; $i < scalar @$flattened; $i += 2) {
 114     my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]);
 115
 116     next unless $key =~ /^(.*\b)::$/;
 117
 118     $keys_to_delete{$key}++;
 119     $keys_to_move{$1} = $1 . '::' . $value;
 120   }
 121
 122   for (my $i = 0; $i < scalar @$flattened; $i += 2) {
 123     my ($key, $value) = ($flattened->[$i], $flattened->[$i+1]);
 124
 125     if ($keys_to_move{$key}) {
 126       push @collapsed, $keys_to_move{$key}, $value;
 127       next;
 128     }
 129     if (!$keys_to_delete{$key}) {
 130       push @collapsed, $key, $value;
 131     }
 132   }
 133
 134   return \@collapsed;
 135 }
 136
 137 sub _prefix {
 138   join '.', grep $_, @_;
 139 }
 140
 141 sub _apply {
 142   my ($value, $name, $filters) = @_;
 143   return $value unless $name && $filters->{$name};
 144   return [ map { _apply($_, $name, $filters) } @$value ] if 'ARRAY' eq ref $value;
 145   return $filters->{$name}->($value);
 146 }
 147
 148 sub _apply_all {
 149   my ($key, $value, $re, $subs) = @_;
 150
 151   while ($key =~ s/$re//) {
 152     $value = _apply($value, $1, $subs);
 153   }
 154
 155   return $key, $value;
 156 }
 157
 158 1;
 159
 160 __END__
 161
 162 =head1 NAME
 163
 164 SL::Controller::Helper::ParseFilter - Convert a form filter spec into a RDBO get_all filter
 165
 166 =head1 SYNOPSIS
 167
 168   use SL::Controller::Helper::ParseFilter;
 169   SL::DB::Object->get_all(parse_filter($::form->{filter}));
 170
 171   # or more complex
 172   SL::DB::Object->get_all(parse_filter($::form->{filter},
 173     with_objects => [ qw(part customer) ]));
 174
 175 =head1 DESCRIPTION
 176
 177 A search filter will usually search for things in relations of the actual
 178 search target. A search for sales orders may be filtered by the name of the
 179 customer. L<Rose::DB::Object> alloes you to search for these by filtering them prefixed with their table:
 180
 181   query => [
 182     'customer.name'          => 'John Doe',
 183     'department.description' => [ ilike => '%Sales%' ],
 184     'orddate'                => [ lt    => DateTime->today ],
 185   ]
 186
 187 Unfortunately, if you specify them in you form as these strings, the form
 188 parser will convert them into nested structures like this:
 189
 190   $::form = bless {
 191     filter => {
 192       customer => {
 193         name => 'John Doe',
 194       },
 195     },
 196   }, Form;
 197
 198 And the substring match requires you to recognize the ilike, and modify the value.
 199
 200 C<parse_filter> tries to ease this by recognizing these structures and
 201 providing suffixes for common search patterns.
 202
 203 =head1 FUNCTIONS
 204
 205 =over 4
 206
 207 =item C<parse_filter \%FILTER, [ %PARAMS ]>
 208
 209 First argument is the filter from form. It is highly recommended that you put
 210 all filter attributes into a named container as to not confuse them with the
 211 rest of your form.
 212
 213 Nested structures will be parsed and interpreted as foreign references. For
 214 example if you search for L<Order>s, this input will search for those with a
 215 specific L<Salesman>:
 216
 217   [% L.select_tag('filter.salesman.id', ...) %]
 218
 219 Additionally you can add modifier to the name to set a certain method:
 220
 221   [% L.input_tag('filter.department.description:substr::ilike', ...) %]
 222
 223 This will add the "% .. %" wildcards for substr matching in SQL, and add an
 224 C<< ilike => $value >> block around it to match case insensitively.
 225
 226 As a rule all value filters require a single colon and must be placed before
 227 match method suffixes, which are appended with 2 colons. See below for a full
 228 list of modifiers.
 229
 230 The reason for the method being last is that it is possible to specify the
 231 method in another input. Suppose you want a date input and a separate
 232 before/after/equal select, you can use the following:
 233
 234   [% L.date_tag('filter.appointed_date:date', ... ) %]
 235
 236 and later
 237
 238   [% L.select_tag('filter.appointed_date::', ... ) %]
 239
 240 The special empty method will be used to set the method for the previous
 241 method-less input.
 242
 243 =back
 244
 245 =head1 LAUNDERING
 246
 247 Unfortunately Template cannot parse the postfixes if you want to
 248 rerender the filter. For this reason all colons filter keys are by
 249 default laundered into underscores, so you can use them like this:
 250
 251   [% L.input_tag('filter.price:number::lt', filter.price_number__lt) %]
 252
 253 All of your original entries will stay intactg. If you don't want this to
 254 happen pass C<< no_launder => 1 >> as a parameter.  Additionally you can pass a
 255 different target for the laundered values with the C<launder_to>  parameter. It
 256 takes an hashref and will deep copy all values in your filter to the target. So
 257 if you have a filter that looks liek this:
 258
 259   $filter = {
 260     'price:number::lt' => '2,30',
 261     'closed            => '1',
 262   }
 263
 264 and parse it with
 265
 266   parse_filter($filter, launder_to => $laundered_filter = { })
 267
 268 the original filter will be unchanged, and C<$laundered_filter> will end up
 269 like this:
 270
 271   $filter = {
 272     'price_number__lt' => '2,30',
 273     'closed            => '1',
 274   }
 275
 276 =head1 FILTERS (leading with :)
 277
 278 The following filters are built in, and can be used.
 279
 280 =over 4
 281
 282 =item date
 283
 284 Parses the input string with C<< DateTime->from_lxoffice >>
 285
 286 =item number
 287
 288 Pasres the input string with C<< Form->parse_amount >>
 289
 290 =item percent
 291
 292 Parses the input string with C<< Form->parse_amount / 100 >>
 293
 294 =item head
 295
 296 Adds "%" at the end of the string.
 297
 298 =item tail
 299
 300 Adds "%" at the end of the string.
 301
 302 =item substr
 303
 304 Adds "% .. %" around the search string.
 305
 306 =back
 307
 308 =head2 METHODS (leading with ::)
 309
 310 =over 4
 311
 312 =item lt
 313
 314 =item gt
 315
 316 =item ilike
 317
 318 =item like
 319
 320 All these are recognized like the L<Rose::DB::Object> methods.
 321
 322 =back
 323
 324 =head1 BUGS AND CAVEATS
 325
 326 This will not properly handle multiple versions of the same object in different
 327 context.
 328
 329 Suppose you want all L<SL::DB::Order>s which have either themselves a certain
 330 customer, or are linked to a L<SL::DB::Invoice> with this customer, the
 331 following will not work as you expect:
 332
 333   # does not work!
 334   L.input_tag('customer.name:substr::ilike', ...)
 335   L.input_tag('invoice.customer.name:substr::ilike', ...)
 336
 337 This will sarch for orders whoe invoice has the _same_ customer, which matches
 338 both inputs. This is because tables are aliased by their name and not by their
 339 position in with_objects.
 340
 341 =head1 TODO
 342
 343 =over 4
 344
 345 =item *
 346
 347 Additional filters shoud be pluggable.
 348
 349 =back
 350
 351 =head1 AUTHOR
 352
 353 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 354
 355 =cut