Commit | Line | Data |
f200d74b |
1 | package DBIx::Class::Storage::DBI::Sybase::ASA; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use base qw/DBIx::Class::Storage::DBI/; |
6 | use mro 'c3'; |
7 | use List::Util (); |
8 | |
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 { |
32 | my $self = shift; |
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 | if (not $is_identity_insert) { |
42 | my ($identity_col) = grep $source->column_info($_)->{is_auto_increment}, |
54e39a07 |
43 | $source->columns; |
f200d74b |
44 | my $dbh = $self->_get_dbh; |
45 | my $table_name = $source->from; |
54e39a07 |
46 | $table_name = $$table_name if ref $table_name; |
f200d74b |
47 | |
48 | my ($identity) = $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')"); |
49 | |
50 | $to_insert->{$identity_col} = $identity; |
51 | |
52 | $self->_identity($identity); |
53 | } |
54 | |
55 | return $self->next::method(@_); |
56 | } |
57 | |
58 | # stolen from DB2 |
59 | |
60 | sub _sql_maker_opts { |
61 | my ( $self, $opts ) = @_; |
62 | |
63 | if ( $opts ) { |
64 | $self->{_sql_maker_opts} = { %$opts }; |
65 | } |
66 | |
67 | return { limit_dialect => 'RowNumberOver', %{$self->{_sql_maker_opts}||{}} }; |
68 | } |
69 | |
70 | 1; |
71 | |
72 | =head1 AUTHOR |
73 | |
74 | See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>. |
75 | |
76 | =head1 LICENSE |
77 | |
78 | You may distribute this code under the same terms as Perl itself. |
79 | |
80 | =cut |