Commit | Line | Data |
c1cac633 |
1 | package DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server; |
2 | use strict; |
3 | use warnings; |
4 | |
eb0323df |
5 | use base qw/DBIx::Class::Storage::DBI::MSSQL/; |
2ad62d97 |
6 | use mro 'c3'; |
ef131d82 |
7 | use Carp::Clan qw/^DBIx::Class/; |
893403c8 |
8 | use List::Util(); |
c1cac633 |
9 | |
ef131d82 |
10 | __PACKAGE__->mk_group_accessors(simple => qw/ |
14c82fd4 |
11 | _identity _using_dynamic_cursors |
ef131d82 |
12 | /); |
13 | |
14 | =head1 NAME |
15 | |
16 | DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server - Support specific |
17 | to Microsoft SQL Server over ODBC |
18 | |
19 | =head1 DESCRIPTION |
20 | |
21 | This class implements support specific to Microsoft SQL Server over ODBC, |
22 | including auto-increment primary keys and SQL::Abstract::Limit dialect. It |
23 | is loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it |
24 | detects a MSSQL back-end. |
25 | |
26 | =head1 IMPLEMENTATION NOTES |
27 | |
28 | Microsoft SQL Server supports three methods of retrieving the C<IDENTITY> |
29 | value for inserted row: C<IDENT_CURRENT>, C<@@IDENTITY>, and C<SCOPE_IDENTITY()>. |
30 | C<SCOPE_IDENTITY()> is used here because it is the safest. However, it must |
31 | be called is the same execute statement, not just the same connection. |
32 | |
33 | So, this implementation appends a C<SELECT SCOPE_IDENTITY()> statement |
34 | onto each C<INSERT> to accommodate that requirement. |
35 | |
36 | If you use dynamic cursors with C<< odbc_cursortype => 2 >> or |
37 | L</on_connect_call_use_dynamic_cursors> then the less accurate |
38 | C<SELECT @@IDENTITY> is used instead. |
39 | |
40 | =head1 MULTIPLE ACTIVE STATEMENTS |
41 | |
42 | The following options are alternative ways to enable concurrent executing |
43 | statement support. Each has its own advantages and drawbacks. |
44 | |
45 | =head2 connect_call_use_dynamic_cursors |
46 | |
47 | Use as: |
48 | |
49 | on_connect_call => 'use_dynamic_cursors' |
50 | |
51 | in your L<DBIx::Class::Storage::DBI/connect_info> as one way to enable multiple |
52 | concurrent statements. |
53 | |
54 | Will add C<< odbc_cursortype => 2 >> to your DBI connection attributes. See |
55 | L<DBD::ODBC/odbc_cursortype> for more information. |
56 | |
57 | This will not work with CODE ref connect_info's and will do nothing if you set |
58 | C<odbc_cursortype> yourself. |
59 | |
60 | B<WARNING:> this will break C<SCOPE_IDENTITY()>, and C<SELECT @@IDENTITY> will |
61 | be used instead, which on SQL Server 2005 and later will return erroneous |
62 | results on tables which have an on insert trigger that inserts into another |
63 | table with an C<IDENTITY> column. |
64 | |
65 | =cut |
66 | |
67 | sub connect_call_use_dynamic_cursors { |
68 | my $self = shift; |
69 | |
70 | if (ref($self->_dbi_connect_info->[0]) eq 'CODE') { |
18ac986d |
71 | croak 'cannot set DBI attributes on a CODE ref connect_info'; |
ef131d82 |
72 | } |
73 | |
74 | my $dbi_attrs = $self->_dbi_connect_info->[-1]; |
75 | $dbi_attrs ||= {}; |
76 | |
77 | if (not exists $dbi_attrs->{odbc_cursortype}) { |
78 | # turn on support for multiple concurrent statements, unless overridden |
79 | $self->_dbi_connect_info->[-1] = { %$dbi_attrs, odbc_cursortype => 2 }; |
1da8d083 |
80 | my $connected = defined $self->_dbh; |
ef131d82 |
81 | $self->disconnect; |
1da8d083 |
82 | $self->ensure_connected if $connected; |
ef131d82 |
83 | $self->_using_dynamic_cursors(1); |
84 | } |
85 | } |
86 | |
87 | sub _rebless { |
88 | no warnings 'uninitialized'; |
89 | my $self = shift; |
90 | |
91 | if (ref($self->_dbi_connect_info->[0]) ne 'CODE' && |
92 | $self->_dbi_connect_info->[-1]{odbc_cursortype} == 2) { |
93 | $self->_using_dynamic_cursors(1); |
94 | return; |
95 | } |
96 | |
97 | $self->_using_dynamic_cursors(0); |
98 | } |
99 | |
18ac986d |
100 | =head2 connect_call_use_server_cursors |
101 | |
102 | Use as: |
103 | |
104 | on_connect_call => 'use_server_cursors' |
105 | |
106 | May allow multiple active select statements. See |
107 | L<DBD::ODBC/odbc_SQL_ROWSET_SIZE> for more information. |
108 | |
109 | Takes an optional parameter for the value to set the attribute to, default is |
110 | C<2>. |
111 | |
112 | B<WARNING>: this does not work on all versions of SQL Server, and may lock up |
113 | your database! |
114 | |
115 | =cut |
116 | |
117 | =head2 connect_call_use_mars |
118 | |
119 | Use as: |
120 | |
121 | on_connect_call => 'use_mars' |
122 | |
123 | Use to enable a feature of SQL Server 2005 and later, "Multiple Active Result |
124 | Sets". See L<DBD::ODBC::FAQ/Does DBD::ODBC support Multiple Active Statements?> |
125 | for more information. |
126 | |
127 | B<WARNING>: This has implications for the way transactions are handled. |
128 | |
129 | =cut |
130 | |
131 | sub connect_call_use_mars { |
132 | my $self = shift; |
133 | |
134 | my $dsn = $self->_dbi_connect_info->[0]; |
135 | |
136 | if (ref($dsn) eq 'CODE') { |
137 | croak 'cannot change the DBI DSN on a CODE ref connect_info'; |
138 | } |
139 | |
140 | if ($dsn !~ /MARS_Connection=/) { |
141 | $self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes"; |
1da8d083 |
142 | my $connected = defined $self->_dbh; |
18ac986d |
143 | $self->disconnect; |
1da8d083 |
144 | $self->ensure_connected if $connected; |
18ac986d |
145 | } |
146 | } |
147 | |
c7963907 |
148 | sub insert_bulk { |
76212d30 |
149 | my $self = shift; |
150 | my ($source, $cols, $data) = @_; |
134a3bb9 |
151 | |
152 | my $identity_insert = 0; |
153 | |
154 | COLUMNS: |
155 | foreach my $col (@{$cols}) { |
156 | if ($source->column_info($col)->{is_auto_increment}) { |
157 | $identity_insert = 1; |
158 | last COLUMNS; |
159 | } |
160 | } |
161 | |
05f7f61a |
162 | if ($identity_insert) { |
893403c8 |
163 | my $table = $source->from; |
ef131d82 |
164 | $self->_get_dbh->do("SET IDENTITY_INSERT $table ON"); |
05f7f61a |
165 | } |
134a3bb9 |
166 | |
76212d30 |
167 | $self->next::method(@_); |
134a3bb9 |
168 | |
05f7f61a |
169 | if ($identity_insert) { |
893403c8 |
170 | my $table = $source->from; |
ef131d82 |
171 | $self->_get_dbh->do("SET IDENTITY_INSERT $table OFF"); |
05f7f61a |
172 | } |
c7963907 |
173 | } |
174 | |
c1cac633 |
175 | sub _prep_for_execute { |
259c0e40 |
176 | my $self = shift; |
177 | my ($op, $extra_bind, $ident, $args) = @_; |
178 | |
d68f21ee |
179 | # cast MONEY values properly |
180 | if ($op eq 'insert' || $op eq 'update') { |
181 | my $fields = $args->[0]; |
182 | my $col_info = $self->_resolve_column_info($ident, [keys %$fields]); |
183 | |
34ff59bb |
184 | for my $col (keys %$fields) { |
f6b185e1 |
185 | if ($col_info->{$col}{data_type} =~ /^money\z/i) { |
d68f21ee |
186 | my $val = $fields->{$col}; |
d68f21ee |
187 | $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]]; |
188 | } |
189 | } |
190 | } |
191 | |
259c0e40 |
192 | my ($sql, $bind) = $self->next::method (@_); |
259c0e40 |
193 | |
893403c8 |
194 | if ($op eq 'insert') { |
195 | $sql .= ';SELECT SCOPE_IDENTITY()'; |
196 | |
197 | my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]); |
198 | if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) { |
764a1b60 |
199 | |
893403c8 |
200 | my $table = $ident->from; |
201 | my $identity_insert_on = "SET IDENTITY_INSERT $table ON"; |
202 | my $identity_insert_off = "SET IDENTITY_INSERT $table OFF"; |
203 | $sql = "$identity_insert_on; $sql; $identity_insert_off"; |
259c0e40 |
204 | } |
205 | } |
c1cac633 |
206 | |
259c0e40 |
207 | return ($sql, $bind); |
c1cac633 |
208 | } |
209 | |
2eebd801 |
210 | sub _execute { |
211 | my $self = shift; |
212 | my ($op) = @_; |
c1cac633 |
213 | |
2eebd801 |
214 | my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_); |
77af494b |
215 | if ($op eq 'insert') { |
ef131d82 |
216 | my ($identity) = $sth->fetchrow_array; |
77af494b |
217 | $sth->finish; |
ef131d82 |
218 | |
219 | if ((not defined $identity) && $self->_using_dynamic_cursors) { |
220 | ($identity) = $self->_dbh->selectrow_array('select @@identity'); |
221 | } |
222 | |
14c82fd4 |
223 | $self->_identity($identity); |
77af494b |
224 | } |
c1cac633 |
225 | |
2eebd801 |
226 | return wantarray ? ($rv, $sth, @bind) : $rv; |
c1cac633 |
227 | } |
228 | |
14c82fd4 |
229 | sub last_insert_id { shift->_identity() } |
c1cac633 |
230 | |
c1cac633 |
231 | 1; |
232 | |
ef131d82 |
233 | =head1 AUTHOR |
c1cac633 |
234 | |
ef131d82 |
235 | See L<DBIx::Class/CONTRIBUTORS>. |
c1cac633 |
236 | |
237 | =head1 LICENSE |
238 | |
239 | You may distribute this code under the same terms as Perl itself. |
240 | |
241 | =cut |
ef131d82 |
242 | |
259c0e40 |
243 | # vim: sw=2 sts=2 |