Merge pull request #57 from sixapart/feature-for-sub-query-by-prepared-statement3

search method and SQL clauses now accept SQL objects recursively

Author: jamadam

cpanfile

@@ -22,6 +22,7 @@ on develop => sub {
 
 on test => sub {
     requires 'version';
+    requires 'Tie::IxHash';
 };
 
 feature 'test_sqlite', 'Test SQLite' => sub {

lib/Data/ObjectDriver/Driver/DBI.pm

@@ -12,6 +12,7 @@ use Data::ObjectDriver::Errors;
 use Data::ObjectDriver::SQL;
 use Data::ObjectDriver::Driver::DBD;
 use Data::ObjectDriver::Iterator;
+use Scalar::Util 'blessed';
 
 my $ForkSafe = _is_fork_safe();
 my %Handles;
@@ -172,27 +173,33 @@ sub prepare_fetch {
 
 sub fetch {
     my $driver = shift;
-    my($rec, $class, $orig_terms, $orig_args) = @_;
+    my ($rec, $class, $terms_or_stmt, $orig_args) = @_;
+    my ($sql, $stmt);
 
     if ($Data::ObjectDriver::RESTRICT_IO) {
         use Data::Dumper;
-        die "Attempted DBI I/O while in restricted mode: fetch() " . Dumper($orig_terms, $orig_args);
+        die "Attempted DBI I/O while in restricted mode: fetch() " . Dumper($terms_or_stmt, $orig_args);
     }
 
-    my ($sql, $bind, $stmt) = $driver->prepare_fetch($class, $orig_terms, $orig_args);
+    if (blessed($terms_or_stmt) && $terms_or_stmt->isa('Data::ObjectDriver::SQL')) {
+        $sql  = $terms_or_stmt->as_sql;
+        $stmt = $terms_or_stmt;
+    } else {
+        ($sql, undef, $stmt) = $driver->prepare_fetch($class, $terms_or_stmt, $orig_args);
+    }
 
-    my @bind;
+    my @columns;
     my $map = $stmt->select_map;
     for my $col (@{ $stmt->select }) {
-        push @bind, \$rec->{ $map->{$col} };
+        push @columns, \$rec->{ $map->{$col} };
     }
 
     my $dbh = $driver->r_handle($class->properties->{db});
     $driver->start_query($sql, $stmt->{bind});
 
     my $sth = $orig_args->{no_cached_prepare} ? $dbh->prepare($sql) : $driver->_prepare_cached($dbh, $sql);
     $sth->execute(@{ $stmt->{bind} });
-    $sth->bind_columns(undef, @bind);
+    $sth->bind_columns(undef, @columns);
 
     # need to slurp 'offset' rows for DBs that cannot do it themselves
     if (!$driver->dbd->offset_implemented && $orig_args->{offset}) {
@@ -218,11 +225,11 @@ sub load_object_from_rec {
 }
 
 sub search {
-    my($driver) = shift;
-    my($class, $terms, $args) = @_;
+    my ($driver) = shift;
+    my ($class, $terms_or_stmt, $args) = @_;
 
     my $rec = {};
-    my $sth = $driver->fetch($rec, $class, $terms, $args);
+    my $sth = $driver->fetch($rec, $class, $terms_or_stmt, $args);
 
     my $iter = sub {
         ## This is kind of a hack--we need $driver to stay in scope,

lib/Data/ObjectDriver/SQL.pm

@@ -3,14 +3,15 @@
 package Data::ObjectDriver::SQL;
 use strict;
 use warnings;
+use Scalar::Util 'blessed';
 
 use base qw( Class::Accessor::Fast );
 
 __PACKAGE__->mk_accessors(qw(
     select distinct select_map select_map_reverse
     from joins where bind limit offset group order
     having where_values column_mutator index_hint
-    comment
+    comment as
 ));
 
 sub new {
@@ -33,10 +34,16 @@ sub new {
 sub add_select {
     my $stmt = shift;
     my($term, $col) = @_;
-    $col ||= $term;
     push @{ $stmt->select }, $term;
-    $stmt->select_map->{$term} = $col;
-    $stmt->select_map_reverse->{$col} = $term;
+    if (blessed($term) && $term->isa('Data::ObjectDriver::SQL')) {
+        my $alias = $col || $term->as || $term->as_sql;
+        $stmt->select_map->{$term} = $alias;
+        $stmt->select_map_reverse->{$alias} = $term;
+    } else {
+        $col ||= $term;
+        $stmt->select_map->{$term} = $col;
+        $stmt->select_map_reverse->{$col} = $term;
+    }
 }
 
 sub add_join {
@@ -60,12 +67,26 @@ sub add_index_hint {
 sub as_sql {
     my $stmt = shift;
     my $sql = '';
+    my @bind_for_select;
+
     if (@{ $stmt->select }) {
         $sql .= 'SELECT ';
         $sql .= 'DISTINCT ' if $stmt->distinct;
+        my $select_map = $stmt->select_map;
         $sql .= join(', ',  map {
-            my $alias = $stmt->select_map->{$_};
-            $alias && /(?:^|\.)\Q$alias\E$/ ? $_ : "$_ $alias";
+            my $col = $_;
+            my $alias = $select_map->{$col};
+            if (blessed($col) && $col->isa('Data::ObjectDriver::SQL')) {
+                push @bind_for_select, @{ $col->{bind} };
+                @{ $col->{bind} } = ();
+                $col->as_subquery($alias);
+            } else {
+                if ($alias) {
+                    /(?:^|\.)\Q$alias\E$/ ? $col : "$col $alias";
+                } else {
+                    $col;
+                }
+            }
         } @{ $stmt->select }) . "\n";
     }
     $sql .= 'FROM ';
@@ -91,8 +112,19 @@ sub as_sql {
         $sql .= ', ' if @from;
     }
 
+    my @bind_for_from;
+
     if (@from) {
-        $sql .= join ', ', map { $stmt->_add_index_hint($_) } @from;
+        $sql .= join ', ', map {
+            my $from = $_;
+            if (blessed($from) && $from->isa('Data::ObjectDriver::SQL')) {
+                push @bind_for_from, @{$from->{bind}};
+                @{$from->{bind}} = ();
+                $from->as_subquery;
+            } else {
+                $stmt->_add_index_hint($from);
+            }
+        } @from;
     }
 
     $sql .= "\n";
@@ -107,9 +139,22 @@ sub as_sql {
     if ($comment && $comment =~ /([ 0-9a-zA-Z.:;()_#&,]+)/) {
         $sql .= "-- $1" if $1;
     }
+
+    @{ $stmt->{bind} } = (@bind_for_select, @bind_for_from, @{ $stmt->{bind} });
+
     return $sql;
 }
 
+sub as_subquery {
+    my ($stmt, $alias) = @_;
+    my $subquery = '(' . $stmt->as_sql . ')';
+    $alias ||= $stmt->as;
+    if ($alias) {
+        $subquery .= ' AS ' . $alias;
+    }
+    $subquery;
+}
+
 sub as_limit {
     my $stmt = shift;
     my $n = $stmt->limit or
@@ -231,7 +276,11 @@ sub add_having {
 #    Carp::croak("Invalid/unsafe column name $col") unless $col =~ /^[\w\.]+$/;
 
     if (my $orig = $stmt->select_map_reverse->{$col}) {
-        $col = $orig;
+        if (blessed($orig) && $orig->isa('Data::ObjectDriver::SQL')) {
+            # do nothins
+        } else {
+            $col = $orig;
+        }
     }
 
     my($term, $bind) = $stmt->_mk_term($col, $val);
@@ -281,12 +330,17 @@ sub _mk_term {
             $term = "$c $op ? AND ?";
             push @bind, @{$val->{value}};
         } else {
-            if (ref $val->{value} eq 'SCALAR') {
-                $term = "$c $val->{op} " . ${$val->{value}};
+            my $value = $val->{value};
+            if (ref $value eq 'SCALAR') {
+                $term = "$c $val->{op} " . $$value;
+            } elsif (blessed($value) && $value->isa('Data::ObjectDriver::SQL')) {
+                local $value->{as} = undef;
+                $term = "$c $val->{op} ". $value->as_subquery;
+                push @bind, @{$value->{bind}};
             } else {
                 $term = "$c $val->{op} ?";
                 $term .= $stmt->as_escape($val->{escape}) if $val->{escape} && $op =~ /^(?:NOT\s+)?I?LIKE$/;
-                push @bind, $val->{value};
+                push @bind, $value;
             }
         }
     } elsif (ref($val) eq 'SCALAR') {