[Bast-commits] r7573 - in DBIx-Class/0.08/branches: .
disregard_this_branch/lib/DBIx/Class/Storage
disregard_this_branch/lib/DBIx/Class/Storage/DBI
disregard_this_branch/t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Sat Sep 5 08:56:23 GMT 2009
Author: ribasushi
Date: 2009-09-05 08:56:23 +0000 (Sat, 05 Sep 2009)
New Revision: 7573
Added:
DBIx-Class/0.08/branches/disregard_this_branch/
Modified:
DBIx-Class/0.08/branches/disregard_this_branch/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/disregard_this_branch/lib/DBIx/Class/Storage/DBI/MSSQL.pm
DBIx-Class/0.08/branches/disregard_this_branch/t/746mssql.t
Log:
WTF branch
Copied: DBIx-Class/0.08/branches/disregard_this_branch (from rev 7571, DBIx-Class/0.08/trunk)
Modified: DBIx-Class/0.08/branches/disregard_this_branch/lib/DBIx/Class/Storage/DBI/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-09-04 19:49:54 UTC (rev 7571)
+++ DBIx-Class/0.08/branches/disregard_this_branch/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-09-05 08:56:23 UTC (rev 7573)
@@ -16,29 +16,9 @@
sub insert_bulk {
my $self = shift;
- my ($source, $cols, $data) = @_;
- my $identity_insert = 0;
-
- COLUMNS:
- foreach my $col (@{$cols}) {
- if ($source->column_info($col)->{is_auto_increment}) {
- $identity_insert = 1;
- last COLUMNS;
- }
- }
-
- if ($identity_insert) {
- my $table = $source->from;
- $self->_get_dbh->do("SET IDENTITY_INSERT $table ON");
- }
-
$self->next::method(@_);
- if ($identity_insert) {
- my $table = $source->from;
- $self->_get_dbh->do("SET IDENTITY_INSERT $table OFF");
- }
}
# support MSSQL GUID column types
Modified: DBIx-Class/0.08/branches/disregard_this_branch/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2009-09-04 19:49:54 UTC (rev 7571)
+++ DBIx-Class/0.08/branches/disregard_this_branch/lib/DBIx/Class/Storage/DBI.pm 2009-09-05 08:56:23 UTC (rev 7573)
@@ -1312,65 +1312,10 @@
goto $self->can('insert_bulk');
}
- my %colvalues;
- my $table = $source->from;
- @colvalues{@$cols} = (0..$#$cols);
- my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
+ Carp::Clan::cluck ('This is where we are');
- $self->_query_start( $sql, @bind );
- my $sth = $self->sth($sql);
+ die 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx';
-# @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
-
- ## This must be an arrayref, else nothing works!
- my $tuple_status = [];
-
- ## Get the bind_attributes, if any exist
- my $bind_attributes = $self->source_bind_attributes($source);
-
- ## Bind the values and execute
- my $placeholder_index = 1;
-
- foreach my $bound (@bind) {
-
- my $attributes = {};
- my ($column_name, $data_index) = @$bound;
-
- if( $bind_attributes ) {
- $attributes = $bind_attributes->{$column_name}
- if defined $bind_attributes->{$column_name};
- }
-
- my @data = map { $_->[$data_index] } @$data;
-
- $sth->bind_param_array( $placeholder_index, [@data], $attributes );
- $placeholder_index++;
- }
- my $rv = eval { $sth->execute_array({ArrayTupleStatus => $tuple_status}) };
- if (my $err = $@) {
- my $i = 0;
- ++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i];
-
- $self->throw_exception($sth->errstr || "Unexpected populate error: $err")
- if ($i > $#$tuple_status);
-
- require Data::Dumper;
- local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Indent = 1;
- local $Data::Dumper::Useqq = 1;
- local $Data::Dumper::Quotekeys = 0;
-
- $self->throw_exception(sprintf "%s for populate slice:\n%s",
- $tuple_status->[$i][1],
- Data::Dumper::Dumper(
- { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) }
- ),
- );
- }
- $self->throw_exception($sth->errstr) if !$rv;
-
- $self->_query_end( $sql, @bind );
- return (wantarray ? ($rv, $sth, @bind) : $rv);
}
sub update {
Modified: DBIx-Class/0.08/branches/disregard_this_branch/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/trunk/t/746mssql.t 2009-09-04 19:49:54 UTC (rev 7571)
+++ DBIx-Class/0.08/branches/disregard_this_branch/t/746mssql.t 2009-09-05 08:56:23 UTC (rev 7573)
@@ -12,172 +12,13 @@
plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 39;
-
-DBICTest::Schema->load_classes('ArtistGUID');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
-{
- no warnings 'redefine';
- my $connect_count = 0;
- my $orig_connect = \&DBI::connect;
- local *DBI::connect = sub { $connect_count++; goto &$orig_connect };
-
- $schema->storage->ensure_connected;
-
- is( $connect_count, 1, 'only one connection made');
-}
-
+$schema->storage->ensure_connected;
isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
$schema->storage->dbh_do (sub {
my ($storage, $dbh) = @_;
- eval { $dbh->do("DROP TABLE artist") };
- $dbh->do(<<'SQL');
-CREATE TABLE artist (
- artistid INT IDENTITY NOT NULL,
- name VARCHAR(100),
- rank INT NOT NULL DEFAULT '13',
- charfield CHAR(10) NULL,
- primary key(artistid)
-)
-SQL
-});
-
-my %seen_id;
-
-my @opts = (
- { on_connect_call => 'use_dynamic_cursors' },
- {},
-);
-my $new;
-
-# test Auto-PK with different options
-for my $opts (@opts) {
- SKIP: {
- $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
-
- eval {
- $schema->storage->ensure_connected
- };
- if ($@ =~ /dynamic cursors/) {
- skip
-'Dynamic Cursors not functional, tds_version 8.0 or greater required if using'.
-' FreeTDS', 1;
- }
-
- $schema->resultset('Artist')->search({ name => 'foo' })->delete;
-
- $new = $schema->resultset('Artist')->create({ name => 'foo' });
-
- ok($new->artistid > 0, "Auto-PK worked");
- }
-}
-
-$seen_id{$new->artistid}++;
-
-# test LIMIT support
-for (1..6) {
- $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
- is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
- $seen_id{$new->artistid}++;
-}
-
-my $it = $schema->resultset('Artist')->search( {}, {
- rows => 3,
- order_by => 'artistid',
-});
-
-is( $it->count, 3, "LIMIT count ok" );
-is( $it->next->name, "foo", "iterator->next ok" );
-$it->next;
-is( $it->next->name, "Artist 2", "iterator->next ok" );
-is( $it->next, undef, "next past end of resultset ok" );
-
-# test GUID columns
-
-$schema->storage->dbh_do (sub {
- my ($storage, $dbh) = @_;
- eval { $dbh->do("DROP TABLE artist") };
- $dbh->do(<<'SQL');
-CREATE TABLE artist (
- artistid UNIQUEIDENTIFIER NOT NULL,
- name VARCHAR(100),
- rank INT NOT NULL DEFAULT '13',
- charfield CHAR(10) NULL,
- a_guid UNIQUEIDENTIFIER,
- primary key(artistid)
-)
-SQL
-});
-
-# start disconnected to make sure insert works on an un-reblessed storage
-$schema = DBICTest::Schema->connect($dsn, $user, $pass);
-
-my $row;
-lives_ok {
- $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
-} 'created a row with a GUID';
-
-ok(
- eval { $row->artistid },
- 'row has GUID PK col populated',
-);
-diag $@ if $@;
-
-ok(
- eval { $row->a_guid },
- 'row has a GUID col with auto_nextval populated',
-);
-diag $@ if $@;
-
-my $row_from_db = $schema->resultset('ArtistGUID')
- ->search({ name => 'mtfnpy' })->first;
-
-is $row_from_db->artistid, $row->artistid,
- 'PK GUID round trip';
-
-is $row_from_db->a_guid, $row->a_guid,
- 'NON-PK GUID round trip';
-
-# test MONEY type
-$schema->storage->dbh_do (sub {
- my ($storage, $dbh) = @_;
- eval { $dbh->do("DROP TABLE money_test") };
- $dbh->do(<<'SQL');
-
-CREATE TABLE money_test (
- id INT IDENTITY PRIMARY KEY,
- amount MONEY NULL
-)
-
-SQL
-
-});
-
-my $rs = $schema->resultset('Money');
-
-lives_ok {
- $row = $rs->create({ amount => 100 });
-} 'inserted a money value';
-
-cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
-
-lives_ok {
- $row->update({ amount => 200 });
-} 'updated a money value';
-
-cmp_ok $rs->find($row->id)->amount, '==', 200,
- 'updated money value round-trip';
-
-lives_ok {
- $row->update({ amount => undef });
-} 'updated a money value to NULL';
-
-is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip';
-
-$schema->storage->dbh_do (sub {
- my ($storage, $dbh) = @_;
eval { $dbh->do("DROP TABLE Owners") };
eval { $dbh->do("DROP TABLE Books") };
$dbh->do(<<'SQL');
@@ -241,102 +82,4 @@
]);
}, 'populate without PKs supplied ok' );
-#
-# try a prefetch on tables with identically named columns
-#
-
-# set quote char - make sure things work while quoted
-$schema->storage->_sql_maker->{quote_char} = [qw/[ ]/];
-$schema->storage->_sql_maker->{name_sep} = '.';
-
-{
- # try a ->has_many direction
- my $owners = $schema->resultset ('Owners')->search ({
- 'books.id' => { '!=', undef }
- }, {
- prefetch => 'books',
- order_by => 'name',
- rows => 3, # 8 results total
- });
-
- is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
- is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
-
- TODO: {
- local $TODO = 'limit past end of resultset problem';
- is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
- is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
- is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
-
- # make sure count does not become overly complex
- is_same_sql_bind (
- $owners->page(3)->count_rs->as_query,
- '(
- SELECT COUNT( * )
- FROM (
- SELECT TOP 3 [me].[id]
- FROM [owners] [me]
- LEFT JOIN [books] [books] ON [books].[owner] = [me].[id]
- WHERE ( [books].[id] IS NOT NULL )
- GROUP BY [me].[id]
- ORDER BY [me].[id] DESC
- ) [count_subq]
- )',
- [],
- );
- }
-
- # try a ->belongs_to direction (no select collapse, group_by should work)
- my $books = $schema->resultset ('BooksInLibrary')->search ({
- 'owner.name' => [qw/wiggle woggle/],
- }, {
- distinct => 1,
- prefetch => 'owner',
- rows => 2, # 3 results total
- order_by => { -desc => 'owner' },
- # there is no sane way to order by the right side of a grouped prefetch currently :(
- #order_by => { -desc => 'owner.name' },
- });
-
-
- is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
- is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
-
- TODO: {
- local $TODO = 'limit past end of resultset problem';
- is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
- is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
- is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
-
- # make sure count does not become overly complex (FIXME - the distinct-induced group_by is incorrect)
- is_same_sql_bind (
- $books->page(2)->count_rs->as_query,
- '(
- SELECT COUNT( * )
- FROM (
- SELECT TOP 2 [me].[id]
- FROM [books] [me]
- JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
- WHERE ( ( ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ? ) )
- GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
- ORDER BY [me].[id] DESC
- ) [count_subq]
- )',
- [
- [ 'owner.name' => 'wiggle' ],
- [ 'owner.name' => 'woggle' ],
- [ 'source' => 'Library' ],
- ],
- );
- }
-
-}
-
-# clean up our mess
-END {
- if (my $dbh = eval { $schema->storage->_dbh }) {
- eval { $dbh->do("DROP TABLE $_") }
- for qw/artist money_test Books Owners/;
- }
-}
-# vim:sw=2 sts=2
+done_testing;
More information about the Bast-commits
mailing list