[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Sybase / Base.pm

package DBIx::Class::Storage::DBI::Sybase::Base;

use strict;
use warnings;

=head1 NAME

DBIx::Class::Storage::DBI::Sybase::Base - Common functionality for drivers using
DBD::Sybase

=head1 METHODS

=head2 connected

Returns true if we have an open (and working) database connection, false if it
is not (yet) open (or does not work). (Executes a simple SELECT to make sure it
works.)

The reason this is needed is that L<DBD::Sybase>'s ping() does not work with an
active statement handle, leading to masked database errors.

=cut

sub connected {
  my $self = shift;

  my $dbh = $self->_dbh;
  local $dbh->{RaiseError} = 1;
  eval {
    $dbh->do('select 1');
  };

  return $@ ? 0 : 1;
}

1;

=head1 AUTHORS

See L<DBIx::Class/CONTRIBUTORS>.

=head1 LICENSE

You may distribute this code under the same terms as Perl itself.

=cut
Commit	Line	Data
eabab5d0	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
2932b9a6	9	DBD::Sybase
eabab5d0	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
526dc858	27	my $dbh = $self->_dbh;
526dc858	28	local $dbh->{RaiseError} = 1;
eabab5d0	29	eval {
283fb613	30	$dbh->do('select 1');
eabab5d0	31	};
	32
	33	return $@ ? 0 : 1;
	34	}
	35
	36	1;
	37
	38	=head1 AUTHORS
	39
	40	See L<DBIx::Class/CONTRIBUTORS>.
	41
	42	=head1 LICENSE
	43
	44	You may distribute this code under the same terms as Perl itself.
	45
	46	=cut