[Bast-commits] r5442 - in DBIx-Class/0.08/branches/subquery: lib/DBIx/Class lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI t t/resultset

robkinyon at dev.catalyst.perl.org robkinyon at dev.catalyst.perl.org
Tue Feb 10 20:10:10 GMT 2009


Author: robkinyon
Date: 2009-02-10 20:10:10 +0000 (Tue, 10 Feb 2009)
New Revision: 5442

Added:
   DBIx-Class/0.08/branches/subquery/t/resultset/
   DBIx-Class/0.08/branches/subquery/t/resultset/as_query.t
Modified:
   DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSet.pm
   DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Storage/DBI/Cursor.pm
Log:
Added as_query to ResultSet with a couple tests

Modified: DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSet.pm	2009-02-10 13:57:34 UTC (rev 5441)
+++ DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSet.pm	2009-02-10 20:10:10 UTC (rev 5442)
@@ -1709,6 +1709,14 @@
   return \%unaliased;
 }
 
+=head2 as_query
+
+Returns the SQL query and bind vars associated with the invocant.
+
+=cut
+
+sub as_query { return shift->cursor->as_query }
+
 =head2 find_or_new
 
 =over 4

Modified: DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Storage/DBI/Cursor.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Storage/DBI/Cursor.pm	2009-02-10 13:57:34 UTC (rev 5441)
+++ DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Storage/DBI/Cursor.pm	2009-02-10 20:10:10 UTC (rev 5442)
@@ -49,6 +49,24 @@
   return bless ($new, $class);
 }
 
+=head2 as_query
+
+Returns the SQL statement and bind vars associated with the invocant.
+
+=cut
+
+sub as_query {
+  my $self = shift;
+
+  my $storage = $self->{storage};
+  my $sql_maker = $storage->sql_maker;
+  local $sql_maker->{for};
+
+  my @args = $storage->_select_args(@{$self->{args}});
+  my ($sql, $bind)  = $storage->_prep_for_execute(@args[0 .. 2], [@args[4 .. $#args]]);
+  return [ $sql, @$bind ];
+}
+
 =head2 next
 
 =over 4

Modified: DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Storage/DBI.pm	2009-02-10 13:57:34 UTC (rev 5441)
+++ DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Storage/DBI.pm	2009-02-10 20:10:10 UTC (rev 5442)
@@ -1135,11 +1135,15 @@
 sub _prep_for_execute {
   my ($self, $op, $extra_bind, $ident, $args) = @_;
 
+  if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
+    $ident = $ident->from();
+  }
+
   my ($sql, @bind) = $self->sql_maker->$op($ident, @$args);
+
   unshift(@bind,
     map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind)
       if $extra_bind;
-
   return ($sql, \@bind);
 }
 
@@ -1181,10 +1185,6 @@
 sub _dbh_execute {
   my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
   
-  if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
-    $ident = $ident->from();
-  }
-
   my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
 
   $self->_query_start( $sql, @$bind );
@@ -1319,6 +1319,13 @@
 }
 
 sub _select {
+  my $self = shift;
+  my $sql_maker = $self->sql_maker;
+  local $sql_maker->{for};
+  return $self->_execute($self->_select_args(@_));
+}
+
+sub _select_args {
   my ($self, $ident, $select, $condition, $attrs) = @_;
   my $order = $attrs->{order_by};
 
@@ -1355,7 +1362,7 @@
     push @args, $attrs->{rows}, $attrs->{offset};
   }
 
-  return $self->_execute(@args);
+  return @args;
 }
 
 sub source_bind_attributes {

Added: DBIx-Class/0.08/branches/subquery/t/resultset/as_query.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/resultset/as_query.t	                        (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/resultset/as_query.t	2009-02-10 20:10:10 UTC (rev 5442)
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 6;
+
+my $schema	= DBICTest->init_schema();
+my $art_rs	= $schema->resultset('Artist');
+
+{
+  my $arr = $art_rs->as_query;
+  my ($query, @bind) = @$arr;
+
+  is( $query, "SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me" );
+  is_deeply( \@bind, [] );
+}
+
+$art_rs = $art_rs->search({ name => 'Billy Joel' });
+
+{
+  my $arr = $art_rs->as_query;
+  my ($query, @bind) = @$arr;
+
+  is( $query, "SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me WHERE ( name = ? )" );
+  is_deeply( \@bind, [ [ name => 'Billy Joel' ] ] );
+}
+
+$art_rs = $art_rs->search({ rank => 2 });
+
+{
+  my $arr = $art_rs->as_query;
+  my ($query, @bind) = @$arr;
+
+  is( $query, "SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me WHERE ( ( ( rank = ? ) AND ( name = ? ) ) )" );
+  is_deeply( \@bind, [ [ rank => 2 ], [ name => 'Billy Joel' ] ] );
+}
+
+__END__




More information about the Bast-commits mailing list