From: Rafael Kitover Date: Sun, 6 Feb 2011 11:12:54 +0000 (-0500) Subject: rewrite SQLAnywhere GUID normalizing as a cursor_class (formerly a _select_args hack) X-Git-Tag: v0.08191~84 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=4b3515a668346eb157141db0d44d4c3282305c72 rewrite SQLAnywhere GUID normalizing as a cursor_class (formerly a _select_args hack) --- diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm index eee5cbb..92e8702 100644 --- a/lib/DBIx/Class/Storage/DBI/Cursor.pm +++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm @@ -9,7 +9,7 @@ use Try::Tiny; use namespace::clean; __PACKAGE__->mk_group_accessors('simple' => - qw/sth/ + qw/sth storage args pos attrs _dbh_gen/ ); =head1 NAME diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm b/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm index 15c801c..03a1afe 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm @@ -17,6 +17,18 @@ Anywhere through ODBC All functionality is provided by L, see that module for details. +=head1 CAVEATS + +=head2 uniqueidentifierstr data type + +If you use the C type with this driver, your queries may +fail with: + + Data truncated (SQL-01004) + +B use the C type instead, it is more efficient +anyway. + =head1 AUTHOR See L and L. diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm index 3705b9e..542dd56 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm @@ -6,6 +6,7 @@ use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/; use mro 'c3'; use List::Util 'first'; use Try::Tiny; +use DBIx::Class::Storage::DBI::SQLAnywhere::Cursor (); use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/_identity/); @@ -14,14 +15,19 @@ __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: @@ -83,9 +89,28 @@ sub _prefetch_autovalues { 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); @@ -95,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 diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere/Cursor.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere/Cursor.pm new file mode 100644 index 0000000..8c9f533 --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere/Cursor.pm @@ -0,0 +1,109 @@ +package DBIx::Class::Storage::DBI::SQLAnywhere::Cursor; + +use strict; +use warnings; +use base 'DBIx::Class::Storage::DBI::Cursor'; +use mro 'c3'; + +=head1 NAME + +DBIx::Class::Storage::DBI::SQLAnywhere::Cursor - GUID Support for SQL Anywhere +over L + +=head1 DESCRIPTION + +This class is for normalizing GUIDs retrieved from SQL Anywhere via +L. + +You probably don't want to be here, see +L for information on the SQL Anywhere +driver. + +Unfortunately when using L, GUIDs come back in binary, the +purpose of this class is to transform them to text. +L sets +L to this class by default. +It is overridable via your +L. + +You can use L safely with this class and not lose +the GUID normalizing functionality, +L<::Cursor::Cached|DBIx::Class::Cursor::Cached> uses the underlying class data +for the inner cursor class. + +=cut + +sub _dbh_next { + my ($storage, $dbh, $self) = @_; + + my $next = $self->next::can; + + my @row = $next->(@_); + + my $col_info = $storage->_resolve_column_info($self->args->[0]); + + my $select = $self->args->[1]; + + for my $select_idx (0..$#$select) { + my $selected = $select->[$select_idx]; + + next if ref $selected; + + my $data_type = $col_info->{$selected}{data_type}; + + if ($storage->_is_guid_type($data_type)) { + my $returned = $row[$select_idx]; + + if (length $returned == 16) { + $row[$select_idx] = $storage->_uuid_to_str($returned); + } + } + } + + return @row; +} + +sub _dbh_all { + my ($storage, $dbh, $self) = @_; + + my $next = $self->next::can; + + my @rows = $next->(@_); + + my $col_info = $storage->_resolve_column_info($self->args->[0]); + + my $select = $self->args->[1]; + + for my $row (@rows) { + for my $select_idx (0..$#$select) { + my $selected = $select->[$select_idx]; + + next if ref $selected; + + my $data_type = $col_info->{$selected}{data_type}; + + if ($storage->_is_guid_type($data_type)) { + my $returned = $row->[$select_idx]; + + if (length $returned == 16) { + $row->[$select_idx] = $storage->_uuid_to_str($returned); + } + } + } + } + + return @rows; +} + +1; + +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut +# vim:sts=2 sw=2: diff --git a/t/749sqlanywhere.t b/t/749sqlanywhere.t index e086065..7189898 100644 --- a/t/749sqlanywhere.t +++ b/t/749sqlanywhere.t @@ -4,6 +4,7 @@ use warnings; use Test::More; use Test::Exception; use Scope::Guard (); +use Try::Tiny; use lib qw(t/lib); use DBICTest; @@ -167,7 +168,8 @@ EOF my @uuid_types = qw/uniqueidentifier uniqueidentifierstr/; -# test uniqueidentifiers +# test uniqueidentifiers (and the cursor_class). + for my $uuid_type (@uuid_types) { local $schema->source('ArtistGUID')->column_info('artistid')->{data_type} = $uuid_type; @@ -190,6 +192,9 @@ CREATE TABLE artist_guid ( SQL }); + local $TODO = 'something wrong with uniqueidentifierstr over ODBC' + if $dsn =~ /:ODBC:/ && $uuid_type eq 'uniqueidentifierstr'; + my $row; lives_ok { $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' }) @@ -207,14 +212,35 @@ SQL ); diag $@ if $@; - my $row_from_db = $schema->resultset('ArtistGUID') - ->search({ name => 'mtfnpy' })->first; + my $row_from_db = try { $schema->resultset('ArtistGUID') + ->search({ name => 'mtfnpy' })->first } + catch { diag $_ }; + + is try { $row_from_db->artistid }, $row->artistid, + 'PK GUID round trip (via ->search->next)'; + + is try { $row_from_db->a_guid }, $row->a_guid, + 'NON-PK GUID round trip (via ->search->next)'; + + $row_from_db = try { $schema->resultset('ArtistGUID') + ->find($row->artistid) } + catch { diag $_ }; + + is try { $row_from_db->artistid }, $row->artistid, + 'PK GUID round trip (via ->find)'; + + is try { $row_from_db->a_guid }, $row->a_guid, + 'NON-PK GUID round trip (via ->find)'; + + ($row_from_db) = try { $schema->resultset('ArtistGUID') + ->search({ name => 'mtfnpy' })->all } + catch { diag $_ }; - is $row_from_db->artistid, $row->artistid, - 'PK GUID round trip'; + is try { $row_from_db->artistid }, $row->artistid, + 'PK GUID round trip (via ->search->all)'; - is $row_from_db->a_guid, $row->a_guid, - 'NON-PK GUID round trip'; + is try { $row_from_db->a_guid }, $row->a_guid, + 'NON-PK GUID round trip (via ->search->all)'; } }