| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package OData::QueryParams::DBIC::FilterUtils; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | # ABSTRACT: parse filter param | 
| 4 |  |  |  |  |  |  |  | 
| 5 | 15 |  |  | 15 |  | 143815 | use v5.20; | 
|  | 15 |  |  |  |  | 77 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 15 |  |  | 15 |  | 90 | use strict; | 
|  | 15 |  |  |  |  | 43 |  | 
|  | 15 |  |  |  |  | 337 |  | 
| 8 | 15 |  |  | 15 |  | 120 | use warnings; | 
|  | 15 |  |  |  |  | 31 |  | 
|  | 15 |  |  |  |  | 433 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 15 |  |  | 15 |  | 92 | use feature 'signatures'; | 
|  | 15 |  |  |  |  | 32 |  | 
|  | 15 |  |  |  |  | 1335 |  | 
| 11 | 15 |  |  | 15 |  | 90 | no warnings 'experimental::signatures'; | 
|  | 15 |  |  |  |  | 35 |  | 
|  | 15 |  |  |  |  | 642 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 15 |  |  | 15 |  | 1068 | use parent 'Exporter'; | 
|  | 15 |  |  |  |  | 845 |  | 
|  | 15 |  |  |  |  | 104 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | our @EXPORT_OK = qw(parser); | 
| 16 |  |  |  |  |  |  | our $VERSION   = '0.07'; | 
| 17 |  |  |  |  |  |  |  | 
| 18 | 15 |  |  |  |  | 19160 | use constant Operators => { | 
| 19 |  |  |  |  |  |  | EQUALS             => 'eq', | 
| 20 |  |  |  |  |  |  | AND                => 'and', | 
| 21 |  |  |  |  |  |  | OR                 => 'or', | 
| 22 |  |  |  |  |  |  | GREATER_THAN       => 'gt', | 
| 23 |  |  |  |  |  |  | GREATER_THAN_EQUAL => 'ge', | 
| 24 |  |  |  |  |  |  | LESS_THAN          => 'lt', | 
| 25 |  |  |  |  |  |  | LESS_THAN_EQUAL    => 'le', | 
| 26 |  |  |  |  |  |  | LIKE               => 'like', | 
| 27 |  |  |  |  |  |  | IS_NULL            => 'is null', | 
| 28 |  |  |  |  |  |  | NOT_EQUAL          => 'ne', | 
| 29 | 15 |  |  | 15 |  | 1797 | }; | 
|  | 15 |  |  |  |  | 33 |  | 
| 30 |  |  |  |  |  |  |  | 
| 31 | 229 |  |  | 229 | 1 | 456 | sub predicate ($config) { | 
|  | 229 |  |  |  |  | 367 |  | 
|  | 229 |  |  |  |  | 324 |  | 
| 32 |  |  |  |  |  |  |  | 
| 33 | 229 |  | 100 |  |  | 532 | $config ||= {}; | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | my $this = { | 
| 36 |  |  |  |  |  |  | subject  => $config->{subject}, | 
| 37 |  |  |  |  |  |  | sub_type => $config->{sub_type}, | 
| 38 |  |  |  |  |  |  | value    => $config->{value}, | 
| 39 |  |  |  |  |  |  | val_type => $config->{val_type}, | 
| 40 |  |  |  |  |  |  | operator => ($config->{operator}) ? $config->{operator} : Operators->{EQUALS}, | 
| 41 | 229 | 100 |  |  |  | 1088 | }; | 
| 42 |  |  |  |  |  |  |  | 
| 43 | 229 | 100 | 100 |  |  | 1403 | if ( $this->{value} && $this->{value} =~ m{\A[0-9]+(?:\.[0-9]+)?\z} ) { | 
| 44 | 136 |  |  |  |  | 296 | $this->{val_type} = 'numeric'; | 
| 45 |  |  |  |  |  |  | } | 
| 46 |  |  |  |  |  |  |  | 
| 47 | 229 |  |  |  |  | 493 | return $this; | 
| 48 |  |  |  |  |  |  | } | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | sub parser { | 
| 51 | 173 |  |  | 173 | 1 | 14614 | state $order = [qw/parenthesis andor math op startsWith endsWith contains substringof/]; | 
| 52 | 173 |  |  |  |  | 481 | state $REGEX = { | 
| 53 |  |  |  |  |  |  | parenthesis => qr/^([(](.*)[)])$/x, | 
| 54 |  |  |  |  |  |  | andor       => qr/^(.*?) \s+ (or|and) \s+ (.*)$/x, | 
| 55 |  |  |  |  |  |  | math        => qr/\(? ([A-Za-z0-9\/\._]*) \s+ (mod|div|add|sub|mul) \s+ ([0-9]+(?:\.[0-9]+)? ) \)? \s+ (.*) /x, | 
| 56 |  |  |  |  |  |  | op          => qr/ | 
| 57 |  |  |  |  |  |  | ((?:(?:\b[A-Za-z]+\(.*?\)) | 
| 58 |  |  |  |  |  |  | | [A-Za-z0-9\/\._] | 
| 59 |  |  |  |  |  |  | | '.*?')*) | 
| 60 |  |  |  |  |  |  | \s+ | 
| 61 |  |  |  |  |  |  | (eq|gt|lt|ge|le|ne) | 
| 62 |  |  |  |  |  |  | \s+ | 
| 63 |  |  |  |  |  |  | (true|false|datetimeoffset'(.*)'|('.*')|(?:[0-9]+(?:\.[0-9]+)?)*) | 
| 64 |  |  |  |  |  |  | /x, | 
| 65 |  |  |  |  |  |  | startsWith  => qr/^startswith[(](.*), \s* '(.*)'[)]/x, | 
| 66 |  |  |  |  |  |  | endsWith    => qr/^endswith[(](.*), \s* '(.*)'[)]/x, | 
| 67 |  |  |  |  |  |  | contains    => qr/^contains[(](.*), \s* '(.*)'[)]/x, | 
| 68 |  |  |  |  |  |  | substringof => qr/^substringof[(]'(.*?)', \s* (.*)[)]/x, | 
| 69 |  |  |  |  |  |  | }; | 
| 70 |  |  |  |  |  |  |  | 
| 71 | 317 |  |  | 317 | 1 | 484 | sub parse_fragment ($filter) { | 
|  | 317 |  |  |  |  | 489 |  | 
|  | 317 |  |  |  |  | 509 |  | 
| 72 | 317 |  |  |  |  | 530 | my $found; | 
| 73 |  |  |  |  |  |  | my $obj; | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | KEY: | 
| 76 | 317 |  |  |  |  | 506 | for my $key ( @{$order} ) { | 
|  | 317 |  |  |  |  | 670 |  | 
| 77 | 1733 | 100 |  |  |  | 3301 | last KEY if $found; | 
| 78 |  |  |  |  |  |  |  | 
| 79 | 1494 |  |  |  |  | 2648 | my $regex = $REGEX->{$key}; | 
| 80 |  |  |  |  |  |  |  | 
| 81 | 1494 |  |  |  |  | 13208 | my @match = $filter =~ $regex; | 
| 82 |  |  |  |  |  |  |  | 
| 83 | 1494 | 100 |  |  |  | 4006 | if ( @match ) { | 
| 84 | 248 | 100 |  |  |  | 882 | if ( $key eq 'parenthesis' ) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 85 | 21 | 100 |  |  |  | 111 | if( index( $match[1], ')' ) < index( $match[1], '(' ) ) { | 
| 86 | 5 |  |  |  |  | 21 | next KEY; | 
| 87 |  |  |  |  |  |  | } | 
| 88 |  |  |  |  |  |  |  | 
| 89 | 16 |  |  |  |  | 63 | $obj = parse_fragment($match[1]); | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  | elsif ( $key eq 'math' ) { | 
| 92 | 24 |  |  |  |  | 95 | $obj = parse_fragment( $match[2] . ' ' . $match[3] ); | 
| 93 | 24 |  |  |  |  | 123 | $obj->{subject} = predicate({ | 
| 94 |  |  |  |  |  |  | subject  => $match[0], | 
| 95 |  |  |  |  |  |  | sub_type => 'field', | 
| 96 |  |  |  |  |  |  | operator => $match[1], | 
| 97 |  |  |  |  |  |  | value    => $match[2], | 
| 98 |  |  |  |  |  |  | val_type => 'string', | 
| 99 |  |  |  |  |  |  | }); | 
| 100 |  |  |  |  |  |  |  | 
| 101 | 24 | 50 |  |  |  | 94 | if ( ref $obj->{subject} ) { | 
| 102 | 24 |  |  |  |  | 60 | $obj->{sub_type} = undef; | 
| 103 |  |  |  |  |  |  | } | 
| 104 |  |  |  |  |  |  |  | 
| 105 | 24 | 50 |  |  |  | 63 | if ( ref $obj->{value} ) { | 
| 106 | 0 |  |  |  |  | 0 | $obj->{val_type} = undef; | 
| 107 |  |  |  |  |  |  | } | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  | elsif ( $key eq 'andor' ) { | 
| 110 | 15 |  |  |  |  | 58 | $obj = predicate({ | 
| 111 |  |  |  |  |  |  | subject  => parse_fragment( $match[0] ), | 
| 112 |  |  |  |  |  |  | operator => $match[1], | 
| 113 |  |  |  |  |  |  | value    => parse_fragment( $match[2] ), | 
| 114 |  |  |  |  |  |  | }); | 
| 115 |  |  |  |  |  |  |  | 
| 116 | 15 | 50 |  |  |  | 65 | if ( !ref $obj->{subject} ) { | 
| 117 | 0 |  |  |  |  | 0 | $obj->{sub_type} = 'field'; | 
| 118 |  |  |  |  |  |  | } | 
| 119 |  |  |  |  |  |  |  | 
| 120 | 15 | 50 |  |  |  | 48 | if ( !ref $obj->{value} ) { | 
| 121 | 0 |  |  |  |  | 0 | $obj->{val_type} = 'field'; | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  | } | 
| 124 |  |  |  |  |  |  | elsif ( $key eq 'op' ) { | 
| 125 | 174 |  |  |  |  | 888 | $obj = predicate({ | 
| 126 |  |  |  |  |  |  | subject  => $match[0], | 
| 127 |  |  |  |  |  |  | sub_type => 'field', | 
| 128 |  |  |  |  |  |  | operator => $match[1], | 
| 129 |  |  |  |  |  |  | value    => $match[2], | 
| 130 |  |  |  |  |  |  | }); | 
| 131 |  |  |  |  |  |  |  | 
| 132 | 174 | 100 |  |  |  | 835 | if ( $match[0] =~ m{\(.*?\)} ) { | 
| 133 | 75 |  |  |  |  | 250 | $obj->{subject}  = parse_fragment( $match[0] ); | 
| 134 | 75 |  |  |  |  | 256 | $obj->{sub_type} = undef; | 
| 135 |  |  |  |  |  |  | } | 
| 136 |  |  |  |  |  |  |  | 
| 137 | 174 | 100 |  |  |  | 966 | if ( $match[2] =~ m{\A'.*?'\z} ) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | #$obj->{value}    = $1; | 
| 139 | 37 |  |  |  |  | 89 | $obj->{val_type} = 'string'; | 
| 140 |  |  |  |  |  |  | } | 
| 141 |  |  |  |  |  |  | elsif ( $match[2] eq 'true' | $match[2] eq 'false' ) { | 
| 142 | 12 |  |  |  |  | 25 | $obj->{val_type} = 'bool'; | 
| 143 |  |  |  |  |  |  | } | 
| 144 |  |  |  |  |  |  | elsif ( $match[2] =~ m{\A[0-9]+(?:\.[0-9]+)?\z} ) { | 
| 145 | 125 |  |  |  |  | 278 | $obj->{val_type} = 'numeric'; | 
| 146 |  |  |  |  |  |  | } | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | #if(typeof obj.value === 'string') { | 
| 149 |  |  |  |  |  |  | #    var quoted = obj.value.match(/^'(.*)'$/); | 
| 150 |  |  |  |  |  |  | #    var m = obj.value.match(/^datetimeoffset'(.*)'$/); | 
| 151 |  |  |  |  |  |  | #    if(quoted && quoted.length > 1) { | 
| 152 |  |  |  |  |  |  | #        obj.value = quoted[1]; | 
| 153 |  |  |  |  |  |  | #    } else if(m && m.length > 1) { | 
| 154 |  |  |  |  |  |  | #        obj.value = new Date(m[1]); | 
| 155 |  |  |  |  |  |  | #    } | 
| 156 |  |  |  |  |  |  | #} | 
| 157 |  |  |  |  |  |  | } | 
| 158 |  |  |  |  |  |  | # ( $key eq 'startsWith' || $key eq 'endsWith' || $key eq 'contains' || $key eq 'substringof' ) { | 
| 159 |  |  |  |  |  |  | else { | 
| 160 | 14 | 100 |  |  |  | 115 | $obj = predicate({ | 
|  |  | 100 |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | subject  => $match[0], | 
| 162 |  |  |  |  |  |  | sub_type => ( $key eq 'substringof' ? 'string' : 'field' ), | 
| 163 |  |  |  |  |  |  | operator => $key, | 
| 164 |  |  |  |  |  |  | value    => $match[1], | 
| 165 |  |  |  |  |  |  | val_type => ( $key eq 'substringof' ? 'field' : 'string' ), | 
| 166 |  |  |  |  |  |  | }); | 
| 167 |  |  |  |  |  |  | } | 
| 168 |  |  |  |  |  |  |  | 
| 169 | 243 |  |  |  |  | 985 | $found++; | 
| 170 |  |  |  |  |  |  | } | 
| 171 |  |  |  |  |  |  | } | 
| 172 |  |  |  |  |  |  |  | 
| 173 | 317 |  |  |  |  | 876 | return $obj; | 
| 174 |  |  |  |  |  |  | } | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | return | 
| 177 | 175 |  |  | 175 |  | 251 | sub ($filter_string) { | 
|  | 175 |  |  |  |  | 308 |  | 
|  | 175 |  |  |  |  | 324 |  | 
| 178 |  |  |  |  |  |  |  | 
| 179 | 175 | 100 |  |  |  | 444 | return if !defined $filter_string; | 
| 180 |  |  |  |  |  |  |  | 
| 181 | 174 |  |  |  |  | 565 | $filter_string =~ s{\A\s+}{}; | 
| 182 | 174 |  |  |  |  | 736 | $filter_string =~ s{\s+\z}{}; | 
| 183 |  |  |  |  |  |  |  | 
| 184 | 174 | 100 |  |  |  | 456 | return if $filter_string eq ''; | 
| 185 | 172 |  |  |  |  | 378 | return parse_fragment($filter_string); | 
| 186 | 173 |  |  |  |  | 802 | }; | 
| 187 |  |  |  |  |  |  | } | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | 1; | 
| 190 |  |  |  |  |  |  |  | 
| 191 |  |  |  |  |  |  | __END__ |