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