Commit | Line | Data |
56dca25f |
1 | package DBIx::Class::Storage::DBI::ADO; |
4ffa5700 |
2 | |
3 | use base 'DBIx::Class::Storage::DBI'; |
56dca25f |
4 | use mro 'c3'; |
ed7ab0f4 |
5 | use Try::Tiny; |
fd323bf1 |
6 | use namespace::clean; |
4ffa5700 |
7 | |
56dca25f |
8 | =head1 NAME |
9 | |
10 | DBIx::Class::Storage::DBI::ADO - Support for L<DBD::ADO> |
11 | |
12 | =head1 DESCRIPTION |
13 | |
14 | This class provides a mechanism for discovering and loading a sub-class |
15 | for a specific ADO backend, as well as some workarounds for L<DBD::ADO>. It |
16 | should be transparent to the user. |
17 | |
18 | =cut |
19 | |
4ffa5700 |
20 | sub _rebless { |
21 | my $self = shift; |
22 | |
56dca25f |
23 | my $dbtype = $self->_dbh_get_info(17); |
24 | |
25 | if (not $dbtype) { |
26 | warn 'Unable to determine ADO driver, failling back to generic support'; |
27 | return; |
28 | } |
29 | |
30 | $dbtype =~ s/\W/_/gi; |
31 | my $subclass = "DBIx::Class::Storage::DBI::ADO::${dbtype}"; |
32 | if ($self->load_optional_class($subclass) && !$self->isa($subclass)) { |
33 | bless $self, $subclass; |
34 | $self->_rebless; |
35 | } |
36 | } |
37 | |
38 | # cleanup some warnings from DBD::ADO |
39 | # RT#65563, not fixed as of DBD::ADO v2.98 |
40 | sub _dbh_get_info { |
41 | my $self = shift; |
42 | |
43 | my $warn_handler = $SIG{__WARN__} || sub { warn @_ }; |
44 | |
45 | local $SIG{__WARN__} = sub { |
46 | $warn_handler->(@_) |
47 | unless $_[0] =~ m{^Missing argument in sprintf at \S+/ADO/GetInfo\.pm}; |
52b420dd |
48 | }; |
56dca25f |
49 | |
50 | $self->next::method(@_); |
4ffa5700 |
51 | } |
52 | |
748eb620 |
53 | # Here I was just experimenting with ADO cursor types, left in as a comment in |
54 | # case you want to as well. See the DBD::ADO docs. |
4ffa5700 |
55 | #sub _dbh_sth { |
56 | # my ($self, $dbh, $sql) = @_; |
57 | # |
58 | # my $sth = $self->disable_sth_caching |
59 | # ? $dbh->prepare($sql, { CursorType => 'adOpenStatic' }) |
60 | # : $dbh->prepare_cached($sql, { CursorType => 'adOpenStatic' }, 3); |
61 | # |
62 | # $self->throw_exception($dbh->errstr) if !$sth; |
63 | # |
64 | # $sth; |
65 | #} |
66 | |
67 | 1; |
56dca25f |
68 | |
69 | =head1 AUTHOR |
70 | |
71 | See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>. |
72 | |
73 | =head1 LICENSE |
74 | |
75 | You may distribute this code under the same terms as Perl itself. |
76 | |
77 | =cut |
78 | # vim:sts=2 sw=2: |