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