lib/DBIx/Class/Storage/DBI/Sybase/Base.pm

   1 package # hide from PAUSE
   2     DBIx::Class::Storage::DBI::Sybase::Base;
   3
   4 use strict;
   5 use warnings;
   6
   7 use base qw/DBIx::Class::Storage::DBI/;
   8 use mro 'c3';
   9
  10 =head1 NAME
  11
  12 DBIx::Class::Storage::DBI::Sybase::Base - Common functionality for drivers using
  13 DBD::Sybase
  14
  15 =cut
  16
  17 sub _ping {
  18   my $self = shift;
  19
  20   my $dbh = $self->_dbh or return 0;
  21
  22   local $dbh->{RaiseError} = 1;
  23   eval {
  24     $dbh->do('select 1');
  25   };
  26
  27   return $@ ? 0 : 1;
  28 }
  29
  30 sub _placeholders_supported {
  31   my $self = shift;
  32   my $dbh  = $self->_dbh;
  33
  34   return eval {
  35 # There's also $dbh->{syb_dynamic_supported} but it can be inaccurate for this
  36 # purpose.
  37     local $dbh->{PrintError} = 0;
  38     $dbh->selectrow_array('select ?', {}, 1);
  39   };
  40 }
  41
  42 sub _placeholders_with_type_conversion_supported {
  43   my $self = shift;
  44   my $dbh  = $self->_dbh;
  45
  46   return eval {
  47     local $dbh->{PrintError} = 0;
  48 # this specifically tests a bind that is NOT a string
  49     $dbh->selectrow_array('select 1 where 1 = ?', {}, 1);
  50   };
  51 }
  52
  53 sub _set_max_connect {
  54   my $self = shift;
  55   my $val  = shift || 256;
  56
  57   my $dsn = $self->_dbi_connect_info->[0];
  58
  59   return if ref($dsn) eq 'CODE';
  60
  61   if ($dsn !~ /maxConnect=/) {
  62     $self->_dbi_connect_info->[0] = "$dsn;maxConnect=$val";
  63     my $connected = defined $self->_dbh;
  64     $self->disconnect;
  65     $self->ensure_connected if $connected;
  66   }
  67 }
  68
  69 sub _using_freetds {
  70   my $self = shift;
  71
  72   return $self->_dbh->{syb_oc_version} =~ /freetds/i;
  73 }
  74
  75 1;
  76
  77 =head1 AUTHORS
  78
  79 See L<DBIx::Class/CONTRIBUTORS>.
  80
  81 =head1 LICENSE
  82
  83 You may distribute this code under the same terms as Perl itself.
  84
  85 =cut