Commit | Line | Data |
726c8f65 |
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: |