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