From: Rafael Kitover Date: Fri, 24 Jul 2009 05:28:11 +0000 (+0000) Subject: moved code to ::DBI::MSSQL and added DT inflation test X-Git-Tag: v0.08109~47^2~28 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5a77aa8ba52c50bdc4291ca22433f9c315234ad2;p=dbsrgits%2FDBIx-Class.git moved code to ::DBI::MSSQL and added DT inflation test --- diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index 3a1f868..fe51f1b 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -6,14 +6,88 @@ use warnings; use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/; use mro 'c3'; +use List::Util(); + __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL'); -sub _dbh_last_insert_id { - my ($self, $dbh, $source, $col) = @_; - my ($id) = $dbh->selectrow_array('SELECT SCOPE_IDENTITY()'); - return $id; +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->dbh->do("SET IDENTITY_INSERT $table ON"); + } + + $self->next::method(@_); + + if ($identity_insert) { + my $table = $source->from; + $self->dbh->do("SET IDENTITY_INSERT $table OFF"); + } +} + +sub _prep_for_execute { + my $self = shift; + my ($op, $extra_bind, $ident, $args) = @_; + +# cast MONEY values properly + if ($op eq 'insert' || $op eq 'update') { + my $fields = $args->[0]; + my $col_info = $self->_resolve_column_info($ident, [keys %$fields]); + + for my $col (keys %$fields) { + if ($col_info->{$col}{data_type} =~ /^money\z/i) { + my $val = $fields->{$col}; + $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]]; + } + } + } + + my ($sql, $bind) = $self->next::method (@_); + + if ($op eq 'insert') { + $sql .= ';SELECT SCOPE_IDENTITY()'; + + 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"; + } + } + + return ($sql, $bind); +} + +sub _execute { + my $self = shift; + my ($op) = @_; + + my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_); + if ($op eq 'insert') { + $self->{_scope_identity} = $sth->fetchrow_array; + $sth->finish; + } + + return wantarray ? ($rv, $sth, @bind) : $rv; } + +sub last_insert_id { shift->{_scope_identity} } + sub build_datetime_parser { my $self = shift; my $type = "DateTime::Format::Strptime"; @@ -25,49 +99,41 @@ sub build_datetime_parser { sub sqlt_type { 'SQLServer' } sub _sql_maker_opts { - my ( $self, $opts ) = @_; + my ( $self, $opts ) = @_; - if ( $opts ) { - $self->{_sql_maker_opts} = { %$opts }; - } + if ( $opts ) { + $self->{_sql_maker_opts} = { %$opts }; + } - return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} }; + return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} }; } 1; =head1 NAME -DBIx::Class::Storage::DBI::MSSQL - Storage::DBI subclass for MSSQL +DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support +in DBIx::Class =head1 SYNOPSIS -This subclass supports MSSQL, and can in theory be used directly -via the C mechanism: - - $schema->storage_type('::DBI::MSSQL'); - $schema->connect_info('dbi:....', ...); - -However, as there is no L, you will probably want to use -one of the other DBD-specific MSSQL classes, such as -L. These classes will -merge this class with a DBD-specific class to obtain fully -correct behavior for your scenario. - -=head1 METHODS - -=head2 last_insert_id +This is the base class for Microsoft SQL Server support, used by +L and +L. -=head2 sqlt_type +=head1 IMPLEMENTATION NOTES -=head2 build_datetime_parser +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. -The resulting parser handles the MSSQL C type, but is almost -certainly not sufficient for the other MSSQL 2008 date/time types. +So, this implementation appends a SELECT SCOPE_IDENTITY() statement +onto each INSERT to accommodate that requirement. -=head1 AUTHORS +=head1 AUTHOR -Brian Cassidy +See L. =head1 LICENSE diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm index 48f281b..7e495c9 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -5,85 +5,6 @@ use warnings; use base qw/DBIx::Class::Storage::DBI::MSSQL/; use mro 'c3'; -use List::Util(); - -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->dbh->do("SET IDENTITY_INSERT $table ON"); - } - - $self->next::method(@_); - - if ($identity_insert) { - my $table = $source->from; - $self->dbh->do("SET IDENTITY_INSERT $table OFF"); - } -} - -sub _prep_for_execute { - my $self = shift; - my ($op, $extra_bind, $ident, $args) = @_; - -# cast MONEY values properly - if ($op eq 'insert' || $op eq 'update') { - my $fields = $args->[0]; - my $col_info = $self->_resolve_column_info($ident, [keys %$fields]); - - for my $col (keys %$fields) { - if ($col_info->{$col}{data_type} =~ /^money\z/i) { - my $val = $fields->{$col}; - $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]]; - } - } - } - - my ($sql, $bind) = $self->next::method (@_); - - if ($op eq 'insert') { - $sql .= ';SELECT SCOPE_IDENTITY()'; - - 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"; - } - } - - return ($sql, $bind); -} - -sub _execute { - my $self = shift; - my ($op) = @_; - - my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_); - if ($op eq 'insert') { - $self->{_scope_identity} = $sth->fetchrow_array; - $sth->finish; - } - - return wantarray ? ($rv, $sth, @bind) : $rv; -} - -sub last_insert_id { shift->{_scope_identity} } - 1; __END__ @@ -95,24 +16,16 @@ 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. +This class implements support specific to Microsoft SQL Server over ODBC. It is +loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it detects a +MSSQL back-end. -So, this implementation appends a SELECT SCOPE_IDENTITY() statement -onto each INSERT to accommodate that requirement. +Most of the functionality is provided from the superclass +L. -=head1 AUTHORS +=head1 AUTHOR -Marc Mims C<< >> +See L. =head1 LICENSE diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm index 600db7a..27cda34 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm @@ -5,7 +5,7 @@ use warnings; use base qw/ DBIx::Class::Storage::DBI::Sybase::Base - DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server + DBIx::Class::Storage::DBI::MSSQL /; use mro 'c3'; @@ -13,8 +13,8 @@ use mro 'c3'; =head1 NAME -DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server - Storage::DBI subclass for MSSQL via -DBD::Sybase +DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server - Support for Microsoft +SQL Server via DBD::Sybase =head1 SYNOPSIS @@ -29,11 +29,9 @@ into the SQL query itself, without using bind placeholders. More importantly this means that caching of prepared statements is explicitly disabled, as the interpolation renders it useless. -=head1 AUTHORS +=head1 AUTHOR -Brandon L Black - -Justin Hunter +See L. =head1 LICENSE diff --git a/t/inflate/datetime_mssql.t b/t/inflate/datetime_mssql.t new file mode 100644 index 0000000..5d4c5a5 --- /dev/null +++ b/t/inflate/datetime_mssql.t @@ -0,0 +1,80 @@ +use strict; +use warnings; + +use Test::More; +use Test::Exception; +use lib qw(t/lib); +use DBICTest; + +my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/}; + +if (not ($dsn && $user)) { + plan skip_all => + 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test' . + "\nWarning: This test drops and creates a table called 'track'"; +} else { + eval "use DateTime; use DateTime::Format::Strptime;"; + if ($@) { + plan skip_all => 'needs DateTime and DateTime::Format::Strptime for testing'; + } + else { + plan tests => 4 * 2; # (tests * dt_types) + } +} + +my $schema = DBICTest::Schema->clone; + +$schema->connection($dsn, $user, $pass); +$schema->storage->ensure_connected; + +my @dt_types = ( + ['DATETIME', { + year => 2004, + month => 8, + day => 21, + hour => 14, + minute => 36, + second => 48, + nanosecond => 500000000, + }], + ['SMALLDATETIME', { # minute precision + year => 2004, + month => 8, + day => 21, + hour => 14, + minute => 36, + }], +); + +for my $dt_type (@dt_types) { + my ($type, $sample_dt) = @$dt_type; + + eval { $schema->storage->dbh->do("DROP TABLE track") }; + $schema->storage->dbh->do(<<"SQL"); +CREATE TABLE track ( + trackid INT IDENTITY PRIMARY KEY, + cd INT, + position INT, + last_updated_on $type, +) +SQL + ok(my $dt = DateTime->new($sample_dt)); + + my $row; + ok( $row = $schema->resultset('Track')->create({ + last_updated_on => $dt, + cd => 1, + })); + ok( $row = $schema->resultset('Track') + ->search({ trackid => $row->trackid }, { select => ['last_updated_on'] }) + ->first + ); + is( $row->updated_date, $dt, 'DateTime roundtrip' ); +} + +# clean up our mess +END { + if (my $dbh = eval { $schema->storage->_dbh }) { + $dbh->do('DROP TABLE track'); + } +}