X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSQLAnywhere.pm;h=b8309213d9450c384a5d56ff40c5d26e33165bb2;hb=56ad42bb48befbeb50953d197e7cb86bbc62686c;hp=5d9170db7e5532ae1d968fc3067f0471cf4e270f;hpb=fd323bf1046faa7de5a8c985268d80ec5b703361;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm index 5d9170d..b830921 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm @@ -4,23 +4,29 @@ use strict; use warnings; use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/; use mro 'c3'; -use List::Util (); +use List::Util 'first'; use Try::Tiny; use namespace::clean; -__PACKAGE__->mk_group_accessors(simple => qw/ - _identity -/); +__PACKAGE__->mk_group_accessors(simple => qw/_identity/); +__PACKAGE__->sql_limit_dialect ('RowNumberOver'); +__PACKAGE__->sql_quote_char ('"'); + +__PACKAGE__->new_guid('UUIDTOSTR(NEWID())'); + +# default to the UUID decoding cursor, overridable by the user +__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::SQLAnywhere::Cursor'); =head1 NAME -DBIx::Class::Storage::DBI::SQLAnywhere - Driver for Sybase SQL Anywhere +DBIx::Class::Storage::DBI::SQLAnywhere - Driver for SQL Anywhere =head1 DESCRIPTION -This class implements autoincrements for Sybase SQL Anywhere, selects the -RowNumberOver limit implementation and provides -L support. +This class implements autoincrements for SQL Anywhere and provides +L support and support for the +C type (via +L.) You need the C driver that comes with the SQL Anywhere distribution, B the one on CPAN. It is usually under a path such as: @@ -37,22 +43,28 @@ Recommended L settings: sub last_insert_id { shift->_identity } -sub _new_uuid { 'UUIDTOSTR(NEWID())' } - -sub insert { +sub _prefetch_autovalues { my $self = shift; - my ($source, $to_insert) = @_; + my ($source, $colinfo, $to_insert) = @_; - my $identity_col = List::Util::first { - $source->column_info($_)->{is_auto_increment} - } $source->columns; + my $values = $self->next::method(@_); + + my $identity_col = + first { $colinfo->{$_}{is_auto_increment} } keys %$colinfo; # user might have an identity PK without is_auto_increment +# +# FIXME we probably should not have supported the above, see what +# does it take to move away from it if (not $identity_col) { foreach my $pk_col ($source->primary_columns) { - if (not exists $to_insert->{$pk_col} && - $source->column_info($pk_col)->{data_type} !~ /^uniqueidentifier/i) - { + if ( + ! exists $to_insert->{$pk_col} + and + $colinfo->{$pk_col}{data_type} + and + $colinfo->{$pk_col}{data_type} !~ /^uniqueidentifier/i + ) { $identity_col = $pk_col; last; } @@ -69,17 +81,36 @@ sub insert { }; if (defined $identity) { - $to_insert->{$identity_col} = $identity; + $values->{$identity_col} = $identity; $self->_identity($identity); } } - return $self->next::method(@_); + return $values; } -# convert UUIDs to strings in selects -sub _select_args { +sub _uuid_to_str { + my ($self, $data) = @_; + + $data = unpack 'H*', $data; + + for my $pos (8, 13, 18, 23) { + substr($data, $pos, 0) = '-'; + } + + return $data; +} + +# select_single does not invoke a cursor object at all, hence UUID decoding happens +# here if the proper cursor class is set +sub select_single { my $self = shift; + + my @row = $self->next::method(@_); + + return @row + unless $self->cursor_class->isa('DBIx::Class::Storage::DBI::SQLAnywhere::Cursor'); + my ($ident, $select) = @_; my $col_info = $self->_resolve_column_info($ident); @@ -89,26 +120,19 @@ sub _select_args { next if ref $selected; - my $data_type = $col_info->{$selected}{data_type}; - - if ($data_type && lc($data_type) eq 'uniqueidentifier') { - $select->[$select_idx] = { UUIDTOSTR => $selected }; - } - } - - return $self->next::method(@_); -} - -# this sub stolen from DB2 + my $data_type = $col_info->{$selected}{data_type} + or next; -sub _sql_maker_opts { - my ( $self, $opts ) = @_; + if ($self->_is_guid_type($data_type)) { + my $returned = $row[$select_idx]; - if ( $opts ) { - $self->{_sql_maker_opts} = { %$opts }; + if (length $returned == 16) { + $row[$select_idx] = $self->_uuid_to_str($returned); + } + } } - return { limit_dialect => 'RowNumberOver', %{$self->{_sql_maker_opts}||{}} }; + return @row; } # this sub stolen from MSSQL @@ -158,19 +182,19 @@ sub connect_call_datetime_setup { ); } -sub _svp_begin { +sub _exec_svp_begin { my ($self, $name) = @_; - $self->_get_dbh->do("SAVEPOINT $name"); + $self->_dbh->do("SAVEPOINT $name"); } # can't release savepoints that have been rolled back -sub _svp_release { 1 } +sub _exec_svp_release { 1 } -sub _svp_rollback { +sub _exec_svp_rollback { my ($self, $name) = @_; - $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name") + $self->_dbh->do("ROLLBACK TO SAVEPOINT $name") } 1;