| Akron | 5cf5fca | 2017-10-09 19:01:47 +0200 | [diff] [blame] | 1 | package Krawfish::Koral::Compile::Aggregate; |
| 2 | use Krawfish::Koral::Compile::Node::Aggregate; |
| Akron | a411d31 | 2017-08-12 01:15:11 +0200 | [diff] [blame] | 3 | use Krawfish::Log; |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 4 | use List::MoreUtils qw/uniq/; |
| 5 | use strict; |
| 6 | use warnings; |
| 7 | |
| Akron | 94256e6 | 2017-10-10 17:29:18 +0200 | [diff] [blame] | 8 | use constant DEBUG => 0; |
| Akron | a411d31 | 2017-08-12 01:15:11 +0200 | [diff] [blame] | 9 | |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 10 | # TODO: |
| 11 | # Check that only valid aggregate objects are passed |
| 12 | |
| 13 | our %AGGR_ORDER = ( |
| 14 | 'length' => 1, |
| 15 | 'freq' => 2, |
| Akron | a3581a9 | 2017-08-17 17:45:37 +0200 | [diff] [blame] | 16 | 'fields' => 3, |
| Akron | c1ed58c | 2017-08-04 17:26:30 +0200 | [diff] [blame] | 17 | 'values' => 4 |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 18 | ); |
| 19 | |
| Akron | a588d07 | 2017-10-13 14:45:34 +0200 | [diff] [blame] | 20 | |
| 21 | # Constructor |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 22 | sub new { |
| 23 | my $class = shift; |
| 24 | bless [@_], $class; |
| 25 | }; |
| 26 | |
| 27 | |
| Akron | a588d07 | 2017-10-13 14:45:34 +0200 | [diff] [blame] | 28 | # Aggregation type |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 29 | sub type { |
| 30 | 'aggregate'; |
| 31 | }; |
| 32 | |
| Akron | a411d31 | 2017-08-12 01:15:11 +0200 | [diff] [blame] | 33 | |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 34 | # Get or set operations |
| 35 | sub operations { |
| 36 | my $self = shift; |
| 37 | if (@_) { |
| 38 | @$self = @_; |
| 39 | return $self; |
| 40 | }; |
| 41 | return @$self; |
| 42 | }; |
| 43 | |
| Akron | c1ed58c | 2017-08-04 17:26:30 +0200 | [diff] [blame] | 44 | |
| Akron | a411d31 | 2017-08-12 01:15:11 +0200 | [diff] [blame] | 45 | # Wrap aggregates in each other |
| Akron | c1ed58c | 2017-08-04 17:26:30 +0200 | [diff] [blame] | 46 | sub wrap { |
| 47 | my ($self, $query) = @_; |
| 48 | |
| Akron | a411d31 | 2017-08-12 01:15:11 +0200 | [diff] [blame] | 49 | if (DEBUG) { |
| 50 | print_log('kq_aggr', 'Wrap operation ' . join(',', @$self)); |
| 51 | }; |
| Akron | c1ed58c | 2017-08-04 17:26:30 +0200 | [diff] [blame] | 52 | |
| Akron | a411d31 | 2017-08-12 01:15:11 +0200 | [diff] [blame] | 53 | # Join aggregates |
| Akron | 5cf5fca | 2017-10-09 19:01:47 +0200 | [diff] [blame] | 54 | return Krawfish::Koral::Compile::Node::Aggregate->new( |
| Akron | c1ed58c | 2017-08-04 17:26:30 +0200 | [diff] [blame] | 55 | $query, |
| 56 | [$self->operations] |
| 57 | ); |
| Akron | a411d31 | 2017-08-12 01:15:11 +0200 | [diff] [blame] | 58 | |
| 59 | return $query; |
| Akron | c1ed58c | 2017-08-04 17:26:30 +0200 | [diff] [blame] | 60 | }; |
| 61 | |
| 62 | |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 63 | # Normalize aggregations |
| 64 | sub normalize { |
| 65 | my $self = shift; |
| 66 | |
| 67 | # Sort objects in defined order |
| 68 | my @ops = sort { |
| 69 | $AGGR_ORDER{$a->type} <=> $AGGR_ORDER{$b->type} |
| 70 | } @$self; |
| 71 | |
| 72 | # Check for doubles |
| 73 | for (my $i = 1; $i < @ops; $i++) { |
| 74 | |
| 75 | # Two consecutive operations are identical |
| 76 | if ($ops[$i]->type eq $ops[$i-1]->type) { |
| 77 | |
| Akron | a3581a9 | 2017-08-17 17:45:37 +0200 | [diff] [blame] | 78 | # Merge fields or values |
| 79 | if ($ops[$i]->type eq 'fields' || $ops[$i]->type eq 'values') { |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 80 | $ops[$i-1]->operations( |
| 81 | $ops[$i-1]->operations, |
| 82 | $ops[$i]->operations |
| Akron | cfa3e01 | 2017-08-07 19:46:41 +0200 | [diff] [blame] | 83 | ); |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 84 | |
| Akron | cfa3e01 | 2017-08-07 19:46:41 +0200 | [diff] [blame] | 85 | # Remove double operation |
| 86 | splice(@ops, $i, 1); |
| 87 | $i--; |
| 88 | } |
| 89 | |
| 90 | else { |
| 91 | # Remove double operation |
| 92 | splice(@ops, $i, 1); |
| 93 | }; |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 94 | |
| Akron | 4204f17 | 2017-10-02 22:32:02 +0200 | [diff] [blame] | 95 | CORE::next; |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 96 | }; |
| 97 | |
| 98 | # Normalize when no longer consecutive operations |
| 99 | # can be expected |
| 100 | $ops[$i-1] = $ops[$i-1]->normalize; |
| 101 | }; |
| 102 | |
| 103 | # Normalize last operation |
| 104 | $ops[-1] = $ops[-1]->normalize; |
| 105 | |
| 106 | $self->operations(@ops); |
| 107 | |
| 108 | return $self; |
| 109 | }; |
| 110 | |
| 111 | |
| Akron | a588d07 | 2017-10-13 14:45:34 +0200 | [diff] [blame] | 112 | # Stringification |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 113 | sub to_string { |
| Akron | 10448e1 | 2017-10-11 18:04:53 +0200 | [diff] [blame] | 114 | my ($self, $id) = @_; |
| 115 | return 'aggr=[' . join(',', map { $_->to_string($id) } @$self) . ']'; |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 116 | }; |
| 117 | |
| Akron | 492674d | 2017-10-11 16:30:34 +0200 | [diff] [blame] | 118 | |
| Akron | 78c4950 | 2017-07-27 16:00:36 +0200 | [diff] [blame] | 119 | 1; |