line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package UR::BoolExpr::Template::PropertyComparison::Like; |
3
|
|
|
|
|
|
|
|
4
|
266
|
|
|
266
|
|
15196
|
use strict; |
|
266
|
|
|
|
|
341
|
|
|
266
|
|
|
|
|
6322
|
|
5
|
266
|
|
|
266
|
|
840
|
use warnings; |
|
266
|
|
|
|
|
295
|
|
|
266
|
|
|
|
|
5733
|
|
6
|
266
|
|
|
266
|
|
1207
|
use UR; |
|
266
|
|
|
|
|
337
|
|
|
266
|
|
|
|
|
1094
|
|
7
|
|
|
|
|
|
|
our $VERSION = "0.46"; # UR $VERSION; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
UR::Object::Type->define( |
10
|
|
|
|
|
|
|
class_name => __PACKAGE__, |
11
|
|
|
|
|
|
|
is => ['UR::BoolExpr::Template::PropertyComparison'], |
12
|
|
|
|
|
|
|
); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub _compare { |
15
|
14
|
|
|
14
|
|
20
|
my ($class,$comparison_value,@property_value) = @_; |
16
|
14
|
50
|
|
|
|
39
|
return '' unless defined ($comparison_value); # property like NULL should always be false |
17
|
14
|
|
|
|
|
16
|
my $escape = '\\'; |
18
|
14
|
|
|
|
|
35
|
my $regex = $class-> |
19
|
|
|
|
|
|
|
comparison_value_and_escape_character_to_regex( |
20
|
|
|
|
|
|
|
$comparison_value, |
21
|
|
|
|
|
|
|
$escape |
22
|
|
|
|
|
|
|
); |
23
|
266
|
|
|
266
|
|
23430
|
no warnings 'uninitialized'; |
|
266
|
|
|
|
|
379
|
|
|
266
|
|
|
|
|
18937
|
|
24
|
14
|
|
|
|
|
20
|
foreach my $value ( @property_value ) { |
25
|
14
|
100
|
|
|
|
86
|
return 1 if $value =~ $regex; |
26
|
|
|
|
|
|
|
} |
27
|
10
|
|
|
|
|
34
|
return ''; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
1; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=pod |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 NAME |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
UR::BoolExpr::Template::PropertyComparison::Like - perform an SQL-ish like test |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 DESCRIPTION |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
The input test value is assummed to be an SQL 'like' value, where '_' |
41
|
|
|
|
|
|
|
represents a one character wildcard, and '%' means a 0 or more character |
42
|
|
|
|
|
|
|
wildcard. It gets converted to a perl regular expression and used to match |
43
|
|
|
|
|
|
|
against an object's properties. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
If the property returns multiple values, this comparison returns true if any of the values |
46
|
|
|
|
|
|
|
match. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=cut |
50
|
|
|
|
|
|
|
|