File Coverage

blib/lib/DBR/Query/Part/Subquery.pm
Criterion Covered Total %
statement 25 39 64.1
branch 4 14 28.5
condition n/a
subroutine 9 12 75.0
pod 0 8 0.0
total 38 73 52.0


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;