Commit | Line | Data |
4b3515a6 |
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 | |
a2f22854 |
36 | my $unpack_guids = sub { |
37 | my ($select, $col_infos, $data, $storage) = @_; |
4b3515a6 |
38 | |
39 | for my $select_idx (0..$#$select) { |
a2f22854 |
40 | next unless ( |
41 | defined $data->[$select_idx] |
42 | and |
43 | length($data->[$select_idx]) == 16 |
44 | ); |
4b3515a6 |
45 | |
a2f22854 |
46 | my $selected = $select->[$select_idx]; |
4b3515a6 |
47 | |
a2f22854 |
48 | my $data_type = $col_infos->{$select->[$select_idx]}{data_type} |
49 | or next; |
4b3515a6 |
50 | |
a2f22854 |
51 | $data->[$select_idx] = $storage->_uuid_to_str($data->[$select_idx]) |
52 | if $storage->_is_guid_type($data_type); |
4b3515a6 |
53 | } |
a2f22854 |
54 | }; |
4b3515a6 |
55 | |
4b3515a6 |
56 | |
a2f22854 |
57 | sub next { |
58 | my $self = shift; |
4b3515a6 |
59 | |
a2f22854 |
60 | my @row = $self->next::method(@_); |
4b3515a6 |
61 | |
a2f22854 |
62 | $unpack_guids->( |
63 | $self->args->[1], |
64 | $self->{_colinfos} ||= $self->storage->_resolve_column_info($self->args->[0]), |
65 | \@row, |
66 | $self->storage |
67 | ); |
4b3515a6 |
68 | |
a2f22854 |
69 | return @row; |
70 | } |
4b3515a6 |
71 | |
a2f22854 |
72 | sub all { |
73 | my $self = shift; |
4b3515a6 |
74 | |
a2f22854 |
75 | my @rows = $self->next::method(@_); |
4b3515a6 |
76 | |
a2f22854 |
77 | $unpack_guids->( |
78 | $self->args->[1], |
79 | $self->{_colinfos} ||= $self->storage->_resolve_column_info($self->args->[0]), |
80 | $_, |
81 | $self->storage |
82 | ) for @rows; |
4b3515a6 |
83 | |
4b3515a6 |
84 | |
85 | return @rows; |
86 | } |
87 | |
a2bd3796 |
88 | =head1 FURTHER QUESTIONS? |
4b3515a6 |
89 | |
a2bd3796 |
90 | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. |
4b3515a6 |
91 | |
a2bd3796 |
92 | =head1 COPYRIGHT AND LICENSE |
4b3515a6 |
93 | |
a2bd3796 |
94 | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> |
95 | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can |
96 | redistribute it and/or modify it under the same terms as the |
97 | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |
4b3515a6 |
98 | |
99 | =cut |
a2bd3796 |
100 | |
101 | 1; |
102 | |
4b3515a6 |
103 | # vim:sts=2 sw=2: |