Fix multiple storage regressions from 52416317
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Storage / DBI / SQLAnywhere.pm
CommitLineData
db8f81cf 1package DBIx::Class::Storage::DBI::SQLAnywhere;
f200d74b 2
3use strict;
4use warnings;
548d1627 5use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/;
f200d74b 6use mro 'c3';
6298a324 7use List::Util 'first';
52b420dd 8use Try::Tiny;
fd323bf1 9use namespace::clean;
f200d74b 10
6a247f33 11__PACKAGE__->mk_group_accessors(simple => qw/_identity/);
12__PACKAGE__->sql_limit_dialect ('RowNumberOver');
db8f81cf 13
14=head1 NAME
15
2b0076be 16DBIx::Class::Storage::DBI::SQLAnywhere - Driver for Sybase SQL Anywhere
db8f81cf 17
18=head1 DESCRIPTION
19
d5dedbd6 20This class implements autoincrements for Sybase SQL Anywhere and provides
4b8dd353 21L<DBIx::Class::InflateColumn::DateTime> support.
db8f81cf 22
23You need the C<DBD::SQLAnywhere> driver that comes with the SQL Anywhere
24distribution, B<NOT> the one on CPAN. It is usually under a path such as:
25
2b0076be 26 /opt/sqlanywhere11/sdk/perl
27
7df295ec 28Recommended L<connect_info|DBIx::Class::Storage::DBI/connect_info> settings:
2b0076be 29
30 on_connect_call => 'datetime_setup'
31
32=head1 METHODS
db8f81cf 33
34=cut
35
36sub last_insert_id { shift->_identity }
37
548d1627 38sub _new_uuid { 'UUIDTOSTR(NEWID())' }
39
e366f807 40sub _prefetch_autovalues {
f200d74b 41 my $self = shift;
db8f81cf 42 my ($source, $to_insert) = @_;
43
e366f807 44 my $values = $self->next::method(@_);
45
52416317 46 my $colinfo = $source->columns_info;
47
6298a324 48 my $identity_col =
e366f807 49 first { $colinfo->{$_}{is_auto_increment} } keys %$colinfo;
db8f81cf 50
cea43436 51# user might have an identity PK without is_auto_increment
52 if (not $identity_col) {
53 foreach my $pk_col ($source->primary_columns) {
52416317 54 if (
55 ! exists $to_insert->{$pk_col}
56 and
57 $colinfo->{$pk_col}{data_type}
58 and
59 $colinfo->{$pk_col}{data_type} !~ /^uniqueidentifier/i
60 ) {
cea43436 61 $identity_col = $pk_col;
62 last;
63 }
64 }
65 }
66
b0267fb7 67 if ($identity_col && (not exists $to_insert->{$identity_col})) {
db8f81cf 68 my $dbh = $self->_get_dbh;
69 my $table_name = $source->from;
70 $table_name = $$table_name if ref $table_name;
71
9780718f 72 my ($identity) = try {
73 $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')")
548d1627 74 };
75
76 if (defined $identity) {
e366f807 77 $values->{$identity_col} = $identity;
548d1627 78 $self->_identity($identity);
79 }
80 }
81
e366f807 82 return $values;
548d1627 83}
84
85# convert UUIDs to strings in selects
86sub _select_args {
87 my $self = shift;
88 my ($ident, $select) = @_;
89
7e5fec1c 90 my $col_info = $self->_resolve_column_info($ident);
548d1627 91
92 for my $select_idx (0..$#$select) {
93 my $selected = $select->[$select_idx];
f200d74b 94
548d1627 95 next if ref $selected;
db8f81cf 96
7e5fec1c 97 my $data_type = $col_info->{$selected}{data_type};
548d1627 98
7da56142 99 if ($data_type && lc($data_type) eq 'uniqueidentifier') {
548d1627 100 $select->[$select_idx] = { UUIDTOSTR => $selected };
101 }
f200d74b 102 }
db8f81cf 103
104 return $self->next::method(@_);
105}
106
2b0076be 107# this sub stolen from MSSQL
108
109sub build_datetime_parser {
110 my $self = shift;
111 my $type = "DateTime::Format::Strptime";
9780718f 112 try {
52b420dd 113 eval "require ${type}"
9780718f 114 }
115 catch {
116 $self->throw_exception("Couldn't load ${type}: $_");
117 };
118
2b0076be 119 return $type->new( pattern => '%Y-%m-%d %H:%M:%S.%6N' );
120}
121
122=head2 connect_call_datetime_setup
123
124Used as:
125
126 on_connect_call => 'datetime_setup'
127
7df295ec 128In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the date and
129timestamp formats (as temporary options for the session) for use with
2b0076be 130L<DBIx::Class::InflateColumn::DateTime>.
131
132The C<TIMESTAMP> data type supports up to 6 digits after the decimal point for
133second precision. The full precision is used.
134
135The C<DATE> data type supposedly stores hours and minutes too, according to the
136documentation, but I could not get that to work. It seems to only store the
137date.
138
139You will need the L<DateTime::Format::Strptime> module for inflation to work.
140
141=cut
142
143sub connect_call_datetime_setup {
144 my $self = shift;
145
146 $self->_do_query(
147 "set temporary option timestamp_format = 'yyyy-mm-dd hh:mm:ss.ssssss'"
148 );
149 $self->_do_query(
150 "set temporary option date_format = 'yyyy-mm-dd hh:mm:ss.ssssss'"
151 );
152}
153
9cf3db6f 154sub _svp_begin {
155 my ($self, $name) = @_;
156
157 $self->_get_dbh->do("SAVEPOINT $name");
158}
159
160# can't release savepoints that have been rolled back
161sub _svp_release { 1 }
162
163sub _svp_rollback {
164 my ($self, $name) = @_;
165
166 $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
167}
168
f200d74b 1691;
db8f81cf 170
270eecac 171=head1 MAXIMUM CURSORS
172
7df295ec 173A L<DBIx::Class> application can use a lot of cursors, due to the usage of
174L<prepare_cached|DBI/prepare_cached>.
270eecac 175
176The default cursor maximum is C<50>, which can be a bit too low. This limit can
177be turned off (or increased) by the DBA by executing:
178
179 set option max_statement_count = 0
180 set option max_cursor_count = 0
181
182Highly recommended.
183
db8f81cf 184=head1 AUTHOR
185
186See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
187
188=head1 LICENSE
189
190You may distribute this code under the same terms as Perl itself.
191
192=cut