lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm

   1 package DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server;
   2 use strict;
   3 use warnings;
   4
   5 use base qw/DBIx::Class::Storage::DBI::MSSQL/;
   6 use mro 'c3';
   7 use Scalar::Util 'reftype';
   8 use Try::Tiny;
   9 use Carp::Clan qw/^DBIx::Class/;
  10 use namespace::clean;
  11
  12 __PACKAGE__->mk_group_accessors(simple => qw/
  13   _using_dynamic_cursors
  14 /);
  15
  16 =head1 NAME
  17
  18 DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server - Support specific
  19 to Microsoft SQL Server over ODBC
  20
  21 =head1 DESCRIPTION
  22
  23 This class implements support specific to Microsoft SQL Server over ODBC.  It is
  24 loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it detects a
  25 MSSQL back-end.
  26
  27 Most of the functionality is provided from the superclass
  28 L<DBIx::Class::Storage::DBI::MSSQL>.
  29
  30 =head1 MULTIPLE ACTIVE STATEMENTS
  31
  32 The following options are alternative ways to enable concurrent executing
  33 statement support. Each has its own advantages and drawbacks and works on
  34 different platforms. Read each section carefully.
  35
  36 In order of preference, they are:
  37
  38 =over 8
  39
  40 =item * L</connect_call_use_mars>
  41
  42 =item * L</connect_call_use_dynamic_cursors>
  43
  44 =item * L</connect_call_use_server_cursors>
  45
  46 =back
  47
  48 =head1 METHODS
  49
  50 =head2 connect_call_use_mars
  51
  52 Use as:
  53
  54   on_connect_call => 'use_mars'
  55
  56 Use to enable a feature of SQL Server 2005 and later, "Multiple Active Result
  57 Sets". See L<DBD::ODBC::FAQ/Does DBD::ODBC support Multiple Active Statements?>
  58 for more information.
  59
  60 This does not work on FreeTDS drivers at the time of this writing, and only
  61 works with the Native Client, later versions of the Windows MS ODBC driver, and
  62 the Easysoft driver.
  63
  64 =cut
  65
  66 sub connect_call_use_mars {
  67   my $self = shift;
  68
  69   my $dsn = $self->_dbi_connect_info->[0];
  70
  71   if (ref($dsn) eq 'CODE') {
  72     $self->throw_exception('cannot change the DBI DSN on a CODE ref connect_info');
  73   }
  74
  75   if ($dsn !~ /MARS_Connection=/) {
  76     if ($self->using_freetds) {
  77       $self->throw_exception('FreeTDS does not support MARS at the time of '
  78                             .'writing.');
  79     }
  80
  81     if (exists $self->_server_info->{normalized_dbms_version} &&
  82                $self->_server_info->{normalized_dbms_version} < 9) {
  83       $self->throw_exception('SQL Server 2005 or later required to use MARS.');
  84     }
  85
  86     if (my ($data_source) = $dsn =~ /^dbi:ODBC:([\w-]+)\z/i) { # prefix with DSN
  87       warn "Bare DSN in ODBC connect string, rewriting to DSN=$data_source\n";
  88       $dsn = "dbi:ODBC:DSN=$data_source";
  89     }
  90
  91     $self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes";
  92     $self->disconnect;
  93     $self->ensure_connected;
  94   }
  95 }
  96
  97 sub connect_call_use_MARS {
  98   carp "'connect_call_use_MARS' has been deprecated, use "
  99       ."'connect_call_use_mars' instead.";
 100   shift->connect_call_use_mars(@_)
 101 }
 102
 103 =head2 connect_call_use_dynamic_cursors
 104
 105 Use as:
 106
 107   on_connect_call => 'use_dynamic_cursors'
 108
 109 in your L<connect_info|DBIx::Class::Storage::DBI/connect_info> as one way to enable multiple
 110 concurrent statements.
 111
 112 Will add C<< odbc_cursortype => 2 >> to your DBI connection attributes. See
 113 L<DBD::ODBC/odbc_cursortype> for more information.
 114
 115 Alternatively, you can add it yourself and dynamic cursor support will be
 116 automatically enabled.
 117
 118 If you're using FreeTDS, C<tds_version> must be set to at least C<8.0>.
 119
 120 This will not work with CODE ref connect_info's.
 121
 122 B<WARNING:> this will break C<SCOPE_IDENTITY()>, and C<SELECT @@IDENTITY> will
 123 be used instead, which on SQL Server 2005 and later will return erroneous
 124 results on tables which have an on insert trigger that inserts into another
 125 table with an C<IDENTITY> column.
 126
 127 =cut
 128
 129 sub connect_call_use_dynamic_cursors {
 130   my $self = shift;
 131
 132   if (ref($self->_dbi_connect_info->[0]) eq 'CODE') {
 133     $self->throw_exception ('Cannot set DBI attributes on a CODE ref connect_info');
 134   }
 135
 136   my $dbi_attrs = $self->_dbi_connect_info->[-1];
 137
 138   unless (ref $dbi_attrs eq 'HASH') {
 139     $dbi_attrs = {};
 140     push @{ $self->_dbi_connect_info }, $dbi_attrs;
 141   }
 142
 143   if (not exists $dbi_attrs->{odbc_cursortype}) {
 144     # turn on support for multiple concurrent statements, unless overridden
 145     $dbi_attrs->{odbc_cursortype} = 2;
 146     $self->disconnect; # resetting dbi attrs, so have to reconnect
 147     $self->ensure_connected;
 148     $self->_set_dynamic_cursors;
 149   }
 150 }
 151
 152 sub _set_dynamic_cursors {
 153   my $self = shift;
 154   my $dbh  = $self->_get_dbh;
 155
 156   try {
 157     local $dbh->{RaiseError} = 1;
 158     local $dbh->{PrintError} = 0;
 159     $dbh->do('SELECT @@IDENTITY');
 160   } catch {
 161     $self->throw_exception (<<'EOF');
 162
 163 Your drivers do not seem to support dynamic cursors (odbc_cursortype => 2),
 164 if you're using FreeTDS, make sure to set tds_version to 8.0 or greater.
 165 EOF
 166   };
 167
 168   $self->_using_dynamic_cursors(1);
 169   $self->_identity_method('@@identity');
 170 }
 171
 172 sub _init {
 173   my $self = shift;
 174
 175   if (
 176     ref($self->_dbi_connect_info->[0]) ne 'CODE'
 177       &&
 178     ref ($self->_dbi_connect_info->[-1]) eq 'HASH'
 179       &&
 180     ($self->_dbi_connect_info->[-1]{odbc_cursortype} || 0) > 1
 181   ) {
 182     $self->_set_dynamic_cursors;
 183   }
 184   else {
 185     $self->_using_dynamic_cursors(0);
 186   }
 187 }
 188
 189 =head2 connect_call_use_server_cursors
 190
 191 Use as:
 192
 193   on_connect_call => 'use_server_cursors'
 194
 195 May allow multiple active select statements. See
 196 L<DBD::ODBC/odbc_SQL_ROWSET_SIZE> for more information.
 197
 198 Takes an optional parameter for the value to set the attribute to, default is
 199 C<2>.
 200
 201 B<WARNING>: this does not work on all versions of SQL Server, and may lock up
 202 your database!
 203
 204 At the time of writing, this option only works on Microsoft's Windows drivers,
 205 later versions of the ODBC driver and the Native Client driver.
 206
 207 =cut
 208
 209 sub connect_call_use_server_cursors {
 210   my $self            = shift;
 211   my $sql_rowset_size = shift || 2;
 212
 213   if ($^O !~ /win32|cygwin/i) {
 214     $self->throw_exception('Server cursors only work on Windows platforms at '
 215                           .'the time of writing.');
 216   }
 217
 218   $self->_get_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size;
 219 }
 220
 221 =head2 using_freetds
 222
 223 Tries to determine, to the best of our ability, whether or not you are using the
 224 FreeTDS driver with L<DBD::ODBC>.
 225
 226 =cut
 227
 228 sub using_freetds {
 229   my $self = shift;
 230
 231   my $dsn = $self->_dbi_connect_info->[0];
 232
 233   $dsn = '' if ref $dsn eq 'CODE';
 234
 235   my $dbh = $self->_get_dbh;
 236
 237   return 1 if $dsn =~ /driver=FreeTDS/i
 238               || (try { $dbh->get_info(6) }||'') =~ /tdsodbc/i;
 239
 240   return 0;
 241 }
 242
 243 1;
 244
 245 =head1 AUTHOR
 246
 247 See L<DBIx::Class/CONTRIBUTORS>.
 248
 249 =head1 LICENSE
 250
 251 You may distribute this code under the same terms as Perl itself.
 252
 253 =cut
 254 # vim: sw=2 sts=2