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

   1 package DBIx::Class::Storage::DBI::ADO;
   2
   3 use base 'DBIx::Class::Storage::DBI';
   4 use mro 'c3';
   5 use Try::Tiny;
   6 use namespace::clean;
   7
   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
  20 sub _rebless {
  21   my $self = shift;
  22
  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};
  48   };
  49
  50   $self->next::method(@_);
  51 }
  52
  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.
  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;
  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: