From: Rafael Kitover Date: Sun, 6 Feb 2011 20:22:34 +0000 (-0500) Subject: Multiple code/test/doc improvements for MSSQL over DBD::ADO X-Git-Tag: v0.08191~89 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=56dca25f0e1582928ba897df4e1cf44c9710d4f2;p=dbsrgits%2FDBIx-Class.git Multiple code/test/doc improvements for MSSQL over DBD::ADO --- diff --git a/Changes b/Changes index ddeda06..3656835 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,7 @@ Revision history for DBIx::Class * New Features / Changes - Add quote_names connection option. When set to true automatically sets quote_char and name_sep appropriate for your RDBMS + - IC::DateTime support for MSSQL over DBD::ADO * Fixes - Disable mysql_auto_reconnect for MySQL - depending on the ENV diff --git a/lib/DBIx/Class/Optional/Dependencies.pm b/lib/DBIx/Class/Optional/Dependencies.pm index 082ce79..fbb19e3 100644 --- a/lib/DBIx/Class/Optional/Dependencies.pm +++ b/lib/DBIx/Class/Optional/Dependencies.pm @@ -54,6 +54,9 @@ my $rdbms_mssql_odbc = { my $rdbms_mssql_sybase = { 'DBD::Sybase' => '0', }; +my $rdbms_mssql_ado = { + 'DBD::ADO' => '0', +}; my $rdbms_mysql = { 'DBD::mysql' => '0', }; @@ -242,7 +245,17 @@ my $reqs = { }, pod => { title => 'MSSQL support via DBD::Sybase', - desc => 'Modules required to connect to MSSQL support via DBD::Sybase', + desc => 'Modules required to connect to MSSQL via DBD::Sybase', + }, + }, + + rdbms_mssql_ado => { + req => { + %$rdbms_mssql_ado, + }, + pod => { + title => 'MSSQL support via DBD::ADO (Windows only)', + desc => 'Modules required to connect to MSSQL via DBD::ADO. This particular DBD is available on Windows only', }, }, @@ -308,6 +321,15 @@ my $reqs = { }, }, + test_rdbms_mssql_ado => { + req => { + $ENV{DBICTEST_MSSQL_ADO_DSN} + ? ( + %$rdbms_mssql_ado, + ) : () + }, + }, + test_rdbms_mssql_sybase => { req => { $ENV{DBICTEST_MSSQL_DSN} diff --git a/lib/DBIx/Class/Storage/DBI/ADO.pm b/lib/DBIx/Class/Storage/DBI/ADO.pm index aa9fb5d..91d731c 100644 --- a/lib/DBIx/Class/Storage/DBI/ADO.pm +++ b/lib/DBIx/Class/Storage/DBI/ADO.pm @@ -1,29 +1,53 @@ -package # hide from PAUSE - DBIx::Class::Storage::DBI::ADO; +package DBIx::Class::Storage::DBI::ADO; use base 'DBIx::Class::Storage::DBI'; +use mro 'c3'; use Try::Tiny; use namespace::clean; +=head1 NAME + +DBIx::Class::Storage::DBI::ADO - Support for L + +=head1 DESCRIPTION + +This class provides a mechanism for discovering and loading a sub-class +for a specific ADO backend, as well as some workarounds for L. It +should be transparent to the user. + +=cut + sub _rebless { my $self = shift; -# check for MSSQL -# XXX This should be using an OpenSchema method of some sort, but I don't know -# how. -# Current version is stolen from Sybase.pm - try { - my $dbtype = @{$self->_get_dbh - ->selectrow_arrayref(qq{sp_server_info \@attribute_id=1}) - }[2]; - - $dbtype =~ s/\W/_/gi; - my $subclass = "DBIx::Class::Storage::DBI::ADO::${dbtype}"; - if ($self->load_optional_class($subclass) && !$self->isa($subclass)) { - bless $self, $subclass; - $self->_rebless; - } + my $dbtype = $self->_dbh_get_info(17); + + if (not $dbtype) { + warn 'Unable to determine ADO driver, failling back to generic support'; + return; + } + + $dbtype =~ s/\W/_/gi; + my $subclass = "DBIx::Class::Storage::DBI::ADO::${dbtype}"; + if ($self->load_optional_class($subclass) && !$self->isa($subclass)) { + bless $self, $subclass; + $self->_rebless; + } +} + +# cleanup some warnings from DBD::ADO +# RT#65563, not fixed as of DBD::ADO v2.98 +sub _dbh_get_info { + my $self = shift; + + my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; + + local $SIG{__WARN__} = sub { + $warn_handler->(@_) + unless $_[0] =~ m{^Missing argument in sprintf at \S+/ADO/GetInfo\.pm}; }; + + $self->next::method(@_); } # Here I was just experimenting with ADO cursor types, left in as a comment in @@ -41,3 +65,14 @@ sub _rebless { #} 1; + +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut +# vim:sts=2 sw=2: diff --git a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm index 90d7639..7c053af 100644 --- a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm @@ -9,6 +9,54 @@ use base qw/ /; use mro 'c3'; +=head1 NAME + +DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server - Support for Microsoft +SQL Server via DBD::ADO + +=head1 SYNOPSIS + +This subclass supports MSSQL server connections via L. + +=head1 DESCRIPTION + +The MSSQL specific functionality is provided by +L. + +=head1 EXAMPLE DSN + + dbi:ADO:provider=sqlncli10;server=EEEBOX\SQLEXPRESS + +=head1 CAVEATS + +=head2 identities + +C<_identity_method> is set to C<@@identity>, as C doesn't work +with L. See L +for caveats regarding this. + +=head2 truncation bug + +There is a bug with MSSQL ADO providers where data gets truncated based on the +size of the bind sizes in the first prepare call: + +L + +The C workaround is used (see L) with the +approximate maximum size of the data_type of the bound column, or 8000 (maximum +VARCHAR size) if the data_type is not available. + +This code is incomplete and may be buggy. Particularly, C is not +supported yet. The data_type list for other DBs is also incomplete. Please +report problems (and send patches.) + +=head2 fractional seconds + +Fractional seconds with L are not +currently supported, datetimes are truncated at the second. + +=cut + sub _rebless { my $self = shift; $self->_identity_method('@@identity'); @@ -94,51 +142,45 @@ sub _mssql_max_data_type_representation_size_in_bytes { } } -1; - -=head1 NAME - -DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server - Support for Microsoft -SQL Server via DBD::ADO - -=head1 SYNOPSIS - -This subclass supports MSSQL server connections via L. - -=head1 DESCRIPTION - -The MSSQL specific functionality is provided by -L. - -=head2 CAVEATS - -=head3 identities - -C<_identity_method> is set to C<@@identity>, as C doesn't work -with L. See L -for caveats regarding this. +sub datetime_parser_type { + 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::DateTime::Format' +} -=head3 truncation bug +package # hide from PAUSE + DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::DateTime::Format; -There is a bug with MSSQL ADO providers where data gets truncated based on the -size of the bind sizes in the first prepare call: +my $datetime_format = '%m/%d/%Y %I:%M:%S %p'; +my $datetime_parser; -L +sub parse_datetime { + shift; + require DateTime::Format::Strptime; + $datetime_parser ||= DateTime::Format::Strptime->new( + pattern => $datetime_format, + on_error => 'croak', + ); + return $datetime_parser->parse_datetime(shift); +} -The C workaround is used (see L) with the -approximate maximum size of the data_type of the bound column, or 8000 (maximum -VARCHAR size) if the data_type is not available. +sub format_datetime { + shift; + require DateTime::Format::Strptime; + $datetime_parser ||= DateTime::Format::Strptime->new( + pattern => $datetime_format, + on_error => 'croak', + ); + return $datetime_parser->format_datetime(shift); +} -This code is incomplete and may be buggy. Particularly, C is not -supported yet. The data_type list for other DBs is also incomplete. Please -report problems (and send patches.) +1; =head1 AUTHOR -See L. +See L and L. =head1 LICENSE You may distribute this code under the same terms as Perl itself. =cut +# vim:sts=2 sw=2: diff --git a/t/747mssql_ado.t b/t/747mssql_ado.t index fd847bd..3c276ef 100644 --- a/t/747mssql_ado.t +++ b/t/747mssql_ado.t @@ -6,6 +6,9 @@ use Test::Exception; use lib qw(t/lib); use DBICTest; +# Example DSN (from frew): +# dbi:ADO:PROVIDER=sqlncli10;SERVER=tcp:172.24.2.10;MARS Connection=True;Initial Catalog=CIS;UID=cis_web;PWD=...;DataTypeCompatibility=80; + my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/}; plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ADO_DSN}, _USER and _PASS to run this test' @@ -16,9 +19,16 @@ $schema->storage->ensure_connected; isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server' ); +my $ver = $schema->storage->_server_info->{normalized_dbms_version}; + +ok $ver, 'can introspect DBMS version'; + +is $schema->storage->sql_limit_dialect, ($ver >= 9 ? 'RowNumberOver' : 'Top'), + 'correct limit dialect detected'; + $schema->storage->dbh_do (sub { my ($storage, $dbh) = @_; - eval { $dbh->do("DROP TABLE artist") }; + eval { local $^W = 0; $dbh->do("DROP TABLE artist") }; $dbh->do(<<'SQL'); CREATE TABLE artist ( artistid INT IDENTITY NOT NULL, @@ -39,8 +49,8 @@ is $found->artistid, $new->artistid, 'search works'; # test large column list in select $found = $schema->resultset('Artist')->search({ name => 'foo' }, { - select => ['artistid', 'name', map "'foo' foo_$_", 0..50], - as => ['artistid', 'name', map "foo_$_", 0..50], + select => ['artistid', 'name', map \"'foo' foo_$_", 0..50], + as => ['artistid', 'name', map "foo_$_", 0..50], })->first; is $found->artistid, $new->artistid, 'select with big column list'; is $found->get_column('foo_50'), 'foo', 'last item in big column list'; @@ -71,6 +81,10 @@ done_testing; # clean up our mess END { + my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; + local $SIG{__WARN__} = sub { + $warn_handler->(@_) unless $_[0] =~ /Not a Win32::OLE object/ + }; if (my $dbh = eval { $schema->storage->_dbh }) { eval { $dbh->do("DROP TABLE $_") } for qw/artist/; diff --git a/t/inflate/datetime_mssql.t b/t/inflate/datetime_mssql.t index 3c425e7..cff0fba 100644 --- a/t/inflate/datetime_mssql.t +++ b/t/inflate/datetime_mssql.t @@ -17,14 +17,16 @@ BEGIN { } } -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/}; +my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/}; my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/}; +my ($dsn3, $user3, $pass3) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/}; -if (not ($dsn || $dsn2)) { +if (not ($dsn || $dsn2 || $dsn3)) { plan skip_all => - 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN} and/or $ENV{DBICTEST_MSSQL_DSN} _USER ' - .'and _PASS to run this test' . - "\nWarning: This test drops and creates a table called 'small_dt'"; + 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN} and/or $ENV{DBICTEST_MSSQL_DSN} and/or ' + .'$ENV{DBICTEST_MSSQL_ADO_DSN} _USER and _PASS to run this test' . + "\nWarning: This test drops and creates tables called 'event_small_dt' and" + ." 'track'."; } plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_dt') @@ -33,6 +35,7 @@ plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missin my @connect_info = ( [ $dsn, $user, $pass ], [ $dsn2, $user2, $pass2 ], + [ $dsn3, $user3, $pass3 ], ); my $schema; @@ -58,7 +61,8 @@ for my $connect_info (@connect_info) { my $guard = Scope::Guard->new(\&cleanup); - try { $schema->storage->dbh->do("DROP TABLE track") }; + # $^W because DBD::ADO is a piece of crap + try { local $^W = 0; $schema->storage->dbh->do("DROP TABLE track") }; $schema->storage->dbh->do(<<"SQL"); CREATE TABLE track ( trackid INT IDENTITY PRIMARY KEY, @@ -67,7 +71,7 @@ CREATE TABLE track ( last_updated_at DATETIME, ) SQL - try { $schema->storage->dbh->do("DROP TABLE event_small_dt") }; + try { local $^W = 0; $schema->storage->dbh->do("DROP TABLE event_small_dt") }; $schema->storage->dbh->do(<<"SQL"); CREATE TABLE event_small_dt ( id INT IDENTITY PRIMARY KEY, @@ -108,6 +112,8 @@ SQL for my $dt_type (@dt_types) { my ($type, $col, $source, $pk, $create_extra, $sample_dt) = @$dt_type; + delete $sample_dt->{nanosecond} if $dsn =~ /:ADO:/; + ok(my $dt = DateTime->new($sample_dt)); my $row;