lib/DBIx/Class/Storage/DBI/SQLAnywhere/Cursor.pm

   1 package DBIx::Class::Storage::DBI::SQLAnywhere::Cursor;
   2
   3 use strict;
   4 use warnings;
   5 use base 'DBIx::Class::Storage::DBI::Cursor';
   6 use mro 'c3';
   7
   8 =head1 NAME
   9
  10 DBIx::Class::Storage::DBI::SQLAnywhere::Cursor - GUID Support for SQL Anywhere
  11 over L<DBD::SQLAnywhere>
  12
  13 =head1 DESCRIPTION
  14
  15 This class is for normalizing GUIDs retrieved from SQL Anywhere via
  16 L<DBD::SQLAnywhere>.
  17
  18 You probably don't want to be here, see
  19 L<DBIx::Class::Storage::DBI::SQLAnywhere> for information on the SQL Anywhere
  20 driver.
  21
  22 Unfortunately when using L<DBD::SQLAnywhere>, GUIDs come back in binary, the
  23 purpose of this class is to transform them to text.
  24 L<DBIx::Class::Storage::DBI::SQLAnywhere> sets
  25 L<cursor_class|DBIx::Class::Storage::DBI/cursor_class> to this class by default.
  26 It is overridable via your
  27 L<connect_info|DBIx::Class::Storage::DBI/connect_info>.
  28
  29 You can use L<DBIx::Class::Cursor::Cached> safely with this class and not lose
  30 the GUID normalizing functionality,
  31 L<::Cursor::Cached|DBIx::Class::Cursor::Cached> uses the underlying class data
  32 for the inner cursor class.
  33
  34 =cut
  35
  36 sub _dbh_next {
  37   my ($storage, $dbh, $self) = @_;
  38
  39   my $next = $self->next::can;
  40
  41   my @row = $next->(@_);
  42
  43   my $col_info = $storage->_resolve_column_info($self->args->[0]);
  44
  45   my $select = $self->args->[1];
  46
  47   for my $select_idx (0..$#$select) {
  48     my $selected = $select->[$select_idx];
  49
  50     next if ref $selected;
  51
  52     my $data_type = $col_info->{$selected}{data_type};
  53
  54     if ($storage->_is_guid_type($data_type)) {
  55       my $returned = $row[$select_idx];
  56
  57       if (length $returned == 16) {
  58         $row[$select_idx] = $storage->_uuid_to_str($returned);
  59       }
  60     }
  61   }
  62
  63   return @row;
  64 }
  65
  66 sub _dbh_all {
  67   my ($storage, $dbh, $self) = @_;
  68
  69   my $next = $self->next::can;
  70
  71   my @rows = $next->(@_);
  72
  73   my $col_info = $storage->_resolve_column_info($self->args->[0]);
  74
  75   my $select = $self->args->[1];
  76
  77   for my $row (@rows) {
  78     for my $select_idx (0..$#$select) {
  79       my $selected = $select->[$select_idx];
  80
  81       next if ref $selected;
  82
  83       my $data_type = $col_info->{$selected}{data_type};
  84
  85       if ($storage->_is_guid_type($data_type)) {
  86         my $returned = $row->[$select_idx];
  87
  88         if (length $returned == 16) {
  89           $row->[$select_idx] = $storage->_uuid_to_str($returned);
  90         }
  91       }
  92     }
  93   }
  94
  95   return @rows;
  96 }
  97
  98 1;
  99
 100 =head1 AUTHOR
 101
 102 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
 103
 104 =head1 LICENSE
 105
 106 You may distribute this code under the same terms as Perl itself.
 107
 108 =cut
 109 # vim:sts=2 sw=2: