line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# the contents of this file are Copyright (c) 2009 Daniel Norman |
2
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
3
|
|
|
|
|
|
|
# modify it under the terms of the GNU General Public License as |
4
|
|
|
|
|
|
|
# published by the Free Software Foundation. |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
########################################### |
7
|
|
|
|
|
|
|
package DBR::Query::Part::Subquery; |
8
|
18
|
|
|
18
|
|
99
|
use strict; |
|
18
|
|
|
|
|
35
|
|
|
18
|
|
|
|
|
825
|
|
9
|
18
|
|
|
18
|
|
97
|
use base 'DBR::Query::Part'; |
|
18
|
|
|
|
|
34
|
|
|
18
|
|
|
|
|
1652
|
|
10
|
18
|
|
|
18
|
|
584
|
use Carp; |
|
18
|
|
|
|
|
48
|
|
|
18
|
|
|
|
|
13344
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub new{ |
13
|
1
|
|
|
1
|
0
|
3
|
my( $package ) = shift; |
14
|
1
|
|
|
|
|
4
|
my ($field,$query,$runflag) = @_; |
15
|
|
|
|
|
|
|
|
16
|
1
|
50
|
|
|
|
8
|
croak('first argument must be a Field object') unless ref($field) =~ /^DBR::Config::Field/; # Could be ::Anon |
17
|
1
|
50
|
|
|
|
9
|
croak('second argument must be a Select object') unless ref($query) eq 'DBR::Query::Select'; |
18
|
|
|
|
|
|
|
|
19
|
1
|
|
|
|
|
6
|
my $sqfield = $query->fields->[0]; |
20
|
1
|
|
|
|
|
15
|
my $self = [ $field, $query, $runflag, ! $sqfield->is_numeric ]; |
21
|
|
|
|
|
|
|
|
22
|
1
|
|
|
|
|
5
|
bless( $self, $package ); |
23
|
1
|
|
|
|
|
8
|
return $self; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
0
|
|
|
0
|
0
|
0
|
sub type { return 'SUBQUERY' }; |
27
|
1
|
|
|
1
|
0
|
6
|
sub field { return $_[0]->[0] } |
28
|
1
|
|
|
1
|
0
|
30
|
sub query { return $_[0]->[1] } |
29
|
1
|
|
|
1
|
0
|
5
|
sub runflag { return $_[0]->[2] } |
30
|
0
|
|
|
0
|
0
|
0
|
sub quoted { return $_[0]->[3] } |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub sql { |
33
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
34
|
1
|
50
|
|
|
|
5
|
my $conn = shift or croak 'conn is required'; |
35
|
|
|
|
|
|
|
|
36
|
1
|
50
|
|
|
|
5
|
if ( $self->runflag ){ |
37
|
0
|
|
|
|
|
0
|
my $sth = $self->query->run(); |
38
|
0
|
|
|
|
|
0
|
$sth->execute; |
39
|
|
|
|
|
|
|
|
40
|
0
|
|
|
|
|
0
|
my ($val,@list); |
41
|
|
|
|
|
|
|
|
42
|
0
|
0
|
|
|
|
0
|
$sth->bind_col(1, \$val) || die "Failed to bind column"; |
43
|
0
|
|
|
|
|
0
|
push @list, $val while $sth->fetch; |
44
|
|
|
|
|
|
|
|
45
|
0
|
|
|
|
|
0
|
$sth->finish; |
46
|
|
|
|
|
|
|
|
47
|
0
|
0
|
|
|
|
0
|
return '0' unless @list; # HACK - this should abort the query this feeds into, but this will patch the bug for now |
48
|
|
|
|
|
|
|
|
49
|
0
|
0
|
|
|
|
0
|
if( $self->quoted ){ |
50
|
0
|
|
|
|
|
0
|
return $self->field->sql($_[1]) . ' IN (' . join(',', map { $conn->quote( $_ ) } @list ) . ')'; |
|
0
|
|
|
|
|
0
|
|
51
|
|
|
|
|
|
|
}else{ |
52
|
0
|
|
|
|
|
0
|
return $self->field->sql($_[1]) . ' IN (' . join(',', @list ) . ')'; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
}else{ |
55
|
1
|
|
|
|
|
6
|
return $self->field->sql($_[1]) . ' IN (' . $self->query->sql($_[1]) . ')' |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
1
|
|
|
1
|
|
4
|
sub _validate_self{ 1 } |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
0
|
0
|
|
sub is_emptyset { $_[0]->query->where->is_emptyset } |
62
|
|
|
|
|
|
|
1; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
########################################### |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
1; |