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