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