line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Class::Storage::DBI::Sybase::ASE; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
1620
|
use strict; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
88
|
|
4
|
3
|
|
|
3
|
|
18
|
use warnings; |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
99
|
|
5
|
|
|
|
|
|
|
|
6
|
3
|
|
|
|
|
806
|
use base qw/ |
7
|
|
|
|
|
|
|
DBIx::Class::Storage::DBI::Sybase |
8
|
|
|
|
|
|
|
DBIx::Class::Storage::DBI::AutoCast |
9
|
|
|
|
|
|
|
DBIx::Class::Storage::DBI::IdentityInsert |
10
|
3
|
|
|
3
|
|
18
|
/; |
|
3
|
|
|
|
|
9
|
|
11
|
3
|
|
|
3
|
|
19
|
use mro 'c3'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
12
|
3
|
|
|
3
|
|
68
|
use DBIx::Class::Carp; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
15
|
|
13
|
3
|
|
|
3
|
|
17
|
use Scalar::Util qw/blessed weaken/; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
146
|
|
14
|
3
|
|
|
3
|
|
18
|
use Context::Preserve 'preserve_context'; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
130
|
|
15
|
3
|
|
|
|
|
143
|
use DBIx::Class::_Util qw( |
16
|
|
|
|
|
|
|
sigwarn_silencer dbic_internal_try dbic_internal_catch |
17
|
|
|
|
|
|
|
dump_value scope_guard set_subname |
18
|
3
|
|
|
3
|
|
19
|
); |
|
3
|
|
|
|
|
7
|
|
19
|
3
|
|
|
3
|
|
20
|
use namespace::clean; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
15
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
__PACKAGE__->sql_limit_dialect ('GenericSubQ'); |
22
|
|
|
|
|
|
|
__PACKAGE__->sql_quote_char ([qw/[ ]/]); |
23
|
|
|
|
|
|
|
__PACKAGE__->datetime_parser_type( |
24
|
|
|
|
|
|
|
'DBIx::Class::Storage::DBI::Sybase::ASE::DateTime::Format' |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
__PACKAGE__->mk_group_accessors('simple' => |
28
|
|
|
|
|
|
|
qw/_identity _identity_method _blob_log_on_update _parent_storage |
29
|
|
|
|
|
|
|
_writer_storage _is_writer_storage |
30
|
|
|
|
|
|
|
_bulk_storage _is_bulk_storage _began_bulk_work |
31
|
|
|
|
|
|
|
/ |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
my @also_proxy_to_extra_storages = qw/ |
36
|
|
|
|
|
|
|
connect_call_set_auto_cast auto_cast connect_call_blob_setup |
37
|
|
|
|
|
|
|
connect_call_datetime_setup |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching |
40
|
|
|
|
|
|
|
auto_savepoint unsafe cursor_class debug debugobj schema |
41
|
|
|
|
|
|
|
/; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 NAME |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
DBIx::Class::Storage::DBI::Sybase::ASE - Sybase ASE SQL Server support for |
46
|
|
|
|
|
|
|
DBIx::Class |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 SYNOPSIS |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
This subclass supports L for real (non-Microsoft) Sybase databases. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 DESCRIPTION |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
If your version of Sybase does not support placeholders, then your storage will |
55
|
|
|
|
|
|
|
be reblessed to L. |
56
|
|
|
|
|
|
|
You can also enable that driver explicitly, see the documentation for more |
57
|
|
|
|
|
|
|
details. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
With this driver there is unfortunately no way to get the C |
60
|
|
|
|
|
|
|
without doing a C |
61
|
|
|
|
|
|
|
(locking the table.) See L. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
A recommended L setting: |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
on_connect_call => [['datetime_setup'], ['blob_setup', log_on_update => 0]] |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 METHODS |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=cut |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub _rebless { |
72
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
0
|
my $no_bind_vars = __PACKAGE__ . '::NoBindVars'; |
75
|
|
|
|
|
|
|
|
76
|
0
|
0
|
|
|
|
0
|
if ($self->_using_freetds) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
77
|
0
|
0
|
|
|
|
0
|
carp_once <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN}; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
You are using FreeTDS with Sybase. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
We will do our best to support this configuration, but please consider this |
82
|
|
|
|
|
|
|
support experimental. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
TEXT/IMAGE columns will definitely not work. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
You are encouraged to recompile DBD::Sybase with the Sybase Open Client libraries |
87
|
|
|
|
|
|
|
instead. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
See perldoc DBIx::Class::Storage::DBI::Sybase::ASE for more details. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment |
92
|
|
|
|
|
|
|
variable. |
93
|
|
|
|
|
|
|
EOF |
94
|
|
|
|
|
|
|
|
95
|
0
|
0
|
|
|
|
0
|
if (not $self->_use_typeless_placeholders) { |
96
|
0
|
0
|
|
|
|
0
|
if ($self->_use_placeholders) { |
97
|
0
|
|
|
|
|
0
|
$self->auto_cast(1); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
else { |
100
|
0
|
|
|
|
|
0
|
$self->ensure_class_loaded($no_bind_vars); |
101
|
0
|
|
|
|
|
0
|
bless $self, $no_bind_vars; |
102
|
0
|
|
|
|
|
0
|
$self->_rebless; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
elsif (not $self->_get_dbh->{syb_dynamic_supported}) { |
108
|
|
|
|
|
|
|
# not necessarily FreeTDS, but no placeholders nevertheless |
109
|
0
|
|
|
|
|
0
|
$self->ensure_class_loaded($no_bind_vars); |
110
|
0
|
|
|
|
|
0
|
bless $self, $no_bind_vars; |
111
|
0
|
|
|
|
|
0
|
$self->_rebless; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
# this is highly unlikely, but we check just in case |
114
|
|
|
|
|
|
|
elsif (not $self->_use_typeless_placeholders) { |
115
|
0
|
|
|
|
|
0
|
$self->auto_cast(1); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _init { |
120
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
0
|
$self->next::method(@_); |
123
|
|
|
|
|
|
|
|
124
|
0
|
0
|
0
|
|
|
0
|
if ($self->_using_freetds && (my $ver = $self->_using_freetds_version||999) > 0.82) { |
|
|
|
0
|
|
|
|
|
125
|
0
|
|
|
|
|
0
|
carp_once( |
126
|
|
|
|
|
|
|
"Buggy FreeTDS version $ver detected, statement caching will not work and " |
127
|
|
|
|
|
|
|
. 'will be disabled.' |
128
|
|
|
|
|
|
|
); |
129
|
0
|
|
|
|
|
0
|
$self->disable_sth_caching(1); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
0
|
$self->_set_max_connect(256); |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# create storage for insert/(update blob) transactions, |
135
|
|
|
|
|
|
|
# unless this is that storage |
136
|
0
|
0
|
|
|
|
0
|
return if $self->_parent_storage; |
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
0
|
my $writer_storage = (ref $self)->new; |
139
|
|
|
|
|
|
|
|
140
|
0
|
|
|
|
|
0
|
$writer_storage->_is_writer_storage(1); # just info |
141
|
0
|
|
|
|
|
0
|
$writer_storage->connect_info($self->connect_info); |
142
|
0
|
|
|
|
|
0
|
$writer_storage->auto_cast($self->auto_cast); |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
0
|
weaken ($writer_storage->{_parent_storage} = $self); |
145
|
0
|
|
|
|
|
0
|
$self->_writer_storage($writer_storage); |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# create a bulk storage unless connect_info is a coderef |
148
|
0
|
0
|
|
|
|
0
|
return if ref($self->_dbi_connect_info->[0]) eq 'CODE'; |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
0
|
my $bulk_storage = (ref $self)->new; |
151
|
|
|
|
|
|
|
|
152
|
0
|
|
|
|
|
0
|
$bulk_storage->_is_bulk_storage(1); # for special ->disconnect acrobatics |
153
|
0
|
|
|
|
|
0
|
$bulk_storage->connect_info($self->connect_info); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# this is why |
156
|
0
|
|
|
|
|
0
|
$bulk_storage->_dbi_connect_info->[0] .= ';bulkLogin=1'; |
157
|
|
|
|
|
|
|
|
158
|
0
|
|
|
|
|
0
|
weaken ($bulk_storage->{_parent_storage} = $self); |
159
|
0
|
|
|
|
|
0
|
$self->_bulk_storage($bulk_storage); |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
for my $method (@also_proxy_to_extra_storages) { |
163
|
3
|
|
|
3
|
|
1929
|
no strict 'refs'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
75
|
|
164
|
3
|
|
|
3
|
|
14
|
no warnings 'redefine'; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
5201
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my $replaced = __PACKAGE__->can($method); |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
*{$method} = set_subname $method => sub { |
169
|
2
|
|
|
2
|
0
|
4
|
my $self = shift; |
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
0
|
|
|
|
|
|
|
2
|
1
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
|
2
|
|
|
|
170
|
2
|
50
|
|
|
|
6
|
$self->_writer_storage->$replaced(@_) if $self->_writer_storage; |
171
|
2
|
50
|
|
|
|
474
|
$self->_bulk_storage->$replaced(@_) if $self->_bulk_storage; |
172
|
2
|
|
|
|
|
166
|
return $self->$replaced(@_); |
173
|
|
|
|
|
|
|
}; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub disconnect { |
177
|
|
|
|
|
|
|
my $self = shift; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# Even though we call $sth->finish for uses off the bulk API, there's still an |
180
|
|
|
|
|
|
|
# "active statement" warning on disconnect, which we throw away here. |
181
|
|
|
|
|
|
|
# This is due to the bug described in _insert_bulk. |
182
|
|
|
|
|
|
|
# Currently a noop because 'prepare' is used instead of 'prepare_cached'. |
183
|
|
|
|
|
|
|
local $SIG{__WARN__} = sigwarn_silencer(qr/active statement/i) |
184
|
|
|
|
|
|
|
if $self->_is_bulk_storage; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# so that next transaction gets a dbh |
187
|
|
|
|
|
|
|
$self->_began_bulk_work(0) if $self->_is_bulk_storage; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
$self->next::method; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# This is only invoked for FreeTDS drivers by ::Storage::DBI::Sybase::FreeTDS |
193
|
|
|
|
|
|
|
sub _set_autocommit_stmt { |
194
|
0
|
|
|
0
|
|
|
my ($self, $on) = @_; |
195
|
|
|
|
|
|
|
|
196
|
0
|
0
|
|
|
|
|
return 'SET CHAINED ' . ($on ? 'OFF' : 'ON'); |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# Set up session settings for Sybase databases for the connection. |
200
|
|
|
|
|
|
|
# |
201
|
|
|
|
|
|
|
# Make sure we have CHAINED mode turned on if AutoCommit is off in non-FreeTDS |
202
|
|
|
|
|
|
|
# DBD::Sybase (since we don't know how DBD::Sybase was compiled.) If however |
203
|
|
|
|
|
|
|
# we're using FreeTDS, CHAINED mode turns on an implicit transaction which we |
204
|
|
|
|
|
|
|
# only want when AutoCommit is off. |
205
|
|
|
|
|
|
|
sub _run_connection_actions { |
206
|
0
|
|
|
0
|
|
|
my $self = shift; |
207
|
|
|
|
|
|
|
|
208
|
0
|
0
|
|
|
|
|
if ($self->_is_bulk_storage) { |
209
|
|
|
|
|
|
|
# this should be cleared on every reconnect |
210
|
0
|
|
|
|
|
|
$self->_began_bulk_work(0); |
211
|
0
|
|
|
|
|
|
return; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
0
|
0
|
|
|
|
|
$self->_dbh->{syb_chained_txn} = 1 |
215
|
|
|
|
|
|
|
unless $self->_using_freetds; |
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
|
$self->next::method(@_); |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head2 connect_call_blob_setup |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Used as: |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
on_connect_call => [ [ 'blob_setup', log_on_update => 0 ] ] |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Does C<< $dbh->{syb_binary_images} = 1; >> to return C data as raw binary |
227
|
|
|
|
|
|
|
instead of as a hex string. |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
Recommended. |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Also sets the C value for blob write operations. The default is |
232
|
|
|
|
|
|
|
C<1>, but C<0> is better if your database is configured for it. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
See |
235
|
|
|
|
|
|
|
L. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=cut |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub connect_call_blob_setup { |
240
|
|
|
|
|
|
|
my $self = shift; |
241
|
|
|
|
|
|
|
my %args = @_; |
242
|
|
|
|
|
|
|
my $dbh = $self->_dbh; |
243
|
|
|
|
|
|
|
$dbh->{syb_binary_images} = 1; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
$self->_blob_log_on_update($args{log_on_update}) |
246
|
|
|
|
|
|
|
if exists $args{log_on_update}; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub _is_lob_column { |
250
|
0
|
|
|
0
|
|
|
my ($self, $source, $column) = @_; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
return $self->_is_lob_type( |
253
|
|
|
|
|
|
|
$source->columns_info([$column])->{$column}{data_type} |
254
|
0
|
|
|
|
|
|
); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
sub _prep_for_execute { |
258
|
0
|
|
|
0
|
|
|
my ($self, $op, $ident, $args) = @_; |
259
|
|
|
|
|
|
|
|
260
|
0
|
|
|
|
|
|
my $limit; # extract and use shortcut on limit without offset |
261
|
0
|
0
|
0
|
|
|
|
if ($op eq 'select' and ! $args->[4] and $limit = $args->[3]) { |
|
|
|
0
|
|
|
|
|
262
|
0
|
|
|
|
|
|
$args = [ @$args ]; |
263
|
0
|
|
|
|
|
|
$args->[3] = undef; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
0
|
|
|
|
|
|
my ($sql, $bind) = $self->next::method($op, $ident, $args); |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# $limit is already sanitized by now |
269
|
0
|
0
|
|
|
|
|
$sql = join( "\n", |
270
|
|
|
|
|
|
|
"SET ROWCOUNT $limit", |
271
|
|
|
|
|
|
|
$sql, |
272
|
|
|
|
|
|
|
"SET ROWCOUNT 0", |
273
|
|
|
|
|
|
|
) if $limit; |
274
|
|
|
|
|
|
|
|
275
|
0
|
0
|
|
|
|
|
if (my $identity_col = $self->_perform_autoinc_retrieval) { |
276
|
0
|
|
|
|
|
|
$sql .= "\n" . $self->_fetch_identity_sql($ident, $identity_col) |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
0
|
|
|
|
|
|
return ($sql, $bind); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub _fetch_identity_sql { |
283
|
0
|
|
|
0
|
|
|
my ($self, $source, $col) = @_; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
return sprintf ("SELECT MAX(%s) FROM %s", |
286
|
0
|
|
|
|
|
|
map { $self->sql_maker->_quote ($_) } ($col, $source->from) |
|
0
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
); |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# Stolen from SQLT, with some modifications. This is a makeshift |
291
|
|
|
|
|
|
|
# solution before a sane type-mapping library is available, thus |
292
|
|
|
|
|
|
|
# the 'our' for easy overrides. |
293
|
|
|
|
|
|
|
our %TYPE_MAPPING = ( |
294
|
|
|
|
|
|
|
number => 'numeric', |
295
|
|
|
|
|
|
|
money => 'money', |
296
|
|
|
|
|
|
|
varchar => 'varchar', |
297
|
|
|
|
|
|
|
varchar2 => 'varchar', |
298
|
|
|
|
|
|
|
timestamp => 'datetime', |
299
|
|
|
|
|
|
|
text => 'varchar', |
300
|
|
|
|
|
|
|
real => 'double precision', |
301
|
|
|
|
|
|
|
comment => 'text', |
302
|
|
|
|
|
|
|
bit => 'bit', |
303
|
|
|
|
|
|
|
tinyint => 'smallint', |
304
|
|
|
|
|
|
|
float => 'double precision', |
305
|
|
|
|
|
|
|
serial => 'numeric', |
306
|
|
|
|
|
|
|
bigserial => 'numeric', |
307
|
|
|
|
|
|
|
boolean => 'varchar', |
308
|
|
|
|
|
|
|
long => 'varchar', |
309
|
|
|
|
|
|
|
); |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub _native_data_type { |
312
|
0
|
|
|
0
|
|
|
my ($self, $type) = @_; |
313
|
|
|
|
|
|
|
|
314
|
0
|
|
|
|
|
|
$type = lc $type; |
315
|
0
|
|
|
|
|
|
$type =~ s/\s* identity//x; |
316
|
|
|
|
|
|
|
|
317
|
0
|
|
0
|
|
|
|
return uc($TYPE_MAPPING{$type} || $type); |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub _execute { |
322
|
0
|
|
|
0
|
|
|
my $self = shift; |
323
|
0
|
|
|
|
|
|
my ($rv, $sth, @bind) = $self->next::method(@_); |
324
|
|
|
|
|
|
|
|
325
|
0
|
0
|
|
|
|
|
$self->_identity( ($sth->fetchall_arrayref)->[0][0] ) |
326
|
|
|
|
|
|
|
if $self->_perform_autoinc_retrieval; |
327
|
|
|
|
|
|
|
|
328
|
0
|
0
|
|
|
|
|
return wantarray ? ($rv, $sth, @bind) : $rv; |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
0
|
|
|
0
|
1
|
|
sub last_insert_id { shift->_identity } |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
# handles TEXT/IMAGE and transaction for last_insert_id |
334
|
|
|
|
|
|
|
sub insert { |
335
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
336
|
0
|
|
|
|
|
|
my ($source, $to_insert) = @_; |
337
|
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
|
my $columns_info = $source->columns_info; |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
my ($identity_col) = grep |
341
|
0
|
|
|
|
|
|
{ $columns_info->{$_}{is_auto_increment} } |
|
0
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
keys %$columns_info |
343
|
|
|
|
|
|
|
; |
344
|
|
|
|
|
|
|
|
345
|
0
|
0
|
|
|
|
|
$identity_col = '' if ! defined $identity_col; |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# FIXME - this is duplication from DBI.pm. When refactored towards |
348
|
|
|
|
|
|
|
# the LobWriter this can be folded back where it belongs. |
349
|
0
|
0
|
|
|
|
|
local $self->{_autoinc_supplied_for_op} = exists $to_insert->{$identity_col} |
350
|
|
|
|
|
|
|
? 1 |
351
|
|
|
|
|
|
|
: 0 |
352
|
|
|
|
|
|
|
; |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
local $self->{_perform_autoinc_retrieval} = $self->{_autoinc_supplied_for_op} |
355
|
|
|
|
|
|
|
? undef |
356
|
0
|
0
|
|
|
|
|
: $identity_col |
357
|
|
|
|
|
|
|
; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# check for empty insert |
360
|
|
|
|
|
|
|
# INSERT INTO foo DEFAULT VALUES -- does not work with Sybase |
361
|
|
|
|
|
|
|
# try to insert explicit 'DEFAULT's instead (except for identity, timestamp |
362
|
|
|
|
|
|
|
# and computed columns) |
363
|
0
|
0
|
|
|
|
|
if (not %$to_insert) { |
364
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
|
my $ci; |
366
|
|
|
|
|
|
|
# same order as add_columns |
367
|
0
|
|
|
|
|
|
for my $col ($source->columns) { |
368
|
0
|
0
|
|
|
|
|
next if $col eq $identity_col; |
369
|
|
|
|
|
|
|
|
370
|
0
|
|
0
|
|
|
|
my $info = ( $ci ||= $source->columns_info )->{$col}; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
next if ( |
373
|
|
|
|
|
|
|
ref $info->{default_value} eq 'SCALAR' |
374
|
|
|
|
|
|
|
or |
375
|
|
|
|
|
|
|
( |
376
|
|
|
|
|
|
|
exists $info->{data_type} |
377
|
|
|
|
|
|
|
and |
378
|
|
|
|
|
|
|
! defined $info->{data_type} |
379
|
|
|
|
|
|
|
) |
380
|
|
|
|
|
|
|
or |
381
|
|
|
|
|
|
|
( |
382
|
0
|
0
|
0
|
|
|
|
( $info->{data_type} || '' ) |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
383
|
|
|
|
|
|
|
=~ /^timestamp\z/i |
384
|
|
|
|
|
|
|
) |
385
|
|
|
|
|
|
|
); |
386
|
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
$to_insert->{$col} = \'DEFAULT'; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
0
|
|
|
|
|
|
my $blob_cols = $self->_remove_blob_cols($source, $to_insert); |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
# if a new txn is needed - it must happen on the _writer/new connection (for now) |
394
|
0
|
|
|
|
|
|
my $guard; |
395
|
0
|
0
|
0
|
|
|
|
if ( |
|
|
|
0
|
|
|
|
|
396
|
|
|
|
|
|
|
! $self->transaction_depth |
397
|
|
|
|
|
|
|
and |
398
|
|
|
|
|
|
|
( |
399
|
|
|
|
|
|
|
$blob_cols |
400
|
|
|
|
|
|
|
or |
401
|
|
|
|
|
|
|
# do we need the horrific SELECT MAX(COL) hack? |
402
|
|
|
|
|
|
|
( |
403
|
|
|
|
|
|
|
$self->_perform_autoinc_retrieval |
404
|
|
|
|
|
|
|
and |
405
|
|
|
|
|
|
|
( ($self->_identity_method||'') ne '@@IDENTITY' ) |
406
|
|
|
|
|
|
|
) |
407
|
|
|
|
|
|
|
) |
408
|
|
|
|
|
|
|
) { |
409
|
0
|
|
|
|
|
|
$self = $self->_writer_storage; |
410
|
0
|
|
|
|
|
|
$guard = $self->txn_scope_guard; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
0
|
|
|
|
|
|
my $updated_cols = $self->next::method ($source, $to_insert); |
414
|
|
|
|
|
|
|
|
415
|
0
|
0
|
|
|
|
|
$self->_insert_blobs ( |
|
|
0
|
|
|
|
|
|
416
|
|
|
|
|
|
|
$source, |
417
|
|
|
|
|
|
|
$blob_cols, |
418
|
|
|
|
|
|
|
{ |
419
|
|
|
|
|
|
|
( $identity_col |
420
|
|
|
|
|
|
|
? ( $identity_col => $self->last_insert_id($source, $identity_col) ) |
421
|
|
|
|
|
|
|
: () |
422
|
|
|
|
|
|
|
), |
423
|
|
|
|
|
|
|
%$to_insert, |
424
|
|
|
|
|
|
|
%$updated_cols, |
425
|
|
|
|
|
|
|
}, |
426
|
|
|
|
|
|
|
) if $blob_cols; |
427
|
|
|
|
|
|
|
|
428
|
0
|
0
|
|
|
|
|
$guard->commit if $guard; |
429
|
|
|
|
|
|
|
|
430
|
0
|
|
|
|
|
|
return $updated_cols; |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub update { |
434
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
435
|
0
|
|
|
|
|
|
my ($source, $fields, $where, @rest) = @_; |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
# |
438
|
|
|
|
|
|
|
# When *updating* identities, ASE requires SET IDENTITY_UPDATE called |
439
|
|
|
|
|
|
|
# |
440
|
0
|
0
|
|
|
|
|
if (my $blob_cols = $self->_remove_blob_cols($source, $fields)) { |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
# If there are any blobs in $where, Sybase will return a descriptive error |
443
|
|
|
|
|
|
|
# message. |
444
|
|
|
|
|
|
|
# XXX blobs can still be used with a LIKE query, and this should be handled. |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# update+blob update(s) done atomically on separate connection |
447
|
0
|
|
|
|
|
|
$self = $self->_writer_storage; |
448
|
|
|
|
|
|
|
|
449
|
0
|
|
|
|
|
|
my $guard = $self->txn_scope_guard; |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
# First update the blob columns to be updated to '' (taken from $fields, where |
452
|
|
|
|
|
|
|
# it is originally put by _remove_blob_cols .) |
453
|
0
|
|
|
|
|
|
my %blobs_to_empty = map { ($_ => delete $fields->{$_}) } keys %$blob_cols; |
|
0
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
# We can't only update NULL blobs, because blobs cannot be in the WHERE clause. |
456
|
0
|
|
|
|
|
|
$self->next::method($source, \%blobs_to_empty, $where, @rest); |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
# Now update the blobs before the other columns in case the update of other |
459
|
|
|
|
|
|
|
# columns makes the search condition invalid. |
460
|
0
|
|
|
|
|
|
my $rv = $self->_update_blobs($source, $blob_cols, $where); |
461
|
|
|
|
|
|
|
|
462
|
0
|
0
|
|
|
|
|
if (keys %$fields) { |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
# Now set the identity update flags for the actual update |
465
|
|
|
|
|
|
|
local $self->{_autoinc_supplied_for_op} = grep |
466
|
0
|
|
|
|
|
|
{ $_->{is_auto_increment} } |
467
|
0
|
|
|
|
|
|
values %{ $source->columns_info([ keys %$fields ]) } |
|
0
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
; |
469
|
|
|
|
|
|
|
|
470
|
0
|
|
|
|
|
|
my $next = $self->next::can; |
471
|
0
|
|
|
|
|
|
my $args = \@_; |
472
|
|
|
|
|
|
|
return preserve_context { |
473
|
0
|
|
|
0
|
|
|
$self->$next(@$args); |
474
|
0
|
|
|
0
|
|
|
} after => sub { $guard->commit }; |
|
0
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
else { |
477
|
0
|
|
|
|
|
|
$guard->commit; |
478
|
0
|
|
|
|
|
|
return $rv; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
else { |
482
|
|
|
|
|
|
|
# Set the identity update flags for the actual update |
483
|
|
|
|
|
|
|
local $self->{_autoinc_supplied_for_op} = grep |
484
|
0
|
|
|
|
|
|
{ $_->{is_auto_increment} } |
485
|
0
|
|
|
|
|
|
values %{ $source->columns_info([ keys %$fields ]) } |
|
0
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
; |
487
|
|
|
|
|
|
|
|
488
|
0
|
|
|
|
|
|
return $self->next::method(@_); |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
sub _insert_bulk { |
493
|
0
|
|
|
0
|
|
|
my $self = shift; |
494
|
0
|
|
|
|
|
|
my ($source, $cols, $data) = @_; |
495
|
|
|
|
|
|
|
|
496
|
0
|
|
|
|
|
|
my $columns_info = $source->columns_info; |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
my ($identity_col) = |
499
|
0
|
|
|
|
|
|
grep { $columns_info->{$_}{is_auto_increment} } |
|
0
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
keys %$columns_info; |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# FIXME - this is duplication from DBI.pm. When refactored towards |
503
|
|
|
|
|
|
|
# the LobWriter this can be folded back where it belongs. |
504
|
|
|
|
|
|
|
local $self->{_autoinc_supplied_for_op} |
505
|
0
|
|
|
|
|
|
= grep { $_ eq $identity_col } @$cols; |
|
0
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
my $use_bulk_api = |
508
|
|
|
|
|
|
|
$self->_bulk_storage && |
509
|
0
|
|
0
|
|
|
|
$self->_get_dbh->{syb_has_blk}; |
510
|
|
|
|
|
|
|
|
511
|
0
|
0
|
0
|
|
|
|
if (! $use_bulk_api and ref($self->_dbi_connect_info->[0]) eq 'CODE') { |
512
|
0
|
|
|
|
|
|
carp_unique( join ' ', |
513
|
|
|
|
|
|
|
'Bulk API support disabled due to use of a CODEREF connect_info.', |
514
|
|
|
|
|
|
|
'Reverting to regular array inserts.', |
515
|
|
|
|
|
|
|
); |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
|
518
|
0
|
0
|
|
|
|
|
if (not $use_bulk_api) { |
519
|
0
|
|
|
|
|
|
my $blob_cols = $self->_remove_blob_cols_array($source, $cols, $data); |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
# next::method uses a txn anyway, but it ends too early in case we need to |
522
|
|
|
|
|
|
|
# select max(col) to get the identity for inserting blobs. |
523
|
0
|
0
|
|
|
|
|
($self, my $guard) = $self->transaction_depth |
524
|
|
|
|
|
|
|
? ($self, undef) |
525
|
|
|
|
|
|
|
: ($self->_writer_storage, $self->_writer_storage->txn_scope_guard) |
526
|
|
|
|
|
|
|
; |
527
|
|
|
|
|
|
|
|
528
|
0
|
|
|
|
|
|
$self->next::method(@_); |
529
|
|
|
|
|
|
|
|
530
|
0
|
0
|
|
|
|
|
if ($blob_cols) { |
531
|
0
|
0
|
|
|
|
|
if ($self->_autoinc_supplied_for_op) { |
532
|
0
|
|
|
|
|
|
$self->_insert_blobs_array ($source, $blob_cols, $cols, $data); |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
else { |
535
|
0
|
|
|
|
|
|
my @cols_with_identities = (@$cols, $identity_col); |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
## calculate identities |
538
|
|
|
|
|
|
|
# XXX This assumes identities always increase by 1, which may or may not |
539
|
|
|
|
|
|
|
# be true. |
540
|
0
|
|
|
|
|
|
my ($last_identity) = |
541
|
|
|
|
|
|
|
$self->_dbh->selectrow_array ( |
542
|
|
|
|
|
|
|
$self->_fetch_identity_sql($source, $identity_col) |
543
|
|
|
|
|
|
|
); |
544
|
0
|
|
|
|
|
|
my @identities = (($last_identity - @$data + 1) .. $last_identity); |
545
|
|
|
|
|
|
|
|
546
|
0
|
|
|
|
|
|
my @data_with_identities = map [@$_, shift @identities], @$data; |
547
|
|
|
|
|
|
|
|
548
|
0
|
|
|
|
|
|
$self->_insert_blobs_array ( |
549
|
|
|
|
|
|
|
$source, $blob_cols, \@cols_with_identities, \@data_with_identities |
550
|
|
|
|
|
|
|
); |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
0
|
0
|
|
|
|
|
$guard->commit if $guard; |
555
|
|
|
|
|
|
|
|
556
|
0
|
|
|
|
|
|
return; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
# otherwise, use the bulk API |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
# rearrange @$data so that columns are in database order |
562
|
|
|
|
|
|
|
# and so we submit a full column list |
563
|
0
|
|
|
|
|
|
my %orig_order = map { $cols->[$_] => $_ } 0..$#$cols; |
|
0
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
|
565
|
0
|
|
|
|
|
|
my @source_columns = $source->columns; |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
# bcp identity index is 1-based |
568
|
0
|
|
|
|
|
|
my ($identity_idx) = grep { $source_columns[$_] eq $identity_col } (0..$#source_columns); |
|
0
|
|
|
|
|
|
|
569
|
0
|
0
|
|
|
|
|
$identity_idx = defined $identity_idx ? $identity_idx + 1 : 0; |
570
|
|
|
|
|
|
|
|
571
|
0
|
|
|
|
|
|
my @new_data; |
572
|
0
|
|
|
|
|
|
for my $slice_idx (0..$#$data) { |
573
|
|
|
|
|
|
|
push @new_data, [map { |
574
|
|
|
|
|
|
|
# identity data will be 'undef' if not _autoinc_supplied_for_op() |
575
|
|
|
|
|
|
|
# columns with defaults will also be 'undef' |
576
|
0
|
|
|
|
|
|
exists $orig_order{$_} |
577
|
0
|
0
|
|
|
|
|
? $data->[$slice_idx][$orig_order{$_}] |
578
|
|
|
|
|
|
|
: undef |
579
|
|
|
|
|
|
|
} @source_columns]; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
my $proto_bind = $self->_resolve_bindattrs( |
583
|
|
|
|
|
|
|
$source, |
584
|
|
|
|
|
|
|
[map { |
585
|
0
|
|
|
|
|
|
[ { dbic_colname => $source_columns[$_], _bind_data_slice_idx => $_ } |
|
0
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
=> $new_data[0][$_] ] |
587
|
|
|
|
|
|
|
} (0 ..$#source_columns) ], |
588
|
|
|
|
|
|
|
$columns_info |
589
|
|
|
|
|
|
|
); |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
## Set a client-side conversion error handler, straight from DBD::Sybase docs. |
592
|
|
|
|
|
|
|
# This ignores any data conversion errors detected by the client side libs, as |
593
|
|
|
|
|
|
|
# they are usually harmless. |
594
|
|
|
|
|
|
|
my $orig_cslib_cb = DBD::Sybase::set_cslib_cb( |
595
|
|
|
|
|
|
|
set_subname _insert_bulk_cslib_errhandler => sub { |
596
|
0
|
|
|
0
|
|
|
my ($layer, $origin, $severity, $errno, $errmsg, $osmsg, $blkmsg) = @_; |
597
|
|
|
|
|
|
|
|
598
|
0
|
0
|
|
|
|
|
return 1 if $errno == 36; |
599
|
|
|
|
|
|
|
|
600
|
0
|
0
|
|
|
|
|
carp |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
601
|
|
|
|
|
|
|
"Layer: $layer, Origin: $origin, Severity: $severity, Error: $errno" . |
602
|
|
|
|
|
|
|
($errmsg ? "\n$errmsg" : '') . |
603
|
|
|
|
|
|
|
($osmsg ? "\n$osmsg" : '') . |
604
|
|
|
|
|
|
|
($blkmsg ? "\n$blkmsg" : ''); |
605
|
|
|
|
|
|
|
|
606
|
0
|
|
|
|
|
|
return 0; |
607
|
0
|
|
|
|
|
|
}); |
608
|
|
|
|
|
|
|
|
609
|
0
|
|
|
|
|
|
my $exception = ''; |
610
|
|
|
|
|
|
|
dbic_internal_try { |
611
|
0
|
|
|
0
|
|
|
my $bulk = $self->_bulk_storage; |
612
|
|
|
|
|
|
|
|
613
|
0
|
|
|
|
|
|
my $guard = $bulk->txn_scope_guard; |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
## FIXME - once this is done - address the FIXME on finish() below |
616
|
|
|
|
|
|
|
## XXX get this to work instead of our own $sth |
617
|
|
|
|
|
|
|
## will require SQLA or *Hacks changes for ordered columns |
618
|
|
|
|
|
|
|
# $bulk->next::method($source, \@source_columns, \@new_data, { |
619
|
|
|
|
|
|
|
# syb_bcp_attribs => { |
620
|
|
|
|
|
|
|
# identity_flag => $self->_autoinc_supplied_for_op ? 1 : 0, |
621
|
|
|
|
|
|
|
# identity_column => $identity_idx, |
622
|
|
|
|
|
|
|
# } |
623
|
|
|
|
|
|
|
# }); |
624
|
0
|
|
|
|
|
|
my $sql = 'INSERT INTO ' . |
625
|
|
|
|
|
|
|
$bulk->sql_maker->_quote($source->name) . ' (' . |
626
|
|
|
|
|
|
|
# colname list is ignored for BCP, but does no harm |
627
|
|
|
|
|
|
|
(join ', ', map $bulk->sql_maker->_quote($_), @source_columns) . ') '. |
628
|
|
|
|
|
|
|
' VALUES ('. (join ', ', ('?') x @source_columns) . ')'; |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
## XXX there's a bug in the DBD::Sybase bulk support that makes $sth->finish for |
631
|
|
|
|
|
|
|
## a prepare_cached statement ineffective. Replace with ->sth when fixed, or |
632
|
|
|
|
|
|
|
## better yet the version above. Should be fixed in DBD::Sybase . |
633
|
0
|
0
|
|
|
|
|
my $sth = $bulk->_get_dbh->prepare($sql, |
634
|
|
|
|
|
|
|
# 'insert', # op |
635
|
|
|
|
|
|
|
{ |
636
|
|
|
|
|
|
|
syb_bcp_attribs => { |
637
|
|
|
|
|
|
|
identity_flag => $self->_autoinc_supplied_for_op ? 1 : 0, |
638
|
|
|
|
|
|
|
identity_column => $identity_idx, |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
); |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
{ |
644
|
|
|
|
|
|
|
# FIXME the $sth->finish in _execute_array does a rollback for some |
645
|
|
|
|
|
|
|
# reason. Disable it temporarily until we fix the SQLMaker thing above |
646
|
3
|
|
|
3
|
|
32
|
no warnings 'redefine'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
112
|
|
|
0
|
|
|
|
|
|
|
647
|
3
|
|
|
3
|
|
15
|
no strict 'refs'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
4435
|
|
648
|
0
|
|
|
|
|
|
local *{ref($sth).'::finish'} = sub {}; |
|
0
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
|
650
|
0
|
|
|
|
|
|
$self->_dbh_execute_for_fetch( |
651
|
|
|
|
|
|
|
$source, $sth, $proto_bind, \@source_columns, \@new_data |
652
|
|
|
|
|
|
|
); |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
|
655
|
0
|
|
|
|
|
|
$guard->commit; |
656
|
|
|
|
|
|
|
|
657
|
0
|
|
|
|
|
|
$bulk->_query_end($sql); |
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
dbic_internal_catch { |
660
|
0
|
|
|
0
|
|
|
$exception = $_; |
661
|
0
|
|
|
|
|
|
}; |
662
|
|
|
|
|
|
|
|
663
|
0
|
|
|
|
|
|
DBD::Sybase::set_cslib_cb($orig_cslib_cb); |
664
|
|
|
|
|
|
|
|
665
|
0
|
0
|
|
|
|
|
if ($exception =~ /-Y option/) { |
|
|
0
|
|
|
|
|
|
666
|
0
|
|
|
|
|
|
my $w = 'Sybase bulk API operation failed due to character set incompatibility, ' |
667
|
|
|
|
|
|
|
. 'reverting to regular array inserts. Try unsetting the LC_ALL environment variable' |
668
|
|
|
|
|
|
|
; |
669
|
0
|
0
|
|
|
|
|
$w .= "\n$exception" if $self->debug; |
670
|
0
|
|
|
|
|
|
carp $w; |
671
|
|
|
|
|
|
|
|
672
|
0
|
|
|
|
|
|
$self->_bulk_storage(undef); |
673
|
0
|
|
|
|
|
|
unshift @_, $self; |
674
|
0
|
|
|
|
|
|
goto \&_insert_bulk; |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
elsif ($exception) { |
677
|
|
|
|
|
|
|
# rollback makes the bulkLogin connection unusable |
678
|
0
|
|
|
|
|
|
$self->_bulk_storage->disconnect; |
679
|
0
|
|
|
|
|
|
$self->throw_exception($exception); |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
# Make sure blobs are not bound as placeholders, and return any non-empty ones |
684
|
|
|
|
|
|
|
# as a hash. |
685
|
|
|
|
|
|
|
sub _remove_blob_cols { |
686
|
0
|
|
|
0
|
|
|
my ($self, $source, $fields) = @_; |
687
|
|
|
|
|
|
|
|
688
|
0
|
|
|
|
|
|
my %blob_cols; |
689
|
|
|
|
|
|
|
|
690
|
0
|
|
|
|
|
|
for my $col (keys %$fields) { |
691
|
0
|
0
|
|
|
|
|
if ($self->_is_lob_column($source, $col)) { |
692
|
0
|
|
|
|
|
|
my $blob_val = delete $fields->{$col}; |
693
|
0
|
0
|
|
|
|
|
if (not defined $blob_val) { |
694
|
0
|
|
|
|
|
|
$fields->{$col} = \'NULL'; |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
else { |
697
|
0
|
|
|
|
|
|
$fields->{$col} = \"''"; |
698
|
0
|
0
|
|
|
|
|
$blob_cols{$col} = $blob_val |
699
|
|
|
|
|
|
|
if length $blob_val; |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
0
|
0
|
|
|
|
|
return %blob_cols ? \%blob_cols : undef; |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
# same for _insert_bulk |
708
|
|
|
|
|
|
|
sub _remove_blob_cols_array { |
709
|
0
|
|
|
0
|
|
|
my ($self, $source, $cols, $data) = @_; |
710
|
|
|
|
|
|
|
|
711
|
0
|
|
|
|
|
|
my @blob_cols; |
712
|
|
|
|
|
|
|
|
713
|
0
|
|
|
|
|
|
for my $i (0..$#$cols) { |
714
|
0
|
|
|
|
|
|
my $col = $cols->[$i]; |
715
|
|
|
|
|
|
|
|
716
|
0
|
0
|
|
|
|
|
if ($self->_is_lob_column($source, $col)) { |
717
|
0
|
|
|
|
|
|
for my $j (0..$#$data) { |
718
|
0
|
|
|
|
|
|
my $blob_val = delete $data->[$j][$i]; |
719
|
0
|
0
|
|
|
|
|
if (not defined $blob_val) { |
720
|
0
|
|
|
|
|
|
$data->[$j][$i] = \'NULL'; |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
else { |
723
|
0
|
|
|
|
|
|
$data->[$j][$i] = \"''"; |
724
|
0
|
0
|
|
|
|
|
$blob_cols[$j][$i] = $blob_val |
725
|
|
|
|
|
|
|
if length $blob_val; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
} |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
0
|
0
|
|
|
|
|
return @blob_cols ? \@blob_cols : undef; |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
sub _update_blobs { |
735
|
0
|
|
|
0
|
|
|
my ($self, $source, $blob_cols, $where) = @_; |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
my @primary_cols = |
738
|
|
|
|
|
|
|
dbic_internal_try { |
739
|
0
|
|
|
0
|
|
|
$source->_pri_cols_or_die |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
dbic_internal_catch { |
742
|
0
|
|
|
0
|
|
|
$self->throw_exception("Cannot update TEXT/IMAGE column(s): $_") |
743
|
|
|
|
|
|
|
} |
744
|
0
|
|
|
|
|
|
; |
745
|
|
|
|
|
|
|
|
746
|
0
|
|
|
|
|
|
my @pks_to_update; |
747
|
0
|
0
|
0
|
|
|
|
if ( |
748
|
|
|
|
|
|
|
ref $where eq 'HASH' |
749
|
|
|
|
|
|
|
and |
750
|
0
|
|
|
|
|
|
! grep { ! defined $where->{$_} } @primary_cols |
751
|
|
|
|
|
|
|
) { |
752
|
0
|
|
|
|
|
|
my %row_to_update; |
753
|
0
|
|
|
|
|
|
@row_to_update{@primary_cols} = @{$where}{@primary_cols}; |
|
0
|
|
|
|
|
|
|
754
|
0
|
|
|
|
|
|
@pks_to_update = \%row_to_update; |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
else { |
757
|
0
|
|
|
|
|
|
my $cursor = $self->select ($source, \@primary_cols, $where, {}); |
758
|
|
|
|
|
|
|
@pks_to_update = map { |
759
|
0
|
|
|
|
|
|
my %row; @row{@primary_cols} = @$_; \%row |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
} $cursor->all; |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
0
|
|
|
|
|
|
for my $ident (@pks_to_update) { |
764
|
0
|
|
|
|
|
|
$self->_insert_blobs($source, $blob_cols, $ident); |
765
|
|
|
|
|
|
|
} |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
sub _insert_blobs { |
769
|
0
|
|
|
0
|
|
|
my ($self, $source, $blob_cols, $row_data) = @_; |
770
|
|
|
|
|
|
|
|
771
|
0
|
|
|
|
|
|
my $table = $source->name; |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
my @primary_cols = dbic_internal_try |
774
|
0
|
|
|
0
|
|
|
{ $source->_pri_cols_or_die } |
775
|
|
|
|
|
|
|
dbic_internal_catch { |
776
|
0
|
|
|
0
|
|
|
$self->throw_exception("Cannot update TEXT/IMAGE column(s): $_") |
777
|
0
|
|
|
|
|
|
}; |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
$self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values') |
780
|
0
|
0
|
|
|
|
|
if grep { ! defined $row_data->{$_} } @primary_cols; |
|
0
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
# if we are 2-phase inserting a blob - there is nothing to retrieve anymore, |
783
|
|
|
|
|
|
|
# regardless of the previous state of the flag |
784
|
|
|
|
|
|
|
local $self->{_perform_autoinc_retrieval} |
785
|
0
|
0
|
|
|
|
|
if $self->_perform_autoinc_retrieval; |
786
|
|
|
|
|
|
|
|
787
|
0
|
|
|
|
|
|
my %where = map {( $_ => $row_data->{$_} )} @primary_cols; |
|
0
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
|
789
|
0
|
|
|
|
|
|
for my $col (keys %$blob_cols) { |
790
|
0
|
|
|
|
|
|
my $blob = $blob_cols->{$col}; |
791
|
|
|
|
|
|
|
|
792
|
0
|
|
|
|
|
|
my $cursor = $self->select ($source, [$col], \%where, {}); |
793
|
0
|
|
|
|
|
|
$cursor->next; |
794
|
0
|
|
|
|
|
|
my $sth = $cursor->sth; |
795
|
|
|
|
|
|
|
|
796
|
0
|
0
|
|
|
|
|
if (not $sth) { |
797
|
0
|
|
|
|
|
|
$self->throw_exception( |
798
|
|
|
|
|
|
|
"Could not find row in table '$table' for blob update:\n" |
799
|
|
|
|
|
|
|
. dump_value \%where |
800
|
|
|
|
|
|
|
); |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
# FIXME - it is not clear if this is needed at all. But it's been |
804
|
|
|
|
|
|
|
# there since 2009 ( d867eedaa ), might as well let sleeping dogs |
805
|
|
|
|
|
|
|
# lie... sigh. |
806
|
0
|
|
|
|
|
|
weaken( my $wsth = $sth ); |
807
|
0
|
0
|
|
0
|
|
|
my $g = scope_guard { $wsth->finish if $wsth }; |
|
0
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
dbic_internal_try { |
810
|
0
|
|
|
0
|
|
|
do { |
811
|
0
|
0
|
|
|
|
|
$sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr; |
812
|
|
|
|
|
|
|
} while $sth->fetch; |
813
|
|
|
|
|
|
|
|
814
|
0
|
0
|
|
|
|
|
$sth->func('ct_prepare_send') or die $sth->errstr; |
815
|
|
|
|
|
|
|
|
816
|
0
|
|
|
|
|
|
my $log_on_update = $self->_blob_log_on_update; |
817
|
0
|
0
|
|
|
|
|
$log_on_update = 1 if not defined $log_on_update; |
818
|
|
|
|
|
|
|
|
819
|
0
|
0
|
|
|
|
|
$sth->func('CS_SET', 1, { |
820
|
|
|
|
|
|
|
total_txtlen => length($blob), |
821
|
|
|
|
|
|
|
log_on_update => $log_on_update |
822
|
|
|
|
|
|
|
}, 'ct_data_info') or die $sth->errstr; |
823
|
|
|
|
|
|
|
|
824
|
0
|
0
|
|
|
|
|
$sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr; |
825
|
|
|
|
|
|
|
|
826
|
0
|
0
|
|
|
|
|
$sth->func('ct_finish_send') or die $sth->errstr; |
827
|
|
|
|
|
|
|
} |
828
|
|
|
|
|
|
|
dbic_internal_catch { |
829
|
0
|
0
|
|
0
|
|
|
if ($self->_using_freetds) { |
830
|
0
|
|
|
|
|
|
$self->throw_exception ( |
831
|
|
|
|
|
|
|
"TEXT/IMAGE operation failed, probably because you are using FreeTDS: $_" |
832
|
|
|
|
|
|
|
); |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
else { |
835
|
0
|
|
|
|
|
|
$self->throw_exception($_); |
836
|
|
|
|
|
|
|
} |
837
|
0
|
|
|
|
|
|
}; |
838
|
|
|
|
|
|
|
} |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
sub _insert_blobs_array { |
842
|
0
|
|
|
0
|
|
|
my ($self, $source, $blob_cols, $cols, $data) = @_; |
843
|
|
|
|
|
|
|
|
844
|
0
|
|
|
|
|
|
for my $i (0..$#$data) { |
845
|
0
|
|
|
|
|
|
my $datum = $data->[$i]; |
846
|
|
|
|
|
|
|
|
847
|
0
|
|
|
|
|
|
my %row; |
848
|
0
|
|
|
|
|
|
@row{ @$cols } = @$datum; |
849
|
|
|
|
|
|
|
|
850
|
0
|
|
|
|
|
|
my %blob_vals; |
851
|
0
|
|
|
|
|
|
for my $j (0..$#$cols) { |
852
|
0
|
0
|
|
|
|
|
if (exists $blob_cols->[$i][$j]) { |
853
|
0
|
|
|
|
|
|
$blob_vals{ $cols->[$j] } = $blob_cols->[$i][$j]; |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
|
857
|
0
|
|
|
|
|
|
$self->_insert_blobs ($source, \%blob_vals, \%row); |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=head2 connect_call_datetime_setup |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
Used as: |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
on_connect_call => 'datetime_setup' |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
In L to set: |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
$dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z |
870
|
|
|
|
|
|
|
$dbh->do('set dateformat mdy'); # input fmt: 08/13/1979 18:08:55.080 |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
This works for both C and C columns, note that |
873
|
|
|
|
|
|
|
C columns only have minute precision. |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=cut |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
sub connect_call_datetime_setup { |
878
|
|
|
|
|
|
|
my $self = shift; |
879
|
|
|
|
|
|
|
my $dbh = $self->_get_dbh; |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
if ($dbh->can('syb_date_fmt')) { |
882
|
|
|
|
|
|
|
# amazingly, this works with FreeTDS |
883
|
|
|
|
|
|
|
$dbh->syb_date_fmt('ISO_strict'); |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
else { |
886
|
|
|
|
|
|
|
carp_once |
887
|
|
|
|
|
|
|
'Your DBD::Sybase is too old to support ' |
888
|
|
|
|
|
|
|
.'DBIx::Class::InflateColumn::DateTime, please upgrade!'; |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
# FIXME - in retrospect this is a rather bad US-centric choice |
891
|
|
|
|
|
|
|
# of format. Not changing as a bugwards compat, though in reality |
892
|
|
|
|
|
|
|
# the only piece that sees the results of $dt object formatting |
893
|
|
|
|
|
|
|
# (as opposed to parsing) is the database itself, so theoretically |
894
|
|
|
|
|
|
|
# changing both this SET command and the formatter definition of |
895
|
|
|
|
|
|
|
# ::S::D::Sybase::ASE::DateTime::Format below should be safe and |
896
|
|
|
|
|
|
|
# transparent |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
$dbh->do('SET DATEFORMAT mdy'); |
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
sub _exec_txn_begin { |
904
|
0
|
|
|
0
|
|
|
my $self = shift; |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
# bulkLogin=1 connections are always in a transaction, and can only call BEGIN |
907
|
|
|
|
|
|
|
# TRAN once. However, we need to make sure there's a $dbh. |
908
|
0
|
0
|
0
|
|
|
|
return if $self->_is_bulk_storage && $self->_dbh && $self->_began_bulk_work; |
|
|
|
0
|
|
|
|
|
909
|
|
|
|
|
|
|
|
910
|
0
|
|
|
|
|
|
$self->next::method(@_); |
911
|
|
|
|
|
|
|
|
912
|
0
|
0
|
|
|
|
|
$self->_began_bulk_work(1) if $self->_is_bulk_storage; |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
# savepoint support using ASE syntax |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
sub _exec_svp_begin { |
918
|
0
|
|
|
0
|
|
|
my ($self, $name) = @_; |
919
|
|
|
|
|
|
|
|
920
|
0
|
|
|
|
|
|
$self->_dbh->do("SAVE TRANSACTION $name"); |
921
|
|
|
|
|
|
|
} |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
# A new SAVE TRANSACTION with the same name releases the previous one. |
924
|
0
|
|
|
0
|
|
|
sub _exec_svp_release { 1 } |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
sub _exec_svp_rollback { |
927
|
0
|
|
|
0
|
|
|
my ($self, $name) = @_; |
928
|
|
|
|
|
|
|
|
929
|
0
|
|
|
|
|
|
$self->_dbh->do("ROLLBACK TRANSACTION $name"); |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
package # hide from PAUSE |
933
|
|
|
|
|
|
|
DBIx::Class::Storage::DBI::Sybase::ASE::DateTime::Format; |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
my $datetime_parse_format = '%Y-%m-%dT%H:%M:%S.%3NZ'; |
936
|
|
|
|
|
|
|
my $datetime_format_format = '%m/%d/%Y %H:%M:%S.%3N'; |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
my ($datetime_parser, $datetime_formatter); |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
sub parse_datetime { |
941
|
0
|
|
|
0
|
|
|
shift; |
942
|
0
|
|
|
|
|
|
require DateTime::Format::Strptime; |
943
|
0
|
|
0
|
|
|
|
$datetime_parser ||= DateTime::Format::Strptime->new( |
944
|
|
|
|
|
|
|
pattern => $datetime_parse_format, |
945
|
|
|
|
|
|
|
on_error => 'croak', |
946
|
|
|
|
|
|
|
); |
947
|
0
|
|
|
|
|
|
return $datetime_parser->parse_datetime(shift); |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
sub format_datetime { |
951
|
0
|
|
|
0
|
|
|
shift; |
952
|
0
|
|
|
|
|
|
require DateTime::Format::Strptime; |
953
|
0
|
|
0
|
|
|
|
$datetime_formatter ||= DateTime::Format::Strptime->new( |
954
|
|
|
|
|
|
|
pattern => $datetime_format_format, |
955
|
|
|
|
|
|
|
on_error => 'croak', |
956
|
|
|
|
|
|
|
); |
957
|
0
|
|
|
|
|
|
return $datetime_formatter->format_datetime(shift); |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
1; |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=head1 Schema::Loader Support |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
As of version C<0.05000>, L should work well with |
965
|
|
|
|
|
|
|
most versions of Sybase ASE. |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=head1 FreeTDS |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
This driver supports L compiled against FreeTDS |
970
|
|
|
|
|
|
|
(L) to the best of our ability, however it is |
971
|
|
|
|
|
|
|
recommended that you recompile L against the Sybase Open Client |
972
|
|
|
|
|
|
|
libraries. They are a part of the Sybase ASE distribution: |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
The Open Client FAQ is here: |
975
|
|
|
|
|
|
|
L. |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
Sybase ASE for Linux (which comes with the Open Client libraries) may be |
978
|
|
|
|
|
|
|
downloaded here: L. |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
To see if you're using FreeTDS run: |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
perl -MDBI -le 'my $dbh = DBI->connect($dsn, $user, $pass); print $dbh->{syb_oc_version}' |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
It is recommended to set C for your ASE server to C<5.0> in |
985
|
|
|
|
|
|
|
C. |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
Some versions or configurations of the libraries involved will not support |
988
|
|
|
|
|
|
|
placeholders, in which case the storage will be reblessed to |
989
|
|
|
|
|
|
|
L. |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
In some configurations, placeholders will work but will throw implicit type |
992
|
|
|
|
|
|
|
conversion errors for anything that's not expecting a string. In such a case, |
993
|
|
|
|
|
|
|
the C option from L is |
994
|
|
|
|
|
|
|
automatically set, which you may enable on connection with |
995
|
|
|
|
|
|
|
L. |
996
|
|
|
|
|
|
|
The type info for the Cs is taken from the |
997
|
|
|
|
|
|
|
L definitions in your Result classes, and |
998
|
|
|
|
|
|
|
are mapped to a Sybase type (if it isn't already) using a mapping based on |
999
|
|
|
|
|
|
|
L. |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
In other configurations, placeholders will work just as they do with the Sybase |
1002
|
|
|
|
|
|
|
Open Client libraries. |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
Inserts or updates of TEXT/IMAGE columns will B work with FreeTDS. |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
=head1 INSERTS WITH PLACEHOLDERS |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
With placeholders enabled, inserts are done in a transaction so that there are |
1009
|
|
|
|
|
|
|
no concurrency issues with getting the inserted identity value using |
1010
|
|
|
|
|
|
|
C |
1011
|
|
|
|
|
|
|
mode. |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
In addition, they are done on a separate connection so that it's possible to |
1014
|
|
|
|
|
|
|
have active cursors when doing an insert. |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
When using C transactions |
1017
|
|
|
|
|
|
|
are unnecessary and not used, as there are no concurrency issues with C |
1018
|
|
|
|
|
|
|
@@IDENTITY> which is a session variable. |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
=head1 TRANSACTIONS |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
Due to limitations of the TDS protocol and L, you cannot begin a |
1023
|
|
|
|
|
|
|
transaction while there are active cursors, nor can you use multiple active |
1024
|
|
|
|
|
|
|
cursors within a transaction. An active cursor is, for example, a |
1025
|
|
|
|
|
|
|
L that has been executed using C or |
1026
|
|
|
|
|
|
|
C but has not been exhausted or L. |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
For example, this will not work: |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
$schema->txn_do(sub { |
1031
|
|
|
|
|
|
|
my $rs = $schema->resultset('Book'); |
1032
|
|
|
|
|
|
|
while (my $result = $rs->next) { |
1033
|
|
|
|
|
|
|
$schema->resultset('MetaData')->create({ |
1034
|
|
|
|
|
|
|
book_id => $result->id, |
1035
|
|
|
|
|
|
|
... |
1036
|
|
|
|
|
|
|
}); |
1037
|
|
|
|
|
|
|
} |
1038
|
|
|
|
|
|
|
}); |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
This won't either: |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
my $first_row = $large_rs->first; |
1043
|
|
|
|
|
|
|
$schema->txn_do(sub { ... }); |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
Transactions done for inserts in C mode when placeholders are in use |
1046
|
|
|
|
|
|
|
are not affected, as they are done on an extra database handle. |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
Some workarounds: |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=over 4 |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
=item * use L |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=item * L another L |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
=item * load the data from your cursor with L |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=back |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
=head1 MAXIMUM CONNECTIONS |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
The TDS protocol makes separate connections to the server for active statements |
1063
|
|
|
|
|
|
|
in the background. By default the number of such connections is limited to 25, |
1064
|
|
|
|
|
|
|
on both the client side and the server side. |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
This is a bit too low for a complex L application, so on connection |
1067
|
|
|
|
|
|
|
the client side setting is set to C<256> (see L.) You |
1068
|
|
|
|
|
|
|
can override it to whatever setting you like in the DSN. |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
See |
1071
|
|
|
|
|
|
|
L |
1072
|
|
|
|
|
|
|
for information on changing the setting on the server side. |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
=head1 DATES |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
See L to setup date formats |
1077
|
|
|
|
|
|
|
for L. |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=head1 LIMITED QUERIES |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
Because ASE does not have a good way to limit results in SQL that works for |
1082
|
|
|
|
|
|
|
all types of queries, the limit dialect is set to |
1083
|
|
|
|
|
|
|
L. |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
Fortunately, ASE and L support cursors properly, so when |
1086
|
|
|
|
|
|
|
L is too slow |
1087
|
|
|
|
|
|
|
you can use the L |
1088
|
|
|
|
|
|
|
L attribute to simulate limited queries by skipping |
1089
|
|
|
|
|
|
|
over records. |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=head1 TEXT/IMAGE COLUMNS |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
L compiled with FreeTDS will B allow you to insert or update |
1094
|
|
|
|
|
|
|
C columns. |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
Setting C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use either: |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
$schema->storage->dbh->do("SET TEXTSIZE $bytes"); |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
or |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
$schema->storage->set_textsize($bytes); |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
instead. |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
However, the C you pass in |
1107
|
|
|
|
|
|
|
L is used to execute the |
1108
|
|
|
|
|
|
|
equivalent C command on connection. |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
See L for a |
1111
|
|
|
|
|
|
|
L setting you need to work |
1112
|
|
|
|
|
|
|
with C columns. |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
=head1 BULK API |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
The experimental L Bulk API support is used for |
1117
|
|
|
|
|
|
|
L in B context, in a transaction |
1118
|
|
|
|
|
|
|
on a separate connection. |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
To use this feature effectively, use a large number of rows for each |
1121
|
|
|
|
|
|
|
L call, eg.: |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
while (my $rows = $data_source->get_100_rows()) { |
1124
|
|
|
|
|
|
|
$rs->populate($rows); |
1125
|
|
|
|
|
|
|
} |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
B the L |
1128
|
|
|
|
|
|
|
calls in your C classes B list columns in database order for this |
1129
|
|
|
|
|
|
|
to work. Also, you may have to unset the C environment variable before |
1130
|
|
|
|
|
|
|
loading your app, as C is not yet supported in DBD::Sybase . |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
When inserting IMAGE columns using this method, you'll need to use |
1133
|
|
|
|
|
|
|
L as well. |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
=head1 COMPUTED COLUMNS |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
If you have columns such as: |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
created_dtm AS getdate() |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
represent them in your Result classes as: |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
created_dtm => { |
1144
|
|
|
|
|
|
|
data_type => undef, |
1145
|
|
|
|
|
|
|
default_value => \'getdate()', |
1146
|
|
|
|
|
|
|
is_nullable => 0, |
1147
|
|
|
|
|
|
|
inflate_datetime => 1, |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
The C must exist and must be C. Then empty inserts will work |
1151
|
|
|
|
|
|
|
on tables with such columns. |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
=head1 TIMESTAMP COLUMNS |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
C columns in Sybase ASE are not really timestamps, see: |
1156
|
|
|
|
|
|
|
L. |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
They should be defined in your Result classes as: |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
ts => { |
1161
|
|
|
|
|
|
|
data_type => 'timestamp', |
1162
|
|
|
|
|
|
|
is_nullable => 0, |
1163
|
|
|
|
|
|
|
inflate_datetime => 0, |
1164
|
|
|
|
|
|
|
} |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
The C< 0>> is necessary if you use |
1167
|
|
|
|
|
|
|
L, and most people do, and still want to |
1168
|
|
|
|
|
|
|
be able to read these values. |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
The values will come back as hexadecimal. |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
=head1 TODO |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
=over |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
=item * |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
Transitions to AutoCommit=0 (starting a transaction) mode by exhausting |
1179
|
|
|
|
|
|
|
any active cursors, using eager cursors. |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
=item * |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
Real limits and limited counts using stored procedures deployed on startup. |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
=item * |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
Blob update with a LIKE query on a blob, without invalidating the WHERE condition. |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
=item * |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
bulk_insert using prepare_cached (see comments.) |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
=back |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
=head1 FURTHER QUESTIONS? |
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
Check the list of L. |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
This module is free software L |
1202
|
|
|
|
|
|
|
by the L. You can |
1203
|
|
|
|
|
|
|
redistribute it and/or modify it under the same terms as the |
1204
|
|
|
|
|
|
|
L. |