File Coverage

lib/UR/BoolExpr/Template/And.pm
Criterion Covered Total %
statement 460 489 94.0
branch 187 222 84.2
condition 106 148 71.6
subroutine 17 17 100.0
pod 0 4 0.0
total 770 880 87.5


line stmt bran cond sub pod time code
1             package UR::BoolExpr::Template::And;
2 266     266   991 use warnings;
  266         331  
  266         7503  
3 266     266   882 use strict;
  266         315  
  266         623517  
4             require UR;
5             our $VERSION = "0.46"; # UR $VERSION;;
6              
7             UR::Object::Type->define(
8             class_name => __PACKAGE__,
9             is => ['UR::BoolExpr::Template::Composite'],
10             );
11              
12             sub _flatten_bx {
13 12     12   19 my ($class, $bx) = @_;
14 12         26 my $template = $bx->template;
15 12         41 my ($flattened_template, @extra_values) = $template->_flatten(@_);
16 12         11 my $flattened_bx;
17 12 100       28 if (not @extra_values) {
18             # optimized
19 9         19 my $flattened_bx_id = $flattened_template->id . $UR::BoolExpr::Util::id_sep . $bx->value_id;
20 9         30 $flattened_bx = UR::BoolExpr->get($flattened_bx_id);
21 9 50       26 $flattened_bx->{'values'} = $bx->{'values'} unless $flattened_bx->{'values'};
22             }
23             else {
24 3         12 $flattened_bx = $flattened_template->get_rule_for_values($bx->values, @extra_values);
25             }
26 12         22 return $flattened_bx;
27             }
28              
29             sub _reframe_bx {
30 19     19   47 my ($class, $bx, $in_terms_of_property_name) = @_;
31 19         42 my $template = $bx->template;
32 19         54 my ($reframed_template, @extra_values) = $template->_reframe($in_terms_of_property_name);
33 19         21 my $reframed_bx;
34 19 100       40 if (@extra_values == 0) {
35 16         44 my $reframed_bx_id = $reframed_template->id . $UR::BoolExpr::Util::id_sep . $bx->value_id;
36 16         52 $reframed_bx = UR::BoolExpr->get($reframed_bx_id);
37 16 100       52 $reframed_bx->{'values'} = $bx->{'values'} unless $reframed_bx->{'values'};
38             }
39             else {
40 3         12 my @values = ($bx->values, @extra_values);
41 3         11 $reframed_bx = $reframed_template->get_rule_for_values(@values);
42             }
43 19         43 return $reframed_bx;
44             }
45              
46             sub _flatten {
47 31     31   37 my $self = $_[0];
48            
49 31 100       68 if ($self->{flatten}) {
50 16         22 return @{ $self->{flatten} }
  16         42  
51             }
52              
53 15         16 my @old_keys = @{ $self->_keys };
  15         61  
54 15         46 my $old_property_meta_hash = $self->_property_meta_hash;
55              
56 15         50 my $class_meta = $self->subject_class_name->__meta__;
57            
58 15         25 my @new_keys;
59             my @extra_keys;
60 0         0 my @extra_values;
61            
62 0         0 my $old_constant_values;
63 0         0 my @new_constant_values;
64              
65 15         22 my $found_unflattened_params = 0;
66 15         44 while (my $key = shift @old_keys) {
67 37         41 my $name = $key;
68 37         94 $name =~ s/ .*//;
69 37 100       75 if (! UR::BoolExpr::Util::is_meta_param($name)) {
70 34         56 my $mdata = $old_property_meta_hash->{$name};
71 34         69 my ($value_position, $operator) = @$mdata{'value_position','operator'};
72            
73 34         141 my ($flat, $add_keys, $add_values) = $class_meta->_flatten_property_name($name);
74 34 50 66     196 $found_unflattened_params = 1 if $flat ne $name or @$add_keys or @$add_values;
      66        
75              
76 34 100 66     100 $flat .= ' ' . $operator if $operator and $operator ne '=';
77 34         41 push @new_keys, $flat;
78            
79 34         38 push @extra_keys, @$add_keys;
80 34         109 push @extra_values, @$add_values;
81             }
82             else {
83 3         4 push @new_keys, $key;
84 3   100     9 $old_constant_values ||= [ @{ $self->_constant_values } ];
  2         7  
85 3         4 my $old_value = shift @$old_constant_values;
86 3         5 my $new_value = [];
87 3         4 for my $part (@$old_value) {
88 6         17 my ($flat, $add_keys, $add_values) = $class_meta->_flatten_property_name($part);
89 6 0 33     16 $found_unflattened_params = 1 if $flat ne $name or @$add_keys or @$add_values;
      33        
90 6         8 push @$new_value, $flat;
91              
92 6         6 push @extra_keys, @$add_keys;
93 6         10 push @extra_values, @$add_values;
94             }
95 3         11 push @new_constant_values, $new_value;
96             }
97             }
98              
99 15         19 my $constant_values;
100 15 100       31 if ($old_constant_values) {
101             # some -* keys were found above, and we flattened the value internals
102 2         4 $constant_values = \@new_constant_values;
103             }
104             else {
105             # no -* keys, just re-use the empty arrayref
106 13         40 $constant_values = $self->_constant_values;
107             }
108              
109 15 100 66     58 if ($found_unflattened_params or @extra_keys) {
110 6 100       18 if (@extra_keys) {
111             # there may be duplication between these and the primary joins
112             # or each other
113 5         9 my %keys_seen = map { $_ => 1 } @new_keys;
  12         29  
114 5         10 my @nodup_extra_keys;
115             my @nodup_extra_values;
116 5         17 while (my $extra_key = shift @extra_keys) {
117 8         11 my $extra_value = shift @extra_values;
118 8 100       22 unless ($keys_seen{$extra_key}) {
119 5         8 push @nodup_extra_keys, $extra_key;
120 5         7 push @nodup_extra_values, $extra_value;
121 5         14 $keys_seen{$extra_key} = 1;
122             }
123             }
124 5         9 push @new_keys, @nodup_extra_keys;
125 5         14 @extra_values = @nodup_extra_values
126             }
127 6         18 my $flat = UR::BoolExpr::Template::And->_fast_construct(
128             $self->subject_class_name,
129             \@new_keys,
130             $constant_values,
131             );
132 6         23 $self->{flatten} = [$flat,@extra_values];
133 6         25 return ($flat, @extra_values);
134             }
135             else {
136             # everything was already flat, just remember this so you DRY
137 9         26 $self->{flatten} = [$self];
138 9         67 Scalar::Util::weaken($self->{flatten}[0]);
139 9         26 return $self
140             }
141             }
142              
143             sub _reframe {
144 19     19   23 my $self = shift;
145 19         25 my $in_terms_of_property_name = shift;
146            
147             # determine the from_class, to_class, and path_back
148 19         54 my $from_class = $self->subject_class_name;
149 19         46 my $cmeta = $self->subject_class_name->__meta__;
150 19         88 my @pmeta = $cmeta->property_meta_for_name($in_terms_of_property_name);
151 19 50       44 unless (@pmeta) {
152 0         0 Carp::confess("Failed to find property $in_terms_of_property_name on $from_class. Cannot reframe $self!");
153             }
154 19         34 my @reframe_path_forward = map { $_->_resolve_join_chain($in_terms_of_property_name) } @pmeta;
  23         78  
155 19         38 my $to_class = $reframe_path_forward[-1]{foreign_class};
156              
157             # translate all of the old properties to use the path back to the original class
158 19         54 my ($flat,@extra_values) = $self->_flatten;
159 19         21 my @old_keys = @{ $flat->_keys };
  19         51  
160 19         45 my $old_property_meta_hash = $flat->_property_meta_hash;
161              
162 19         26 my %sub_group_label_used;
163             my $reframer = sub {
164 59     59   56 my $old_name = $_[0];
165             # uses: @reframe_path_forward from above in this closure
166              
167             # get back to the original object
168 59         75 my @reframe_path_back = reverse @reframe_path_forward;
169              
170             # then forward to the property related to it
171 59         92 my @filter_path_forward = split('\.',$old_name);
172              
173             # if the end of the path back matches the beginning of the path
174             # to the property in the expression unneeded steps (beyond 1)
175 59         51 my $new_key;
176 59         43 while (1) {
177 96 100       125 unless (@reframe_path_back) {
178 25         24 last;
179             }
180 71 100       91 unless (@filter_path_forward) {
181 2         4 last;
182             }
183 69         74 my $last_name_back = $reframe_path_back[-1]{source_name_for_foreign};
184 69         51 my $first_name_forward = $filter_path_forward[0];
185              
186            
187 69         49 my $turnaround_match = 0;
188 69 100       81 if ($last_name_back eq $first_name_forward) {
189             # complete overlap
190 29         26 $turnaround_match = 1; # safe
191             }
192             else {
193             # see if stripping off any labels makes them match
194 40         41 my $last_name_back_base = $last_name_back;
195 40         41 $last_name_back_base =~ s/-.*//;
196              
197 40         27 my $first_name_forward_base = $first_name_forward;
198 40         51 $first_name_forward_base =~ s/-.*//;
199              
200 40 100       71 if ($last_name_back_base eq $first_name_forward_base) {
201             # removing the grouping label causes a match
202             # possible overlap
203 8         18 for my $pair (
204             [$first_name_forward_base, $last_name_back],
205             [$last_name_back_base, $first_name_forward],
206             ) {
207 16         18 my ($partial, $full) = @$pair;
208 16 50       35 if (index($full, $partial) == 0) {
209             #print "$partial is part of $full\n";
210 16 100       22 if (my $prev_full = $sub_group_label_used{$partial}) {
211             # we've tracked back through this $partially specified relationship once
212             # see if we did it the same way
213 13 100       16 if ($prev_full eq $full) {
214 5         7 $turnaround_match = 1;
215             }
216             else {
217             #print "previously used $prev_full for $partial: cannot use $full\n";
218 8         14 next;
219             }
220             }
221             else {
222             # this relationship has not been seen
223             #print "using $full for $partial\n";
224 3         4 $sub_group_label_used{$partial} = $full;
225 3         6 $turnaround_match = 1;
226             }
227             }
228             }
229             }
230             }
231              
232 69 100       85 if ($turnaround_match == 0) {
233             # found a difference: no shortcut
234             # we have to trek all the way back to the original subject before
235             # moving forward to this property
236 32         33 last;
237             }
238             else {
239             # the last step back matches the first step to the property
240 37 100 100     104 if (@reframe_path_back == 1 and @filter_path_forward == 1) {
241             # just keep one of the identical pair
242 2         5 shift @filter_path_forward;
243             }
244             else {
245             # remove both (if one is empty this is no problem)
246 35         35 pop @reframe_path_back;
247 35         40 shift @filter_path_forward;
248             }
249             }
250             }
251            
252 59         59 $new_key = join('.', map { $_->{foreign_name_for_source} } @reframe_path_back);
  37         77  
253 59 100       99 $new_key = join('.', ($new_key ? $new_key : ()), @filter_path_forward);
254              
255 59         80 return $new_key;
256 19         111 };
257              
258            
259             # this is only set below if we find any -* keys
260 19         23 my $old_constant_values;
261              
262             my @new_keys;
263 0         0 my @new_constant_values;
264              
265 19         42 while (@old_keys) {
266 56         56 my $old_key = shift @old_keys;
267              
268 56 100       105 if (! UR::BoolExpr::Util::is_meta_param($old_key)) {
269             # a regular property
270 54         47 my $old_name = $old_key;
271 54         99 $old_name =~ s/ .*//;
272            
273 54         59 my $mdata = $old_property_meta_hash->{$old_name};
274 54         81 my ($value_position, $operator) = @$mdata{'value_position','operator'};
275            
276 54         69 my $new_key = $reframer->($old_name);
277              
278 54 100 66     132 $new_key .= ' ' . $operator if $operator and $operator ne '=';
279 54         118 push @new_keys, $new_key;
280             }
281             else {
282             # this key is not a property, it's a special key like -order_by or -group_by
283 2 0 66     15 unless ($old_key eq '-order_by'
      33        
      33        
284             or $old_key eq '-group_by'
285             or $old_key eq '-hints'
286             or $old_key eq '-recurse'
287             ) {
288 0         0 Carp::confess("no support yet for $old_key in bx reframe()!");
289             }
290              
291 2         3 push @new_keys, $old_key;
292              
293 2 100       4 unless ($old_constant_values) {
294 1         1 $old_constant_values = [ @{ $flat->_constant_values } ];
  1         4  
295             }
296              
297 2         3 my $old_value = shift @$old_constant_values;
298 2         3 my $new_value = [];
299 2         2 for my $part (@$old_value) {
300 5         7 my $reframed_part = $reframer->($part);
301 5         7 push @$new_value, $reframed_part;
302             }
303 2         6 push @new_constant_values, $new_value;
304             }
305             }
306              
307              
308 19         16 my $constant_values;
309 19 100       32 if (@new_constant_values) {
310 1         3 $constant_values = \@new_constant_values;
311             }
312             else {
313 18         51 $constant_values = $flat->_constant_values; # re-use empty immutable arrayref
314             }
315              
316 19         61 my $reframed = UR::BoolExpr::Template::And->_fast_construct(
317             $to_class,
318             \@new_keys,
319             $constant_values,
320             );
321              
322 19         248 return $reframed, @extra_values;
323             }
324              
325             sub _template_for_grouped_subsets {
326 56     56   88 my $self = shift;
327 56         146 my $group_by = $self->group_by;
328 56 50       139 die "rule template $self->{id} has no -group_by!?!?" unless $group_by;
329              
330 56         174 my @base_property_names = $self->_property_names;
331 56         182 for (my $i = 0; $i < @base_property_names; $i++) {
332 48         158 my $operator = $self->operator_for($base_property_names[$i]);
333 48 100       168 if ($operator ne '=') {
334 2         9 $base_property_names[$i] .= " $operator";
335             }
336             }
337              
338 56         145 my $template = UR::BoolExpr::Template->get_by_subject_class_name_logic_type_and_logic_detail(
339             $self->subject_class_name,
340             'And',
341             join(",", @base_property_names, @$group_by),
342             );
343              
344 56         154 return $template;
345             }
346              
347             sub _variable_value_count {
348 4     4   4 my $self = shift;
349 4         7 my $k = $self->_underlying_keys;
350 4         21 my $v = $self->_constant_values;
351 4 50       7 if ($v) {
352 4         6 $v = scalar(@$v);
353             }
354             else {
355 0         0 $v = 0;
356             }
357 4         6 return $k-$v;
358             }
359              
360             sub _underlying_keys {
361 135297     135297   115027 my $self = shift;
362 135297         257859 my $logic_detail = $self->logic_detail;
363 135297 100       211069 return unless $logic_detail;
364 134656         312027 my @underlying_keys = split(",",$logic_detail);
365 134656         256255 return @underlying_keys;
366             }
367              
368             sub get_underlying_rule_templates {
369 2228     2228 0 2612 my $self = shift;
370 2228 100       4551 my @underlying_keys = grep { UR::BoolExpr::Util::is_meta_param($_) ? () : ($_) } $self->_underlying_keys();
  5096         10892  
371 2228         5246 my $subject_class_name = $self->subject_class_name;
372             return map {
373 2228         3388 UR::BoolExpr::Template::PropertyComparison
  4703         15073  
374             ->_get_for_subject_class_name_and_logic_detail(
375             $subject_class_name,
376             $_
377             );
378             } @underlying_keys;
379             }
380              
381             sub specifies_value_for {
382 1937     1937 0 2737 my ($self, $property_name) = @_;
383 1937 50       4242 Carp::confess('Missing required parameter property_name for specifies_value_for()') if not defined $property_name;
384 1937         4629 my @underlying_templates = $self->get_underlying_rule_templates();
385 1937         3635 foreach ( @underlying_templates ) {
386 2767 100       7067 return 1 if $property_name eq $_->property_name;
387             }
388 1112         6151 return;
389             }
390              
391             sub _filter_breakdown {
392 103878     103878   83420 my $self = $_[0];
393 103878   66     156186 my $filter_breakdown = $self->{_filter_breakdown} ||= do {
394 291         772 my @underlying = $self->get_underlying_rule_templates;
395 291         463 my @primary;
396             my %sub_group_filters;
397 0         0 my %sub_group_sub_filters;
398 291         1081 for (my $n = 0; $n < @underlying; $n++) {
399 376         515 my $underlying = $underlying[$n];
400 376         1533 my $sub_group = $underlying->sub_group;
401 376 50       698 if ($sub_group) {
402 0 0       0 if (substr($sub_group,-1) ne '?') {
403             # control restruct the subject based on the sub-group properties
404 0   0     0 my $list = $sub_group_filters{$sub_group} ||= [];
405 0         0 push @$list, $underlying, $n;
406             }
407             else {
408             # control what is IN a sub-group (effectively define it with these)
409 0         0 chop($sub_group);
410 0   0     0 my $list = $sub_group_sub_filters{$sub_group} ||= [];
411 0         0 push @$list, $underlying, $n;
412             }
413             }
414             else {
415 376         1080 push @primary, $underlying, $n;
416             }
417             }
418              
419             {
420 291         1909 primary => \@primary,
421             sub_group_filters => \%sub_group_filters,
422             sub_group_sub_filters => \%sub_group_sub_filters,
423             };
424             };
425 103878         96585 return $filter_breakdown;
426             }
427              
428             sub evaluate_subject_and_values {
429 103880     103880 0 81146 my $self = shift;
430 103880         67523 my $subject = shift;
431              
432 103880 100 66     314187 return unless (ref($subject) && $subject->isa($self->subject_class_name));
433              
434 103878         136573 my $filter_breakdown = $self->_filter_breakdown;
435             my ($primary,$sub_group_filters,$sub_group_sub_filters)
436 103878         124181 = @$filter_breakdown{"primary","sub_group_filters","sub_group_sub_filters"};
437            
438             # flattening expresions now requires that we re-group them :(
439             # these effectively are subqueries where they occur
440              
441             # check the ungrouped comparisons first since they are simpler
442 103878         168399 for (my $n = 0; $n < @$primary; $n+=2) {
443 2099         1963 my $underlying = $primary->[$n];
444 2099         2255 my $pos = $primary->[$n+1];
445 2099         2006 my $value = $_[$pos];
446 2099 100       4813 unless ($underlying->evaluate_subject_and_values($subject, $value)) {
447 1072         3066 return;
448             }
449             }
450              
451             # only check the complicated rules if none of the above failed
452 102806 50       136760 if (%$sub_group_filters) {
453             #$DB::single = 1;
454 0         0 for my $sub_group (keys %$sub_group_filters) {
455 0         0 my $filters = $sub_group_filters->{$sub_group};
456 0         0 my $sub_filters = $sub_group_sub_filters->{$sub_group};
457 0         0 print "FILTERING $sub_group: " . Data::Dumper::Dumper($filters, $sub_filters);
458             }
459             }
460            
461 102806         318471 return 1;
462             }
463              
464             sub params_list_for_values {
465             # This is the reverse of the bulk of resolve.
466             # It returns the params in list form, directly coercable into a hash if necessary.
467             # $r = UR::BoolExpr->resolve($c1,@p1);
468             # ($c2, @p2) = ($r->subject_class_name, $r->params_list);
469            
470 131613     131613 0 110191 my $rule_template = shift;
471 131613         161062 my @values_sorted = @_;
472            
473 131613         220327 my @keys_sorted = $rule_template->_underlying_keys;
474 131613         278012 my $constant_values = $rule_template->_constant_values;
475            
476 131613         106209 my @params;
477 131613         140743 my ($v,$c) = (0,0);
478 131613         267137 for (my $k=0; $k<@keys_sorted; $k++) {
479 248420         212390 my $key = $keys_sorted[$k];
480             #if (substr($key,0,1) eq "_") {
481             # next;
482             #}
483 248420 100       389846 if (UR::BoolExpr::Util::is_meta_param($key)) {
484 815         1032 my $value = $constant_values->[$c];
485 815         1017 push @params, $key, $value;
486 815         1725 $c++;
487             }
488             else {
489 247605         824327 my ($property, $op) = ($key =~ /^(\-*[\w\.]+)\s*(.*)$/);
490 247605 50       368030 unless ($property) {
491 0         0 $DB::single = 1;
492 0         0 Carp::confess("bad key '$key' in ",join(', ', @keys_sorted));
493             }
494 247605         207075 my $value = $values_sorted[$v];
495 247605 100       317507 if ($op) {
496 19754 100       36586 if ($op ne "in") {
497 17697 50       25729 if ($op =~ /^(.+)-(.+)$/) {
498 0         0 $value = { operator => $1, value => $value, escape => $2 };
499             }
500             else {
501 17697         51929 $value = { operator => $op, value => $value };
502             }
503             }
504             }
505 247605         261886 push @params, $property, $value;
506 247605         476167 $v++;
507             }
508             }
509              
510 131613         600622 return @params;
511             }
512              
513             sub _fast_construct {
514 8499     8499   14670 my ($class,
515             $subject_class_name, # produces subject class meta
516             $keys, # produces logic detail
517             $constant_values, # produces constant value id
518            
519             $logic_detail, # optional, passed by get
520             $constant_value_id, # optional, passed by get
521             $subject_class_meta, # optional, passed by bx
522             ) = @_;
523              
524 8499         10122 my $logic_type = 'And';
525 8499   100     30476 $logic_detail ||= join(",",@$keys);
526 8499   66     25786 $constant_value_id ||= UR::BoolExpr::Util::values_to_value_id(@$constant_values);
527            
528 8499         20930 my $id = join('/',$subject_class_name,$logic_type,$logic_detail,$constant_value_id);
529 8499         14405 my $self = $UR::Object::rule_templates->{$id};
530 8499 100       16503 return $self if $self;
531              
532 7549   33     29033 $subject_class_meta ||= $subject_class_name->__meta__;
533              
534             # See what properties are id-related for the class
535 7549   66     21315 my $cache = $subject_class_meta->{cache}{'UR::BoolExpr::Template::get'} ||= do {
536 2564         3930 my $id_related = {};
537 2564         3681 my $id_translations = [];
538 2564         3481 my $id_pos = {};
539 2564         2723 my $id_prop_is_real; # true if there's a property called 'id' that's a real property, not from UR::Object
540 2564         7070 for my $iclass ($subject_class_name, $subject_class_meta->ancestry_class_names) {
541 6983 100       13110 last if $iclass eq "UR::Object";
542 4419 50       16401 next unless $iclass->isa("UR::Object");
543 4419         9814 my $iclass_meta = $iclass->__meta__;
544 4419         20480 my @id_props = $iclass_meta->id_property_names;
545 4419 50       8611 next unless @id_props;
546 4419 100       5704 $id_prop_is_real = 1 if (grep { $_ eq 'id'} @id_props);
  5575         14114  
547 4419 50 100     24501 next if @id_props == 1 and $id_props[0] eq "id" and !$id_prop_is_real;
      66        
548 4419         9538 @$id_related{@id_props} = @id_props;
549 4419         6664 push @$id_translations, \@id_props;
550 4419 100 100     21242 @$id_pos{@id_props} = (0..$#id_props) unless @id_props == 1 and $id_props[0] eq 'id';
551             }
552 2564         8349 [$id_related,$id_translations,$id_pos];
553             };
554 7549         12762 my ($id_related,$id_translations,$id_pos) = @$cache;
555 7549         14666 my @keys = @$keys;
556 7549         9374 my @constant_values = @$constant_values;
557              
558             # Make a hash to quick-validate the params for duplication
559 266     266   1525 no warnings;
  266         406  
  266         409272  
560 7549         7579 my %check_for_duplicate_rules;
561 7549         18784 for (my $n=0; $n < @keys; $n++) {
562 18047 100       29063 next if UR::BoolExpr::Util::is_meta_param($keys[$n]);
563 17667         21920 my $pos = index($keys[$n],' ');
564 17667 100       21589 if ($pos != -1) {
565 1638         2446 my $property = substr($keys[$n],0,$pos);
566 1638         3961 $check_for_duplicate_rules{$property}++;
567             }
568             else {
569 16029         35202 $check_for_duplicate_rules{$keys[$n]}++;
570             }
571             }
572              
573             # each item in this list mutates the initial set of key-value pairs
574 7549         10311 my $extenders = [];
575            
576             # add new @$extenders for class-specific characteristics
577             # add new @keys at the same time
578             # flag keys as removed also at the same time
579              
580             # note the positions for each key in the "original" rule
581             # by original, we mean the original plus the extensions from above
582             #
583 7549         7719 my $id_position = undef;
584 7549         7275 my $var_pos = 0;
585 7549         6668 my $const_pos = 0;
586 7549         8347 my $property_meta_hash = {};
587 7549         8473 my $property_names = [];
588 7549         10598 for my $key (@keys) {
589 18047 100       25472 if (UR::BoolExpr::Util::is_meta_param($key)) {
590 380         1097 $property_meta_hash->{$key} = {
591             name => $key,
592             value_position => $const_pos
593             };
594 380         529 $const_pos++;
595             }
596             else {
597 17667         53893 my ($name, $op) = ($key =~ /^(.+?)\s+(.*)$/);
598 17667   66     43990 $name ||= $key;
599 17667 100       27234 if ($name eq 'id') {
600 3627         4329 $id_position = $var_pos;
601             }
602 17667         49664 $property_meta_hash->{$name} = {
603             name => $name,
604             operator => $op,
605             value_position => $var_pos
606             };
607 17667         14661 $var_pos++;
608 17667         27373 push @$property_names, $name;
609             }
610             }
611              
612              
613             # Note whether there are properties not involved in the ID
614             # Add value extenders for any cases of id-related properties,
615             # or aliases.
616 7549         8703 my $original_key_count = @keys;
617 7549         7516 my $id_only = 1;
618 7549         6982 my $partial_id = 0;
619 7549         8560 my $key_op_hash = {};
620 7549 100 66     16327 if (@$id_translations and @{$id_translations->[0]} == 1) {
  7549         21976  
621             # single-property ID
622             ## use Data::Dumper;
623             ## print "single property id\n". Dumper($id_translations);
624 5045         4974 my ($property, $op);
625              
626             # Presume we are only getting id properties until another is found.
627             # If a multi-property is partially specified, we'll zero this out too.
628            
629 5045         5359 my $values_index = -1; # -1 so we can bump it at start of loop
630 5045         12055 for (my $key_pos = 0; $key_pos < $original_key_count; $key_pos++) {
631 10691         10459 my $key = $keys[$key_pos];
632 10691 100       16467 if (UR::BoolExpr::Util::is_meta_param($key)) {
633             # -* are constant value keys and do not need to be changed
634 257         558 next;
635             } else {
636 10434         8567 $values_index++;
637             }
638              
639 10434         25602 my ($property, $op) = ($key =~ /^(.+?)\s+(.*)$/);
640 10434   66     26376 $property ||= $key;
641 10434   100     23448 $op ||= "";
642 10434         10047 $op =~ s/\s+//;
643 10434   100     32053 $key_op_hash->{$property} ||= {};
644 10434         15679 $key_op_hash->{$property}{$op}++;
645            
646 10434 100 66     33866 if ($property eq "id" or $id_related->{$property}) {
    50          
647             # Put an id key into the key list.
648 3818         9488 for my $alias (["id"], @$id_translations) {
649 9817 100       17181 next if $alias->[0] eq $property;
650 2496 100       4933 next if $check_for_duplicate_rules{$alias->[0]};
651 971   100     3388 $op ||= "";
652 971 100       2925 push @keys, $alias->[0] . ($op ? " $op" : "");
653 971         2712 push @$extenders, [ [$values_index], undef, $keys[-1] ];
654 971   100     4128 $key_op_hash->{$alias->[0]} ||= {};
655 971         2236 $key_op_hash->{$alias->[0]}{$op}++;
656             ## print ">> extend for @$alias with op $op.\n";
657             }
658 3818 100       19439 unless ($op =~ m/^(=|eq|in|\[\]|)$/) {
659 56         126 $id_only = 0;
660             }
661             }
662             elsif (! UR::BoolExpr::Util::is_meta_param($key)) {
663 6616         12821 $id_only = 0;
664             ## print "non id single property $property on $subject_class\n";
665             }
666             }
667             }
668             else {
669             # multi-property ID
670             ## print "multi property id\n". Dumper($id_translations);
671 2504         3036 my ($property, $op);
672 0         0 my %id_parts;
673 2504         2647 my $values_index = -1; # -1 so we can bump it at start of loop
674 2504         2375 my $id_op;
675 2504         5990 for (my $key_pos = 0; $key_pos < $original_key_count; $key_pos++) {
676 7356         6845 my $key = $keys[$key_pos];
677 7356 100       10984 if (UR::BoolExpr::Util::is_meta_param($key)) {
678             # -* are constant value keys and do not need to be changed
679 123         241 next;
680             } else {
681 7233         5538 $values_index++;
682             }
683 7233 50       10267 next if UR::BoolExpr::Util::is_meta_param($key);
684              
685 7233         18017 my ($property, $op) = ($key =~ /^(.+?)\s+(.*)$/);
686 7233   66     17564 $property ||= $key;
687 7233   100     15497 $op ||= '';
688 7233 100       10280 $op =~ s/^\s+// if $op;
689 7233   100     20721 $key_op_hash->{$property} ||= {};
690 7233         10626 $key_op_hash->{$property}{$op}++;
691            
692 7233 100       13918 if ($property eq "id") {
    100          
693 793         1095 $id_op = $op;
694 793   50     1985 $key_op_hash->{id} ||= {};
695 793         1166 $key_op_hash->{id}{$op}++;
696             # Put an id-breakdown key into the key list.
697 793         1358 for my $alias (@$id_translations) {
698 1106 100       1680 my @new_keys = map { $_ . ($op ? " $op" : "") } @$alias;
  2374         5646  
699 1106 100       1573 if (grep { $check_for_duplicate_rules{$_} } @$alias) {
  2374         5108  
700             #print "up @new_keys with @$alias\n";
701             }
702             else {
703 13         25 push @keys, @new_keys;
704 13         39 push @$extenders, [ [$values_index], "resolve_ordered_values_from_composite_id", @new_keys ];
705 13         29 for (@$alias) {
706 26   50     88 $key_op_hash->{$_} ||= {};
707 26         46 $key_op_hash->{$_}{$op}++;
708             }
709             # print ">> extend for @$alias with op $op.\n";
710             }
711             }
712             }
713             elsif ($id_related->{$property}) {
714 5310   100     12805 $id_op ||= $op;
715 5310 100 66     12556 if ($op eq "" or $op eq "eq" or $op eq "=" or $op eq 'in') {
      100        
      100        
716 5291         14107 $id_parts{$id_pos->{$property}} = $values_index;
717             }
718             else {
719             # We're doing some sort of gray-area comparison on an ID
720             # field, and though we could possibly resolve an ID
721             # from things like an 'in' op, it's more than we've done
722             # before.
723 19         40 $id_only = 0;
724             }
725             }
726             else {
727             ## print "non id multi property $property on class $subject_class\n";
728 1130         2333 $id_only = 0;
729             }
730             }
731            
732 2504 100       5468 if (my $parts = (scalar(keys(%id_parts)))) {
733             # some parts are id-related
734 2326 100       2092 if ($parts == @{$id_translations->[0]}) {
  2326         4505  
735             # all parts are of the id are there
736 1668 50       3154 if (@$id_translations) {
737 1668 100       2271 if (grep { $_ eq 'id' } @keys) {
  5970         9428  
738             #print "found id already\n";
739             }
740             else {
741             #print "no id\n";
742             # we have translations of that ID into underlying properties
743             #print "ADDING ID for " . join(",",keys %id_parts) . "\n";
744 903         3947 my @id_pos = sort { $a <=> $b } keys %id_parts;
  2133         4862  
745 903         3667 push @$extenders, [ [@id_parts{@id_pos}], "resolve_composite_id_from_ordered_values", 'id' ]; #TODO was this correct?
746 903   100     4332 $key_op_hash->{id} ||= {};
747 903         1524 $key_op_hash->{id}{$id_op}++;
748 903         2888 push @keys, "id";
749             }
750             }
751             }
752             else {
753             # not all parts of the id are there
754             ## print "partial id property $property on class $subject_class\n";
755 658         959 $id_only = 0;
756 658         1473 $partial_id = 1;
757             }
758             } else {
759 178         286 $id_only = 0;
760 178         353 $partial_id = 0;
761             }
762             }
763            
764             # Determine the positions of each key in the parameter list.
765             # In actuality, the position of the key's value in the @values or @constant_values array,
766             # depending on whether it is a -* key or not.
767 7549         8570 my %key_positions;
768 7549         7335 my $vpos = 0;
769 7549         7339 my $cpos = 0;
770 7549         10688 for my $key (@keys) {
771 19947   100     55153 $key_positions{$key} ||= [];
772 19947 100       29445 if (UR::BoolExpr::Util::is_meta_param($key)) {
773 380         385 push @{ $key_positions{$key} }, $cpos++;
  380         708  
774             }
775             else {
776 19567         14022 push @{ $key_positions{$key} }, $vpos++;
  19567         31972  
777             }
778             }
779              
780             # Sort the keys, and make an arrayref which will
781             # re-order the values to match.
782 7549         8776 my $last_key = '';
783 7549 100       19863 my @keys_sorted = map { $_ eq $last_key ? () : ($last_key = $_) } sort @keys;
  19947         39936  
784              
785              
786 7549         10272 my $normalized_positions_arrayref = [];
787 7549         8810 my $constant_value_normalized_positions = [];
788 7549         7572 my $recursion_desc = undef;
789 7549         6437 my $hints = undef;
790 7549         6570 my $order_by = undef;
791 7549         6312 my $group_by = undef;
792 7549         6282 my $page = undef;
793 7549         6065 my $limit = undef;
794 7549         6094 my $offset = undef;
795 7549         6020 my $aggregate = undef;
796 7549         6812 my @constant_values_sorted;
797              
798 7549         9420 for my $key (@keys_sorted) {
799 19769         17590 my $pos_list = $key_positions{$key};
800 19769         15694 my $pos = pop @$pos_list;
801 19769 100       27382 if (UR::BoolExpr::Util::is_meta_param($key)) {
802 380         493 push @$constant_value_normalized_positions, $pos;
803 380         434 my $constant_value = $constant_values[$pos];
804              
805 380 100 100     2882 if ($key eq '-recurse') {
    100 100        
    100 100        
    100          
    100          
    100          
    100          
    50          
806 9 50       22 $constant_value = [$constant_value] if (!ref $constant_value);
807 9         13 $recursion_desc = $constant_value;
808             }
809             elsif ($key eq '-hints' or $key eq '-hint') {
810 75 100       190 $constant_value = [$constant_value] if (!ref $constant_value);
811 75         98 $hints = $constant_value;
812             }
813             elsif ($key eq '-order_by' or $key eq '-order') {
814 115 100       287 $constant_value = [$constant_value] if (!ref $constant_value);
815 115         140 $order_by = $constant_value;
816             }
817             elsif ($key eq '-group_by' or $key eq '-group') {
818 51 50       106 $constant_value = [$constant_value] if (!ref $constant_value);
819 51         53 $group_by = $constant_value;
820             }
821             elsif ($key eq '-page') {
822 6 50       15 $constant_value = [$constant_value] if (!ref $constant_value);
823 6         10 $page = $constant_value;
824             }
825             elsif ($key eq '-limit') {
826 40         42 $limit = $constant_value;
827             }
828             elsif ($key eq '-offset') {
829 38         36 $offset = $constant_value;
830             }
831             elsif ($key eq '-aggregate') {
832 46 100       87 $constant_value = [$constant_value] if (!ref $constant_value);
833 46         41 $aggregate = $constant_value;
834             }
835             else {
836 0         0 Carp::croak("Unknown special param '$key'. Expected one of: @UR::BoolExpr::Template::meta_param_names");
837             }
838 380         654 push @constant_values_sorted, $constant_value;
839             }
840             else {
841 19389         25090 push @$normalized_positions_arrayref, $pos;
842             }
843             }
844              
845 7549 100       14181 if ($page) {
846 6 50 33     25 if (defined($limit) || defined($offset)) {
847 0         0 Carp::croak("-page and -limit/-offset are mutually exclusive when defining a BoolExpr");
848             }
849 6 50 33     26 if (ref($page) and ref($page) eq 'ARRAY') {
850 6 50       15 if (@$page == 2) {
    0          
851 6         9 $limit = $page->[1];
852 6         17 $offset = ($page->[0] - 1) * $limit;
853             } elsif (@$page) {
854 0         0 Carp::croak('-page must be an arrayref of two integers: -page => [$page_number, $page_size]');
855             }
856             } else {
857 0         0 Carp::croak('-page must be an arrayref of two integers: -page => [$page_number, $page_size]');
858             }
859             }
860              
861 7549 50 66     18060 if (defined($hints) and ref($hints) ne 'ARRAY') {
862 0 0       0 if (! ref($hints)) {
863 0         0 $hints = [$hints]; # convert it to a list of one item
864             } else {
865 0         0 Carp::croak('-hints of a rule must be an arrayref of property names');
866             }
867             }
868              
869 7549         7449 my $matches_all;
870 7549         6703 do {
871 7549         10220 my $is_no_filters = (scalar(@keys_sorted) == scalar(@constant_values));
872 7549 100       12774 $id_only = 0 if ($is_no_filters);
873 7549   100     16368 $matches_all = ($is_no_filters && ! (defined($limit) or $offset));
874             };
875              
876             # these are used to rapidly turn a bx used for querying into one
877             # suitable for object construction
878 7549         7799 my @ambiguous_keys;
879             my @ambiguous_property_names;
880 7549         17798 for (my $n=0; $n < @keys; $n++) {
881 19947 100       29910 next if UR::BoolExpr::Util::is_meta_param($keys[$n]);
882 19567         49841 my ($property, $op) = ($keys[$n] =~ /^(.+?)\s+(.*)$/);
883 19567   66     48084 $property ||= $keys[$n];
884 19567   100     41479 $op ||= '';
885 19567 100       26085 $op =~ s/^\s+// if $op;
886 19567 100 66     58144 if ($op and $op ne 'eq' and $op ne '==' and $op ne '=') {
      66        
      66        
887 1624         2503 push @ambiguous_keys, $keys[$n];
888 1624         3649 push @ambiguous_property_names, $property;
889             }
890             }
891              
892             # Determine the rule template's ID.
893             # The normalizer will store this. Below, we'll
894             # find or create the template for this ID.
895 7549 100       15070 my $normalized_constant_value_id = (scalar(@constant_values_sorted) ? UR::BoolExpr::Util::values_to_value_id(@constant_values_sorted) : $constant_value_id);
896              
897             my @keys_unaliased = $UR::Object::Type::bootstrapping
898             ? @keys_sorted
899 14715 100       25069 : map { $_->[0] = UR::BoolExpr::Util::is_meta_param($_->[0]) ? $_->[0] : $subject_class_meta->resolve_property_aliases($_->[0]);
900 14714         30582 join(' ',@$_); }
901 7549 100       16545 map { [ split(' ') ] }
  14715         31024  
902             @keys_sorted;
903 7548         30197 my $normalized_id = UR::BoolExpr::Template->__meta__->resolve_composite_id_from_ordered_values($subject_class_name, "And", join(",",@keys_unaliased), $normalized_constant_value_id);
904              
905 7548 100       144645 $self = bless {
    100          
    100          
906             id => $id,
907             subject_class_name => $subject_class_name,
908             logic_type => $logic_type,
909             logic_detail => $logic_detail,
910             constant_value_id => $constant_value_id,
911             normalized_id => $normalized_id,
912            
913             # subclass specific
914             id_position => $id_position,
915             is_id_only => $id_only,
916             is_partial_id => $partial_id,
917             is_unique => undef, # assigned on first use
918             matches_all => $matches_all,
919            
920             key_op_hash => $key_op_hash,
921             _property_names_arrayref => $property_names,
922             _property_meta_hash => $property_meta_hash,
923            
924             recursion_desc => $recursion_desc,
925             hints => $hints,
926             order_by => $order_by,
927             group_by => $group_by,
928             limit => $limit,
929             offset => $offset,
930             aggregate => $aggregate,
931            
932             is_normalized => ($id eq $normalized_id ? 1 : 0),
933             normalized_positions_arrayref => $normalized_positions_arrayref,
934             constant_value_normalized_positions_arrayref => $constant_value_normalized_positions,
935             normalization_extender_arrayref => $extenders,
936            
937             num_values => scalar(@$keys),
938            
939             _keys => \@keys,
940             _constant_values => $constant_values,
941              
942             _ambiguous_keys => (@ambiguous_keys ? \@ambiguous_keys : undef),
943             _ambiguous_property_names => (@ambiguous_property_names ? \@ambiguous_property_names : undef),
944              
945             }, 'UR::BoolExpr::Template::And';
946              
947 7548         18596 $UR::Object::rule_templates->{$id} = $self;
948 7548         71493 return $self;
949             }
950              
951              
952             1;
953              
954             =pod
955              
956             =head1 NAME
957              
958             UR::BoolExpr::And - a rule which is true if ALL the underlying conditions are true
959              
960             =head1 SEE ALSO
961              
962             UR::BoolExpr;(3)
963              
964             =cut