use strict;
use warnings;
-use Try::Tiny;
+use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch );
use namespace::clean;
use base qw/DBIx::Class::Storage::DBI/;
=cut
-sub _rebless {
- my $self = shift;
+sub _rebless { shift->_determine_connector_driver('Sybase') }
- my $dbtype;
- try {
- $dbtype = @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
- } catch {
- $self->throw_exception("Unable to estable connection to determine database type: $_")
- };
+sub _get_rdbms_name {
+ my $self = shift;
- if ($dbtype) {
- $dbtype =~ s/\W/_/gi;
+ dbic_internal_try {
+ my $name = $self->_get_dbh->selectrow_arrayref('sp_server_info @attribute_id=1')->[2];
- # saner class name
- $dbtype = 'ASE' if $dbtype eq 'SQL_Server';
+ if ($name) {
+ $name =~ s/\W/_/gi;
- my $subclass = __PACKAGE__ . "::$dbtype";
- if ($self->load_optional_class($subclass)) {
- bless $self, $subclass;
- $self->_rebless;
+ # saner class name
+ $name = 'ASE' if $name eq 'SQL_Server';
}
+
+ $name; # RV
}
+ dbic_internal_catch {
+ $self->throw_exception("Unable to establish connection to determine database type: $_")
+ };
}
sub _init {
# once the driver is determined see if we need to insert the DBD::Sybase w/ FreeTDS fixups
# this is a dirty version of "instance role application", \o/ DO WANT Moo \o/
my $self = shift;
- if (! $self->isa('DBIx::Class::Storage::DBI::Sybase::FreeTDS') and $self->using_freetds) {
+ if (! $self->isa('DBIx::Class::Storage::DBI::Sybase::FreeTDS') and $self->_using_freetds) {
require DBIx::Class::Storage::DBI::Sybase::FreeTDS;
my @isa = @{mro::get_linear_isa(ref $self)};
local $dbh->{RaiseError} = 1;
local $dbh->{PrintError} = 0;
-# FIXME if the main connection goes stale, does opening another for this statement
-# really determine anything?
-
- if ($dbh->{syb_no_child_con}) {
- return try {
- $self->_connect(@{$self->_dbi_connect_info || [] })
- ->do('select 1');
- 1;
- }
- catch {
- 0;
- };
- }
-
- return try {
- $dbh->do('select 1');
- 1;
- }
- catch {
- 0;
- };
+ ( dbic_internal_try { $dbh->do('select 1'); 1 } )
+ ? 1
+ : 0
+ ;
}
sub _set_max_connect {
}
}
-=head2 using_freetds
-
-Whether or not L<DBD::Sybase> was compiled against FreeTDS. If false, it means
-the Sybase OpenClient libraries were used.
-
-=cut
-
-sub using_freetds {
+# Whether or not DBD::Sybase was compiled against FreeTDS. If false, it means
+# the Sybase OpenClient libraries were used.
+sub _using_freetds {
my $self = shift;
-
return ($self->_get_dbh->{syb_oc_version}||'') =~ /freetds/i;
}
-1;
+# Either returns the FreeTDS version against which DBD::Sybase was compiled,
+# 0 if can't be determined, or undef otherwise
+sub _using_freetds_version {
+ my $inf = shift->_get_dbh->{syb_oc_version};
+ return undef unless ($inf||'') =~ /freetds/i;
+ return $inf =~ /v([0-9\.]+)/ ? $1 : 0;
+}
-=head1 AUTHORS
+=head1 FURTHER QUESTIONS?
-See L<DBIx::Class/CONTRIBUTORS>.
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
=cut
+
+1;
+