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

   1 package DBIx::Class::Storage::DBI::Sybase::Base;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 DBIx::Class::Storage::DBI::Sybase::Base - Common functionality for drivers using
   9 L<DBD::Sybase>
  10
  11 =head1 METHODS
  12
  13 =head2 connected
  14
  15 Returns true if we have an open (and working) database connection, false if it
  16 is not (yet) open (or does not work). (Executes a simple SELECT to make sure it
  17 works.)
  18
  19 The reason this is needed is that L<DBD::Sybase>'s ping() does not work with an
  20 active statement handle, leading to masked database errors.
  21
  22 =cut
  23
  24 sub connected {
  25   my $self = shift;
  26
  27   my $super = eval { $self->next::method(@_) };
  28
  29   return $super unless $@;
  30
  31   my $dbh = $self->_dbh;
  32   local $dbh->{RaiseError} = 1;
  33
  34   eval {
  35     my $ping_sth = $dbh->prepare_cached("select 1");
  36     $ping_sth->execute;
  37     $ping_sth->finish;
  38   };
  39
  40   return $@ ? 0 : 1;
  41 }
  42
  43 1;
  44
  45 =head1 AUTHORS
  46
  47 See L<DBIx::Class/CONTRIBUTORS>.
  48
  49 =head1 LICENSE
  50
  51 You may distribute this code under the same terms as Perl itself.
  52
  53 =cut