lib/DBIx/Class/Storage/DBI/ADO/MS_Jet/Cursor.pm

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