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