Comprehensive MSAccess support over both DBD::ODBC and DBD::ADO
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / ADO / MS_Jet / Cursor.pm
CommitLineData
726c8f65 1package DBIx::Class::Storage::DBI::ADO::MS_Jet::Cursor;
2
3use strict;
4use warnings;
5use base 'DBIx::Class::Storage::DBI::Cursor';
6use mro 'c3';
7
8=head1 NAME
9
10DBIx::Class::Storage::DBI::ADO::MS_Jet::Cursor - GUID Support for MS Access over
11ADO
12
13=head1 DESCRIPTION
14
15This class is for normalizing GUIDs retrieved from Microsoft Access over ADO.
16
17You probably don't want to be here, see
18L<DBIx::Class::Storage::DBI::ACCESS> for information on the Microsoft
19Access driver.
20
21Unfortunately when using L<DBD::ADO>, GUIDs come back wrapped in braces, the
22purpose of this class is to remove them.
23L<DBIx::Class::Storage::DBI::ADO::MS_Jet> sets
24L<cursor_class|DBIx::Class::Storage::DBI/cursor_class> to this class by default.
25It is overridable via your
26L<connect_info|DBIx::Class::Storage::DBI/connect_info>.
27
28You can use L<DBIx::Class::Cursor::Cached> safely with this class and not lose
29the GUID normalizing functionality,
30L<::Cursor::Cached|DBIx::Class::Cursor::Cached> uses the underlying class data
31for the inner cursor class.
32
33=cut
34
35sub _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
64sub _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
951;
96
97=head1 AUTHOR
98
99See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
100
101=head1 LICENSE
102
103You may distribute this code under the same terms as Perl itself.
104
105=cut
106
107# vim:sts=2 sw=2: