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=23b2c49b17262ecf84307c9ffba88ed38ecc90cb;hp=e2efa1338a3762bfa03d1d749766aec52f7eb528;hpb=d5dedbd62928f65a9071b4d9b6d56c6b663a073b;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm index e2efa13..b830921 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm @@ -10,15 +10,23 @@ use namespace::clean; __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 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: @@ -35,21 +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 $values = $self->next::method(@_); my $identity_col = - first { $source->column_info($_)->{is_auto_increment} } $source->columns; + 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; } @@ -66,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); @@ -86,14 +120,19 @@ sub _select_args { next if ref $selected; - my $data_type = $col_info->{$selected}{data_type}; + my $data_type = $col_info->{$selected}{data_type} + or next; + + if ($self->_is_guid_type($data_type)) { + my $returned = $row[$select_idx]; - if ($data_type && lc($data_type) eq 'uniqueidentifier') { - $select->[$select_idx] = { UUIDTOSTR => $selected }; + if (length $returned == 16) { + $row[$select_idx] = $self->_uuid_to_str($returned); + } } } - return $self->next::method(@_); + return @row; } # this sub stolen from MSSQL @@ -143,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;