[Bast-commits] r3909 - in DBIx-Class/0.08/trunk: . lib/DBIx/Class/Storage/DBI/ODBC t

[semifor at dev.catalyst.perl.org]

Author: semifor
Date: 2008-01-02 22:24:23 +0000 (Wed, 02 Jan 2008)
New Revision: 3909

Added:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
   DBIx-Class/0.08/trunk/t/746mssql.t
Modified:
   DBIx-Class/0.08/trunk/Changes
   DBIx-Class/0.08/trunk/t/746db2_400.t
Log:
Added Storage::DBI subclass for MSSQL auto PK over ODBC.


Modified: DBIx-Class/0.08/trunk/Changes
===================================================================
--- DBIx-Class/0.08/trunk/Changes	2008-01-02 20:52:13 UTC (rev 3908)
+++ DBIx-Class/0.08/trunk/Changes	2008-01-02 22:24:23 UTC (rev 3909)
@@ -1,5 +1,6 @@
 Revision history for DBIx::Class
 
+        - Added Storage::DBI subclass for MSSQL over ODBC. 
         - Added freeze, thaw and dclone methods to Schema so that thawed
           objects will get re-attached to the schema.
         - Moved dbicadmin to JSON::Any wrapped JSON.pm for a sane API

Added: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm	                        (rev 0)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm	2008-01-02 22:24:23 UTC (rev 3909)
@@ -0,0 +1,76 @@
+package DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server;
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+sub _prep_for_execute {
+    my $self = shift;
+    my ($op, $extra_bind, $ident, $args) = @_;
+
+    my ($sql, $bind) = $self->SUPER::_prep_for_execute(@_);
+    $sql .= ';SELECT SCOPE_IDENTITY()' if $op eq 'insert';
+
+    return ($sql, $bind);
+}
+
+sub insert {
+    my ($self, $source, $to_insert) = @_;
+
+    my $bind_attributes = $self->source_bind_attributes($source);
+    my (undef, $sth) = $self->_execute( 'insert' => [], $source, $bind_attributes, $to_insert);
+    $self->{_scope_identity} = $sth->fetchrow_array;
+
+    return $to_insert;
+}
+
+sub last_insert_id { shift->{_scope_identity} }
+
+sub sqlt_type { 'SQLServer' }
+
+sub _sql_maker_opts {
+    my ( $self, $opts ) = @_;
+
+    if ( $opts ) {
+        $self->{_sql_maker_opts} = { %$opts };
+    }
+
+    return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} };
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::Class::Storage::ODBC::Microsoft_SQL_Server - Support specific to
+Microsoft SQL Server over ODBC
+
+=head1 DESCRIPTION
+
+This class implements support specific to Microsoft SQL Server over ODBC,
+including auto-increment primary keys and SQL::Abstract::Limit dialect.  It
+is loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it
+detects a MSSQL back-end.
+
+=head1 IMPLEMENTATION NOTES
+
+Microsoft SQL Server supports three methods of retrieving the IDENTITY
+value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
+SCOPE_IDENTITY is used here because it is the safest.  However, it must
+be called is the same execute statement, not just the same connection.
+
+So, this implementation appends a SELECT SCOPE_IDENTITY() statement
+onto each INSERT to accommodate that requirement.
+
+
+=head1 AUTHORS
+
+Marc Mims C<< <marc at questright.com> >>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut

Modified: DBIx-Class/0.08/trunk/t/746db2_400.t
===================================================================
--- DBIx-Class/0.08/trunk/t/746db2_400.t	2008-01-02 20:52:13 UTC (rev 3908)
+++ DBIx-Class/0.08/trunk/t/746db2_400.t	2008-01-02 22:24:23 UTC (rev 3909)
@@ -21,7 +21,7 @@
 
 my $dbh = $schema->storage->dbh;
 
-$dbh->do("DROP TABLE artist", { RaiseError => 0, PrintError => 0 });
+eval { $dbh->do("DROP TABLE artist") };
 
 $dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10))");
 

Added: DBIx-Class/0.08/trunk/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/trunk/t/746mssql.t	                        (rev 0)
+++ DBIx-Class/0.08/trunk/t/746mssql.t	2008-01-02 22:24:23 UTC (rev 3909)
@@ -0,0 +1,63 @@
+use strict;
+use warnings;  
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
+
+plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
+  unless ($dsn && $user);
+
+plan tests => 12;
+
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1});
+
+$schema->storage->ensure_connected;
+isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
+
+my $dbh = $schema->storage->dbh;
+
+eval { $dbh->do("DROP TABLE artist") };
+
+    $dbh->do(<<'');
+CREATE TABLE artist (
+   artistid INT IDENTITY NOT NULL,
+   name VARCHAR(255),
+   charfield CHAR(10),
+   primary key(artistid)
+)
+
+my %seen_id;
+
+# test primary key handling
+my $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" );
+
+
+# clean up our mess
+END {
+    $dbh->do('DROP TABLE artist') if $dbh;
+}
+