line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Bio::ConnectDots::DotQuery::Constraint; |
2
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
242
|
|
3
|
1
|
|
|
1
|
|
7
|
use vars qw(@ISA @AUTO_ATTRIBUTES @OTHER_ATTRIBUTES %SYNONYMS %DEFAULTS); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
97
|
|
4
|
1
|
|
|
1
|
|
5
|
use Class::AutoClass; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
5
|
1
|
|
|
1
|
|
5
|
use Bio::ConnectDots::Util; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
287
|
|
6
|
1
|
|
|
1
|
|
6
|
use Bio::ConnectDots::Parser; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
7
|
1
|
|
|
1
|
|
1636
|
use Bio::ConnectDots::DotQuery::Term; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
1662
|
|
8
|
|
|
|
|
|
|
@ISA = qw(Class::AutoClass); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
@AUTO_ATTRIBUTES=qw(_term _op constants); |
11
|
|
|
|
|
|
|
%SYNONYMS=(); |
12
|
|
|
|
|
|
|
@OTHER_ATTRIBUTES=qw(term op ct_alias cs_alias labels label_ids termlist); |
13
|
|
|
|
|
|
|
%DEFAULTS=(_op=>'='); |
14
|
|
|
|
|
|
|
Class::AutoClass::declare(__PACKAGE__); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# legal formats: |
17
|
|
|
|
|
|
|
# 1) Old ConnectorTable format: ARRAY or HASH of |
18
|
|
|
|
|
|
|
# column =>[label], [label constant] or [label op constant] |
19
|
|
|
|
|
|
|
# NOTE: Old ConnectorSet format NOT supported, because it conflicts with |
20
|
|
|
|
|
|
|
# new ARRAY of output strings |
21
|
|
|
|
|
|
|
# 2) single query string which may include multiple constraints AND'ed together |
22
|
|
|
|
|
|
|
# 3) single Constraint object |
23
|
|
|
|
|
|
|
# 4) ARRAY of (1) query strings and (2) Constraint objects |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub parse { |
26
|
0
|
|
|
0
|
0
|
|
my($class,$constraints)=@_; |
27
|
0
|
|
|
|
|
|
my $parsed=[]; |
28
|
0
|
|
|
|
|
|
my $parser=new Bio::ConnectDots::Parser; |
29
|
|
|
|
|
|
|
# ARRAY is old form if even number of elements, element 0 is scalar, element 1 is ARRAY |
30
|
0
|
0
|
0
|
|
|
|
if (('ARRAY' eq ref $constraints) && @$constraints && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
31
|
|
|
|
|
|
|
@$constraints%2==0 && !ref $constraints->[0] && 'ARRAY' eq ref $constraints->[1]) { |
32
|
0
|
|
|
|
|
|
my $hash; |
33
|
0
|
|
|
|
|
|
while(@$constraints) { |
34
|
0
|
|
|
|
|
|
my($column,$constraint)=(shift @$constraints,shift @$constraints); |
35
|
0
|
|
0
|
|
|
|
my $constraint_list=$hash->{$column} || ($hash->{$column}=[]); |
36
|
0
|
|
|
|
|
|
push(@$constraint_list,$constraint); |
37
|
|
|
|
|
|
|
} |
38
|
0
|
|
|
|
|
|
$constraints=$hash; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
# HASH is always old form. Old form ARRAY turned into HASH in 'if' above |
41
|
|
|
|
|
|
|
# Note 'if' -- not 'elsif' |
42
|
0
|
0
|
|
|
|
|
if ('HASH' eq ref $constraints) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
43
|
0
|
|
|
|
|
|
while (my($column,$constraint_list)=each %$constraints) { |
44
|
0
|
0
|
|
|
|
|
$constraint_list=[$constraint_list] unless 'ARRAY' eq ref $constraint_list->[0]; |
45
|
0
|
|
|
|
|
|
for my $constraint (@$constraint_list) { |
46
|
0
|
|
|
|
|
|
my($labels,$op,$constant); |
47
|
0
|
0
|
0
|
|
|
|
$class->throw("Illegal constraint format ".value_as_string($constraint). |
48
|
|
|
|
|
|
|
": must have 1-3 elements") |
49
|
|
|
|
|
|
|
unless @$constraint && @$constraint<=3; |
50
|
0
|
0
|
|
|
|
|
($labels)=@$constraint if @$constraint==1; |
51
|
0
|
0
|
|
|
|
|
($labels,$constant)=@$constraint if @$constraint==2; |
52
|
0
|
0
|
|
|
|
|
($labels,$op,$constant)=@$constraint if @$constraint==3; |
53
|
0
|
|
|
|
|
|
$constant=$parser->parse_constant_value($constant); # handle constant lists |
54
|
0
|
|
|
|
|
|
push(@$parsed, |
55
|
|
|
|
|
|
|
$class->new(-termlist=>[$column,$labels],-op=>$op,-constant=>$constant)); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
} elsif (!ref $constraints) { # string |
59
|
0
|
|
|
|
|
|
push(@$parsed,$class->parse_string($constraints,$parser)); |
60
|
|
|
|
|
|
|
} elsif (UNIVERSAL::isa($constraints,__PACKAGE__)) { |
61
|
0
|
|
|
|
|
|
push(@$parsed,$constraints); |
62
|
|
|
|
|
|
|
} elsif ('ARRAY' eq ref $constraints) { # new form ARRAY |
63
|
0
|
|
|
|
|
|
for my $constraint (@$constraints) { |
64
|
0
|
0
|
|
|
|
|
if (!ref $ $constraint) { |
|
|
0
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
push(@$parsed,$class->parse_string($constraint,$parser)); |
66
|
|
|
|
|
|
|
} elsif (UNIVERSAL::isa($constraint,__PACKAGE__)) { |
67
|
0
|
|
|
|
|
|
push(@$parsed,$constraint); |
68
|
|
|
|
|
|
|
} else { |
69
|
0
|
|
|
|
|
|
$class->throw("llegal constraint format ".value_as_string($constraint). |
70
|
|
|
|
|
|
|
": must be string or Constraint object to appear in new ARRAY format"); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
} else { |
74
|
0
|
|
|
|
|
|
$class->throw("Unrecognized constraint form ".value_as_string($constraints). |
75
|
|
|
|
|
|
|
": strange type! Not scalar, Constraint object, ARRAY, or HASH"); |
76
|
|
|
|
|
|
|
} |
77
|
0
|
0
|
|
|
|
|
wantarray? @$parsed: $parsed |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
sub parse_string { |
80
|
0
|
|
|
0
|
0
|
|
my($class,$constraints,$parser)=@_; |
81
|
0
|
|
|
|
|
|
my $parsed=[]; |
82
|
0
|
|
|
|
|
|
my $parsed_constraints=$parser->parse_constraints($constraints); |
83
|
0
|
0
|
|
|
|
|
if ($parsed_constraints) { |
84
|
0
|
|
|
|
|
|
for my $constraint (@$parsed_constraints) { |
85
|
0
|
|
|
|
|
|
my($term,$op,$constant)=@$constraint{qw(term op constant)}; |
86
|
0
|
|
|
|
|
|
push(@$parsed, |
87
|
|
|
|
|
|
|
$class->new(-termlist=>$term,-op=>$op,-constants=>$constant)); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
} |
90
|
0
|
0
|
|
|
|
|
wantarray? @$parsed: $parsed; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub normalize { |
94
|
0
|
|
|
0
|
0
|
|
my($self)=@_; |
95
|
0
|
|
|
|
|
|
$self->term->normalize; |
96
|
0
|
|
|
|
|
|
my $op=$self->op; |
97
|
0
|
|
|
|
|
|
my $constants=$self->constants; |
98
|
0
|
0
|
|
|
|
|
$op or $op=$constants? '=': 'EXISTS'; |
|
|
0
|
|
|
|
|
|
99
|
|
|
|
|
|
|
|
100
|
0
|
0
|
|
|
|
|
if ('ARRAY' eq ref $constants) { |
|
|
0
|
|
|
|
|
|
101
|
0
|
|
|
|
|
|
$self->throw("Invalid constraint".$self->as_string.": nested list constants are not supported") |
102
|
0
|
0
|
|
|
|
|
if grep {'ARRAY' eq ref $_} @$constants; |
103
|
0
|
0
|
|
|
|
|
$self->throw("Invalid constraint".$self->as_string.": empty list constants are not supported") |
104
|
|
|
|
|
|
|
unless @$constants; |
105
|
|
|
|
|
|
|
# normalize ops with list constants |
106
|
0
|
0
|
|
|
|
|
if ($op eq '=') { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
$self->op('IN'); |
108
|
|
|
|
|
|
|
} elsif ($op eq "!=") { |
109
|
0
|
|
|
|
|
|
$self->op('NOT IN'); |
110
|
|
|
|
|
|
|
} elsif ($op=~/) { # range op: just compare to end of range |
111
|
0
|
|
|
|
|
|
my $max=maxb(@$constants); # does numeric or alpha max as appropriate |
112
|
0
|
|
|
|
|
|
$self->constants([$max]); |
113
|
|
|
|
|
|
|
} elsif ($op=~/>/) { # range op: just compare to end of range |
114
|
0
|
|
|
|
|
|
my $min=minb(@$constants); # does numeric or alpha min as appropriate |
115
|
0
|
|
|
|
|
|
$self->constants([$min]); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} elsif (!ref $constants) { # change single value to list |
118
|
0
|
0
|
0
|
|
|
|
$self->throw("Invalid constraint".$self->as_string.": no constant provided") |
119
|
|
|
|
|
|
|
unless $op eq 'EXISTS' || defined $constants; |
120
|
0
|
|
|
|
|
|
$constants=$self->constants([$constants]); |
121
|
|
|
|
|
|
|
} else { |
122
|
0
|
|
|
|
|
|
$self->throw("Invalid constraint".$self->as_string.": strange type!"); |
123
|
|
|
|
|
|
|
} |
124
|
0
|
|
|
|
|
|
$self; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub term { |
128
|
0
|
|
|
0
|
0
|
|
my $self=shift @_; |
129
|
0
|
0
|
|
|
|
|
my $term=@_? $self->_term($_[0]): $self->_term; |
130
|
0
|
0
|
|
|
|
|
$term or $term=$self->_term(new Bio::ConnectDots::DotQuery::Term); |
131
|
0
|
|
|
|
|
|
$term; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
sub op { |
134
|
0
|
|
|
0
|
0
|
|
my $self=shift @_; |
135
|
0
|
0
|
|
|
|
|
my $op=@_? $self->_op($_[0]): $self->_op; |
136
|
0
|
0
|
|
|
|
|
$op or $op='='; |
137
|
0
|
|
|
|
|
|
$op; |
138
|
|
|
|
|
|
|
} |
139
|
0
|
|
|
0
|
0
|
|
sub cs {$_[0]->term->cs;} |
140
|
0
|
|
|
0
|
0
|
|
sub cs_id {$_[0]->term->cs_id;} |
141
|
0
|
|
|
0
|
0
|
|
sub cs_name {$_[0]->term->cs_name;} |
142
|
|
|
|
|
|
|
sub column { |
143
|
0
|
|
|
0
|
0
|
|
my $self=shift @_; |
144
|
0
|
0
|
|
|
|
|
my $column=@_? $self->term->column($_[0]): $self->term->column; |
145
|
0
|
|
|
|
|
|
$column; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
sub labels { |
148
|
0
|
|
|
0
|
0
|
|
my $self=shift @_; |
149
|
0
|
0
|
|
|
|
|
my $labels=@_? $self->term->labels($_[0]): $self->term->labels; |
150
|
0
|
|
|
|
|
|
$labels; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
sub label_ids { |
153
|
0
|
|
|
0
|
0
|
|
my $self=shift @_; |
154
|
0
|
0
|
|
|
|
|
my $label_ids=@_? $self->term->label_ids($_[0]): $self->term->label_ids; |
155
|
0
|
|
|
|
|
|
$label_ids; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
sub termlist { |
158
|
0
|
|
|
0
|
0
|
|
my $self=shift @_; |
159
|
0
|
0
|
|
|
|
|
my $termlist=@_? $self->term->termlist($_[0]): $self->term->termlist; |
160
|
0
|
|
|
|
|
|
$termlist; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
sub as_string { |
163
|
0
|
|
|
0
|
0
|
|
my($self)=@_; |
164
|
0
|
|
|
|
|
|
my $term=$self->term->as_string; |
165
|
0
|
|
|
|
|
|
my $op=$self->op; |
166
|
0
|
|
|
|
|
|
my $constants=value_as_string($self->constants); |
167
|
0
|
|
|
|
|
|
return "$term $op $constants"; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
1; |
171
|
|
|
|
|
|
|
|