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