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