I was wrong about 2d12a809 - the crash is real
[dbsrgits/DBIx-Class.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');
2b8cc2f2 13__PACKAGE__->sql_quote_char ('"');
db8f81cf 14
40d8d018 15__PACKAGE__->new_guid('UUIDTOSTR(NEWID())');
16
4b3515a6 17# default to the UUID decoding cursor, overridable by the user
18__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::SQLAnywhere::Cursor');
19
db8f81cf 20=head1 NAME
21
4b3515a6 22DBIx::Class::Storage::DBI::SQLAnywhere - Driver for SQL Anywhere
db8f81cf 23
24=head1 DESCRIPTION
25
4b3515a6 26This class implements autoincrements for SQL Anywhere and provides
27L<DBIx::Class::InflateColumn::DateTime> support and support for the
28C<uniqueidentifier> type (via
29L<DBIx::Class::Storage::DBI::SQLAnywhere::Cursor>.)
db8f81cf 30
31You need the C<DBD::SQLAnywhere> driver that comes with the SQL Anywhere
32distribution, B<NOT> the one on CPAN. It is usually under a path such as:
33
2b0076be 34 /opt/sqlanywhere11/sdk/perl
35
7df295ec 36Recommended L<connect_info|DBIx::Class::Storage::DBI/connect_info> settings:
2b0076be 37
38 on_connect_call => 'datetime_setup'
39
40=head1 METHODS
db8f81cf 41
42=cut
43
44sub last_insert_id { shift->_identity }
45
e366f807 46sub _prefetch_autovalues {
f200d74b 47 my $self = shift;
db8f81cf 48 my ($source, $to_insert) = @_;
49
e366f807 50 my $values = $self->next::method(@_);
51
52416317 52 my $colinfo = $source->columns_info;
53
6298a324 54 my $identity_col =
e366f807 55 first { $colinfo->{$_}{is_auto_increment} } keys %$colinfo;
db8f81cf 56
cea43436 57# user might have an identity PK without is_auto_increment
fabbd5cc 58#
59# FIXME we probably should not have supported the above, see what
60# does it take to move away from it
cea43436 61 if (not $identity_col) {
62 foreach my $pk_col ($source->primary_columns) {
52416317 63 if (
64 ! exists $to_insert->{$pk_col}
65 and
66 $colinfo->{$pk_col}{data_type}
67 and
68 $colinfo->{$pk_col}{data_type} !~ /^uniqueidentifier/i
69 ) {
cea43436 70 $identity_col = $pk_col;
71 last;
72 }
73 }
74 }
75
b0267fb7 76 if ($identity_col && (not exists $to_insert->{$identity_col})) {
db8f81cf 77 my $dbh = $self->_get_dbh;
78 my $table_name = $source->from;
79 $table_name = $$table_name if ref $table_name;
80
9780718f 81 my ($identity) = try {
82 $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')")
548d1627 83 };
84
85 if (defined $identity) {
e366f807 86 $values->{$identity_col} = $identity;
548d1627 87 $self->_identity($identity);
88 }
89 }
90
e366f807 91 return $values;
548d1627 92}
93
4b3515a6 94sub _uuid_to_str {
95 my ($self, $data) = @_;
96
97 $data = unpack 'H*', $data;
98
99 for my $pos (8, 13, 18, 23) {
100 substr($data, $pos, 0) = '-';
101 }
102
103 return $data;
104}
105
106# select_single does not invoke a cursor object at all, hence UUID decoding happens
107# here if the proper cursor class is set
108sub select_single {
548d1627 109 my $self = shift;
4b3515a6 110
111 my @row = $self->next::method(@_);
112
113 return @row
114 unless $self->cursor_class->isa('DBIx::Class::Storage::DBI::SQLAnywhere::Cursor');
115
548d1627 116 my ($ident, $select) = @_;
117
7e5fec1c 118 my $col_info = $self->_resolve_column_info($ident);
548d1627 119
120 for my $select_idx (0..$#$select) {
121 my $selected = $select->[$select_idx];
f200d74b 122
548d1627 123 next if ref $selected;
db8f81cf 124
4b3515a6 125 my $data_type = $col_info->{$selected}{data_type}
126 or next;
127
128 if ($self->_is_guid_type($data_type)) {
129 my $returned = $row[$select_idx];
548d1627 130
4b3515a6 131 if (length $returned == 16) {
132 $row[$select_idx] = $self->_uuid_to_str($returned);
133 }
548d1627 134 }
f200d74b 135 }
db8f81cf 136
4b3515a6 137 return @row;
db8f81cf 138}
139
2b0076be 140# this sub stolen from MSSQL
141
142sub build_datetime_parser {
143 my $self = shift;
144 my $type = "DateTime::Format::Strptime";
9780718f 145 try {
52b420dd 146 eval "require ${type}"
9780718f 147 }
148 catch {
149 $self->throw_exception("Couldn't load ${type}: $_");
150 };
151
2b0076be 152 return $type->new( pattern => '%Y-%m-%d %H:%M:%S.%6N' );
153}
154
155=head2 connect_call_datetime_setup
156
157Used as:
158
159 on_connect_call => 'datetime_setup'
160
7df295ec 161In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set the date and
162timestamp formats (as temporary options for the session) for use with
2b0076be 163L<DBIx::Class::InflateColumn::DateTime>.
164
165The C<TIMESTAMP> data type supports up to 6 digits after the decimal point for
166second precision. The full precision is used.
167
168The C<DATE> data type supposedly stores hours and minutes too, according to the
169documentation, but I could not get that to work. It seems to only store the
170date.
171
172You will need the L<DateTime::Format::Strptime> module for inflation to work.
173
174=cut
175
176sub connect_call_datetime_setup {
177 my $self = shift;
178
179 $self->_do_query(
180 "set temporary option timestamp_format = 'yyyy-mm-dd hh:mm:ss.ssssss'"
181 );
182 $self->_do_query(
183 "set temporary option date_format = 'yyyy-mm-dd hh:mm:ss.ssssss'"
184 );
185}
186
90d7422f 187sub _exec_svp_begin {
9cf3db6f 188 my ($self, $name) = @_;
189
90d7422f 190 $self->_dbh->do("SAVEPOINT $name");
9cf3db6f 191}
192
193# can't release savepoints that have been rolled back
90d7422f 194sub _exec_svp_release { 1 }
9cf3db6f 195
90d7422f 196sub _exec_svp_rollback {
9cf3db6f 197 my ($self, $name) = @_;
198
90d7422f 199 $self->_dbh->do("ROLLBACK TO SAVEPOINT $name")
9cf3db6f 200}
201
f200d74b 2021;
db8f81cf 203
270eecac 204=head1 MAXIMUM CURSORS
205
7df295ec 206A L<DBIx::Class> application can use a lot of cursors, due to the usage of
207L<prepare_cached|DBI/prepare_cached>.
270eecac 208
209The default cursor maximum is C<50>, which can be a bit too low. This limit can
210be turned off (or increased) by the DBA by executing:
211
212 set option max_statement_count = 0
213 set option max_cursor_count = 0
214
215Highly recommended.
216
db8f81cf 217=head1 AUTHOR
218
219See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
220
221=head1 LICENSE
222
223You may distribute this code under the same terms as Perl itself.
224
225=cut