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 | |
15 | DBIx::Class::Storage::DBI::Sybase::ASA - Driver for Sybase SQL Anywhere |
16 | |
17 | =head1 DESCRIPTION |
18 | |
19 | This class implements autoincrements for Sybase SQL Anywhere and selects the |
20 | RowNumberOver limit implementation. |
21 | |
22 | You need the C<DBD::SQLAnywhere> driver that comes with the SQL Anywhere |
23 | distribution, B<NOT> the one on CPAN. It is usually under a path such as: |
24 | |
25 | /opt/sqlanywhere11/sdk/perl |
26 | |
27 | =cut |
28 | |
29 | sub last_insert_id { shift->_identity } |
30 | |
31 | sub insert { |
f200d74b |
32 | my $self = shift; |
db8f81cf |
33 | my ($source, $to_insert) = @_; |
34 | |
35 | my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert]); |
36 | |
37 | my $is_identity_insert = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) ) |
38 | ? 1 |
39 | : 0; |
40 | |
41 | my $identity_col = List::Util::first { |
42 | $source->column_info($_)->{is_auto_increment} |
43 | } $source->columns; |
44 | |
45 | if ((not $is_identity_insert) && $identity_col) { |
46 | my $dbh = $self->_get_dbh; |
47 | my $table_name = $source->from; |
48 | $table_name = $$table_name if ref $table_name; |
49 | |
50 | my ($identity) = $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')"); |
f200d74b |
51 | |
db8f81cf |
52 | $to_insert->{$identity_col} = $identity; |
53 | |
54 | $self->_identity($identity); |
f200d74b |
55 | } |
db8f81cf |
56 | |
57 | return $self->next::method(@_); |
58 | } |
59 | |
60 | # stolen from DB2 |
61 | |
62 | sub _sql_maker_opts { |
63 | my ( $self, $opts ) = @_; |
64 | |
65 | if ( $opts ) { |
66 | $self->{_sql_maker_opts} = { %$opts }; |
67 | } |
68 | |
69 | return { limit_dialect => 'RowNumberOver', %{$self->{_sql_maker_opts}||{}} }; |
f200d74b |
70 | } |
71 | |
72 | 1; |
db8f81cf |
73 | |
74 | =head1 AUTHOR |
75 | |
76 | See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>. |
77 | |
78 | =head1 LICENSE |
79 | |
80 | You may distribute this code under the same terms as Perl itself. |
81 | |
82 | =cut |