[Bast-commits] r6868 - in DBIx-Class/0.08/branches/mssql_top_fixes:
lib/DBIx/Class lib/DBIx/Class/Storage
lib/DBIx/Class/Storage/DBI/ODBC t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Tue Jun 30 07:53:28 GMT 2009
Author: ribasushi
Date: 2009-06-30 07:53:27 +0000 (Tue, 30 Jun 2009)
New Revision: 6868
Modified:
DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks.pm
DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/mssql_top_fixes/t/746mssql.t
Log:
Some fixes after review
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/ResultSet.pm 2009-06-30 01:39:51 UTC (rev 6867)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/ResultSet.pm 2009-06-30 07:53:27 UTC (rev 6868)
@@ -1257,8 +1257,11 @@
# this is so that ordering can be thrown away in things like Top limit
$sub_attrs->{-for_count_only} = 1;
+ my $sub_rs = $rsrc->resultset_class->new ($rsrc, $sub_attrs);
$attrs->{from} = [{
- count_subq => $rsrc->resultset_class->new ($rsrc, $sub_attrs )->as_query
+ -alias => 'count_subq',
+ -source_handle => $rsrc->handle,
+ count_subq => $sub_rs->as_query,
}];
# the subquery replaces this
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks.pm 2009-06-30 01:39:51 UTC (rev 6867)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/SQLAHacks.pm 2009-06-30 07:53:27 UTC (rev 6868)
@@ -213,7 +213,7 @@
my $req_order = $order->{order_by};
my $limit_order =
- scalar $self->_order_by_chunks ($req_order) # exaime normalized version, collapses nesting
+ scalar $self->_order_by_chunks ($req_order) # examine normalized version, collapses nesting
? $req_order
: $order->{_virtual_order_by}
;
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2009-06-30 01:39:51 UTC (rev 6867)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2009-06-30 07:53:27 UTC (rev 6868)
@@ -3,6 +3,7 @@
use warnings;
use base qw/DBIx::Class::Storage::DBI::MSSQL/;
+use List::Util();
sub insert_bulk {
my ($self, $source, $cols, $data) = @_;
@@ -17,23 +18,17 @@
}
}
- my $table = $source->from;
if ($identity_insert) {
- $source->storage->dbh_do(sub {
- my ($storage, $dbh, @cols) = @_;
- $dbh->do("SET IDENTITY_INSERT $table ON;");
- });
+ my $table = $source->from;
+ $self->dbh->do("SET IDENTITY_INSERT $table ON");
}
next::method(@_);
if ($identity_insert) {
- $source->storage->dbh_do(sub {
- my ($storage, $dbh, @cols) = @_;
- $dbh->do("SET IDENTITY_INSERT $table OFF;");
- });
+ my $table = $source->from;
+ $self->dbh->do("SET IDENTITY_INSERT $table OFF");
}
-
}
sub _prep_for_execute {
@@ -41,23 +36,20 @@
my ($op, $extra_bind, $ident, $args) = @_;
my ($sql, $bind) = $self->next::method (@_);
- $sql .= ';SELECT SCOPE_IDENTITY()' if $op eq 'insert';
- my %identity_insert_tables;
- my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
+ if ($op eq 'insert') {
+ $sql .= ';SELECT SCOPE_IDENTITY()';
- foreach my $bound (@{$bind}) {
- my $col = $bound->[0];
- if ($col_info->{$col}->{is_auto_increment}) {
- my $table = $col_info->{$col}->{-result_source}->from;
- $identity_insert_tables{$table} = 1;
+ my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
+ if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
+
+ my $table = $ident->from;
+ my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
+ my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
+ $sql = "$identity_insert_on; $sql; $identity_insert_off";
}
}
- my $identity_insert_on = join '', map { "SET IDENTITY_INSERT $_ ON; " } keys %identity_insert_tables;
- my $identity_insert_off = join '', map { "SET IDENTITY_INSERT $_ OFF; " } keys %identity_insert_tables;
- $sql = "$identity_insert_on $sql $identity_insert_off";
-
return ($sql, $bind);
}
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm 2009-06-30 01:39:51 UTC (rev 6867)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/lib/DBIx/Class/Storage/DBI.pm 2009-06-30 07:53:27 UTC (rev 6868)
@@ -1238,7 +1238,7 @@
where => $where,
};
- my $alias2source = $self->_resolve_ident_sources ($ident);
+ my ($alias2source, $root_alias) = $self->_resolve_ident_sources ($ident);
# calculate bind_attrs before possible $ident mangling
my $bind_attrs = {};
@@ -1250,7 +1250,7 @@
$bind_attrs->{$fqcn} = $bindtypes->{$col} if $bindtypes->{$col};
# so that unqualified searches can be bound too
- $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq 'me';
+ $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq $root_alias;
}
}
@@ -1432,10 +1432,17 @@
);
# put it in the new {from}
- unshift @outer_from, { $alias => $subq };
+ unshift @outer_from, {
+ -alias => $alias,
+ -source_handle => $select_root->{-source_handle},
+ $alias => $subq,
+ };
# This is totally horrific - the $where ends up in both the inner and outer query
- # Unfortunately not much can be done until SQLA2 introspection arrives
+ # Unfortunately not much can be done until SQLA2 introspection arrives, and even
+ # then if where conditions apply to the *right* side of the prefetch, you may have
+ # to both filter the inner select (e.g. to apply a limit) and then have to re-filter
+ # the outer select to exclude joins you didin't want in the first place
#
# OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
return (\@outer_from, $select, $where, $attrs);
@@ -1445,12 +1452,14 @@
my ($self, $ident) = @_;
my $alias2source = {};
+ my $root_alias;
# the reason this is so contrived is that $ident may be a {from}
# structure, specifying multiple tables to join
if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
# this is compat mode for insert/update/delete which do not deal with aliases
$alias2source->{me} = $ident;
+ $root_alias = 'me';
}
elsif (ref $ident eq 'ARRAY') {
@@ -1458,6 +1467,7 @@
my $tabinfo;
if (ref $_ eq 'HASH') {
$tabinfo = $_;
+ $root_alias = $tabinfo->{-alias};
}
if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
$tabinfo = $_->[0];
@@ -1468,7 +1478,7 @@
}
}
- return $alias2source;
+ return ($alias2source, $root_alias);
}
# Takes $ident, \@column_names
@@ -1480,17 +1490,18 @@
# my $col_sources = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
sub _resolve_column_info {
my ($self, $ident, $colnames) = @_;
- my $alias2src = $self->_resolve_ident_sources($ident);
+ my ($alias2src, $root_alias) = $self->_resolve_ident_sources($ident);
my $sep = $self->_sql_maker_opts->{name_sep} || '.';
$sep = "\Q$sep\E";
- my %return;
- foreach my $col (@{$colnames}) {
- $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x;
+ my (%return, %converted);
+ foreach my $col (@$colnames) {
+ my ($alias, $colname) = $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x;
- my $alias = $1 || 'me';
- my $colname = $2;
+ # deal with unqualified cols - we assume the main alias for all
+ # unqualified ones, ugly but can't think of anything better right now
+ $alias ||= $root_alias;
my $rsrc = $alias2src->{$alias};
$return{$col} = $rsrc && { %{$rsrc->column_info($colname)}, -result_source => $rsrc };
Modified: DBIx-Class/0.08/branches/mssql_top_fixes/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/branches/mssql_top_fixes/t/746mssql.t 2009-06-30 01:39:51 UTC (rev 6867)
+++ DBIx-Class/0.08/branches/mssql_top_fixes/t/746mssql.t 2009-06-30 07:53:27 UTC (rev 6868)
@@ -2,6 +2,7 @@
use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
use DBIC::SqlMakerTest;
@@ -11,7 +12,7 @@
plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 25;
+plan tests => 27;
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -97,42 +98,47 @@
SQL
});
-$schema->populate ('Owners', [
- [qw/id name /],
- [qw/1 wiggle/],
- [qw/2 woggle/],
- [qw/3 boggle/],
- [qw/4 fREW/],
- [qw/5 fRIOUX/],
- [qw/6 fROOH/],
- [qw/7 fRUE/],
- [qw/8 fISMBoC/],
- [qw/9 station/],
- [qw/10 mirror/],
- [qw/11 dimly/],
- [qw/12 face_to_face/],
- [qw/13 icarus/],
- [qw/14 dream/],
- [qw/15 dyrstyggyr/],
-]);
-$schema->populate ('BooksInLibrary', [
- [qw/source owner title /],
- [qw/Library 1 secrets0/],
- [qw/Library 1 secrets1/],
- [qw/Eatery 1 secrets2/],
- [qw/Library 2 secrets3/],
- [qw/Library 3 secrets4/],
- [qw/Eatery 3 secrets5/],
- [qw/Library 4 secrets6/],
- [qw/Library 5 secrets7/],
- [qw/Eatery 5 secrets8/],
- [qw/Library 6 secrets9/],
- [qw/Library 7 secrets10/],
- [qw/Eatery 7 secrets11/],
- [qw/Library 8 secrets12/],
-]);
+lives_ok ( sub {
+ $schema->populate ('Owners', [
+ [qw/id name /],
+ [qw/1 wiggle/],
+ [qw/2 woggle/],
+ [qw/3 boggle/],
+ [qw/4 fREW/],
+ [qw/5 fRIOUX/],
+ [qw/6 fROOH/],
+ [qw/7 fRUE/],
+ [qw/8 fISMBoC/],
+ [qw/9 station/],
+ [qw/10 mirror/],
+ [qw/11 dimly/],
+ [qw/12 face_to_face/],
+ [qw/13 icarus/],
+ [qw/14 dream/],
+ [qw/15 dyrstyggyr/],
+ ]);
+}, 'populate with PKs supplied ok' );
+lives_ok ( sub {
+ $schema->populate ('BooksInLibrary', [
+ [qw/source owner title /],
+ [qw/Library 1 secrets0/],
+ [qw/Library 1 secrets1/],
+ [qw/Eatery 1 secrets2/],
+ [qw/Library 2 secrets3/],
+ [qw/Library 3 secrets4/],
+ [qw/Eatery 3 secrets5/],
+ [qw/Library 4 secrets6/],
+ [qw/Library 5 secrets7/],
+ [qw/Eatery 5 secrets8/],
+ [qw/Library 6 secrets9/],
+ [qw/Library 7 secrets10/],
+ [qw/Eatery 7 secrets11/],
+ [qw/Library 8 secrets12/],
+ ]);
+}, 'populate without PKs supplied ok' );
+
#
# try a prefetch on tables with identically named columns
#
@@ -142,7 +148,7 @@
$schema->storage->_sql_maker->{name_sep} = '.';
{
- # try a ->has_many direction (group_by is not possible on has_many with limit)
+ # try a ->has_many direction
my $owners = $schema->resultset ('Owners')->search ({
'books.id' => { '!=', undef }
}, {
More information about the Bast-commits
mailing list