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

   1 package DBIx::Class::Storage::DBI::ADO;
   2
   3 use warnings;
   4 use strict;
   5
   6 use base 'DBIx::Class::Storage::DBI';
   7 use mro 'c3';
   8
   9 use DBIx::Class::_Util qw( sigwarn_silencer modver_gt_or_eq set_subname );
  10 use namespace::clean;
  11
  12 =head1 NAME
  13
  14 DBIx::Class::Storage::DBI::ADO - Support for L<DBD::ADO>
  15
  16 =head1 DESCRIPTION
  17
  18 This class provides a mechanism for discovering and loading a sub-class
  19 for a specific ADO backend, as well as some workarounds for L<DBD::ADO>. It
  20 should be transparent to the user.
  21
  22 =cut
  23
  24 sub _rebless { shift->_determine_connector_driver('ADO') }
  25
  26 # cleanup some warnings from DBD::ADO
  27 # RT#65563, not fixed as of DBD::ADO v2.98
  28 sub _dbh_get_info {
  29   my $self = shift;
  30
  31   local $SIG{__WARN__} = sigwarn_silencer(
  32     qr{^Missing argument in sprintf at \S+/ADO/GetInfo\.pm}
  33   );
  34
  35   $self->next::method(@_);
  36 }
  37
  38 # Monkeypatch out the horrible warnings during global destruction.
  39 # A patch to DBD::ADO has been submitted as well, and it was fixed
  40 # as of 2.99
  41 # https://rt.cpan.org/Ticket/Display.html?id=65563
  42 sub _init {
  43   unless ($DBD::ADO::__DBIC_MONKEYPATCH_CHECKED__) {
  44     require DBD::ADO;
  45
  46     unless ( modver_gt_or_eq( 'DBD::ADO', '2.99' ) ) {
  47       no warnings 'redefine';
  48       my $disconnect = *DBD::ADO::db::disconnect{CODE};
  49
  50       *DBD::ADO::db::disconnect = set_subname 'DBD::ADO::db::disconnect' => sub {
  51         local $SIG{__WARN__} = sigwarn_silencer(
  52           qr/Not a Win32::OLE object|uninitialized value/
  53         );
  54         $disconnect->(@_);
  55       };
  56     }
  57
  58     $DBD::ADO::__DBIC_MONKEYPATCH_CHECKED__ = 1;
  59   }
  60 }
  61
  62 # Here I was just experimenting with ADO cursor types, left in as a comment in
  63 # case you want to as well. See the DBD::ADO docs.
  64 #sub _prepare_sth {
  65 #  my ($self, $dbh, $sql) = @_;
  66 #
  67 #  my $sth = $self->disable_sth_caching
  68 #    ? $dbh->prepare($sql, { CursorType => 'adOpenStatic' })
  69 #    : $dbh->prepare_cached($sql, { CursorType => 'adOpenStatic' }, 3);
  70 #
  71 #  $self->throw_exception($dbh->errstr) if !$sth;
  72 #
  73 #  $sth;
  74 #}
  75
  76 =head1 FURTHER QUESTIONS?
  77
  78 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
  79
  80 =head1 COPYRIGHT AND LICENSE
  81
  82 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
  83 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
  84 redistribute it and/or modify it under the same terms as the
  85 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
  86
  87 =cut
  88
  89 1;
  90
  91 # vim:sts=2 sw=2: