Commit | Line | Data |
db8f81cf |
1 | package DBIx::Class::Storage::DBI::SQLAnywhere; |
f200d74b |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use base qw/DBIx::Class::Storage::DBI/; |
6 | use mro 'c3'; |
db8f81cf |
7 | use List::Util (); |
f200d74b |
8 | |
db8f81cf |
9 | __PACKAGE__->mk_group_accessors(simple => qw/ |
10 | _identity |
11 | /); |
12 | |
13 | =head1 NAME |
14 | |
2b0076be |
15 | DBIx::Class::Storage::DBI::SQLAnywhere - Driver for Sybase SQL Anywhere |
db8f81cf |
16 | |
17 | =head1 DESCRIPTION |
18 | |
4b8dd353 |
19 | This class implements autoincrements for Sybase SQL Anywhere, selects the |
20 | RowNumberOver limit implementation and provides |
21 | L<DBIx::Class::InflateColumn::DateTime> support. |
db8f81cf |
22 | |
23 | You need the C<DBD::SQLAnywhere> driver that comes with the SQL Anywhere |
24 | distribution, B<NOT> the one on CPAN. It is usually under a path such as: |
25 | |
2b0076be |
26 | /opt/sqlanywhere11/sdk/perl |
27 | |
28 | Recommended L<DBIx::Class::Storage::DBI/connect_info> settings: |
29 | |
30 | on_connect_call => 'datetime_setup' |
31 | |
32 | =head1 METHODS |
db8f81cf |
33 | |
34 | =cut |
35 | |
36 | sub last_insert_id { shift->_identity } |
37 | |
38 | sub insert { |
f200d74b |
39 | my $self = shift; |
db8f81cf |
40 | my ($source, $to_insert) = @_; |
41 | |
42 | my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert]); |
43 | |
44 | my $is_identity_insert = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) ) |
45 | ? 1 |
46 | : 0; |
47 | |
48 | my $identity_col = List::Util::first { |
49 | $source->column_info($_)->{is_auto_increment} |
50 | } $source->columns; |
51 | |
52 | if ((not $is_identity_insert) && $identity_col) { |
53 | my $dbh = $self->_get_dbh; |
54 | my $table_name = $source->from; |
55 | $table_name = $$table_name if ref $table_name; |
56 | |
57 | my ($identity) = $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')"); |
f200d74b |
58 | |
db8f81cf |
59 | $to_insert->{$identity_col} = $identity; |
60 | |
61 | $self->_identity($identity); |
f200d74b |
62 | } |
db8f81cf |
63 | |
64 | return $self->next::method(@_); |
65 | } |
66 | |
2b0076be |
67 | # this sub stolen from DB2 |
db8f81cf |
68 | |
69 | sub _sql_maker_opts { |
70 | my ( $self, $opts ) = @_; |
71 | |
72 | if ( $opts ) { |
73 | $self->{_sql_maker_opts} = { %$opts }; |
74 | } |
75 | |
76 | return { limit_dialect => 'RowNumberOver', %{$self->{_sql_maker_opts}||{}} }; |
f200d74b |
77 | } |
78 | |
2b0076be |
79 | # this sub stolen from MSSQL |
80 | |
81 | sub build_datetime_parser { |
82 | my $self = shift; |
83 | my $type = "DateTime::Format::Strptime"; |
84 | eval "use ${type}"; |
85 | $self->throw_exception("Couldn't load ${type}: $@") if $@; |
86 | return $type->new( pattern => '%Y-%m-%d %H:%M:%S.%6N' ); |
87 | } |
88 | |
89 | =head2 connect_call_datetime_setup |
90 | |
91 | Used as: |
92 | |
93 | on_connect_call => 'datetime_setup' |
94 | |
95 | In L<DBIx::Class::Storage::DBI/connect_info> to set the date and timestamp |
96 | formats (as temporary options for the session) for use with |
97 | L<DBIx::Class::InflateColumn::DateTime>. |
98 | |
99 | The C<TIMESTAMP> data type supports up to 6 digits after the decimal point for |
100 | second precision. The full precision is used. |
101 | |
102 | The C<DATE> data type supposedly stores hours and minutes too, according to the |
103 | documentation, but I could not get that to work. It seems to only store the |
104 | date. |
105 | |
106 | You will need the L<DateTime::Format::Strptime> module for inflation to work. |
107 | |
108 | =cut |
109 | |
110 | sub connect_call_datetime_setup { |
111 | my $self = shift; |
112 | |
113 | $self->_do_query( |
114 | "set temporary option timestamp_format = 'yyyy-mm-dd hh:mm:ss.ssssss'" |
115 | ); |
116 | $self->_do_query( |
117 | "set temporary option date_format = 'yyyy-mm-dd hh:mm:ss.ssssss'" |
118 | ); |
119 | } |
120 | |
f200d74b |
121 | 1; |
db8f81cf |
122 | |
123 | =head1 AUTHOR |
124 | |
125 | See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>. |
126 | |
127 | =head1 LICENSE |
128 | |
129 | You may distribute this code under the same terms as Perl itself. |
130 | |
131 | =cut |