column in the GROUP BY clause
* Misc
+ - Refactored capability handling in Storage::DBI, allows for
+ standardized capability handling wrt query/enable/disable
- Makefile.PL no longer imports GetOptions() to interoperate
better with Catalyst installers
- Bumped minimum Module::Install for developers
my $updated_cols = $source->storage->insert(
$source,
{ $self->get_columns },
- (keys %auto_pri) && $source->storage->_supports_insert_returning
+ (keys %auto_pri) && $source->storage->_use_insert_returning
? { returning => [ sort { $auto_pri{$a} <=> $auto_pri{$b} } keys %auto_pri ] }
: ()
,
use File::Path 'make_path';
use namespace::clean;
+# default cursor class, overridable in connect_info attributes
+__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
+
+__PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class/);
+# default
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks');
+
__PACKAGE__->mk_group_accessors('simple' => qw/
_connect_info _dbi_connect_info _dbic_connect_attributes _driver_determined
- _dbh _server_info_hash _conn_pid _conn_tid _sql_maker _sql_maker_opts
+ _dbh _dbh_details _conn_pid _conn_tid _sql_maker _sql_maker_opts
transaction_depth _dbh_autocommit savepoints
/);
__PACKAGE__->mk_group_accessors('simple' => @storage_options);
-# default cursor class, overridable in connect_info attributes
-__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
+# capability definitions, using a 2-tiered accessor system
+# The rationale is:
+#
+# A driver/user may define _use_X, which blindly without any checks says:
+# "(do not) use this capability", (use_dbms_capability is an "inherited"
+# type accessor)
+#
+# If _use_X is undef, _supports_X is then queried. This is a "simple" style
+# accessor, which in turn calls _determine_supports_X, and stores the return
+# in a special slot on the storage object, which is wiped every time a $dbh
+# reconnection takes place (it is not guaranteed that upon reconnection we
+# will get the same rdbms version). _determine_supports_X does not need to
+# exist on a driver, as we ->can for it before calling.
+
+my @capabilities = (qw/insert_returning placeholders typeless_placeholders/);
+__PACKAGE__->mk_group_accessors( dbms_capability => map { "_supports_$_" } @capabilities );
+__PACKAGE__->mk_group_accessors( use_dbms_capability => map { "_use_$_" } @capabilities );
-__PACKAGE__->mk_group_accessors('inherited' => qw/
- sql_maker_class
- _supports_insert_returning
-/);
-__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks');
# Each of these methods need _determine_driver called before itself
# in order to function reliably. This is a purely DRY optimization
+#
+# get_(use)_dbms_capability need to be called on the correct Storage
+# class, as _use_X may be hardcoded class-wide, and _supports_X calls
+# _determine_supports_X which obv. needs a correct driver as well
my @rdbms_specific_methods = qw/
deployment_statements
sqlt_type
build_datetime_parser
datetime_parser_type
+
insert
insert_bulk
update
delete
select
select_single
+
+ get_use_dbms_capability
+ get_dbms_capability
/;
for my $meth (@rdbms_specific_methods) {
my $orig = __PACKAGE__->can ($meth)
- or next;
+ or die "$meth is not a ::Storage::DBI method!";
no strict qw/refs/;
no warnings qw/redefine/;
*{__PACKAGE__ ."::$meth"} = subname $meth => sub {
- if (not $_[0]->_driver_determined) {
+ if (not $_[0]->_driver_determined and not $_[0]->{_in_determine_driver}) {
$_[0]->_determine_driver;
goto $_[0]->can($meth);
}
$new->transaction_depth(0);
$new->_sql_maker_opts({});
+ $new->_dbh_details({});
$new->{savepoints} = [];
$new->{_in_dbh_do} = 0;
$new->{_dbh_gen} = 0;
my @info = @{$self->_dbi_connect_info || []};
$self->_dbh(undef); # in case ->connected failed we might get sent here
- $self->_server_info_hash (undef);
+ $self->_dbh_details({}); # reset everything we know
+
$self->_dbh($self->_connect(@info));
$self->_conn_pid($$);
$self->_do_connection_actions(connect_call_ => $_) for @actions;
}
+
+
+sub set_use_dbms_capability {
+ $_[0]->set_inherited ($_[1], $_[2]);
+}
+
+sub get_use_dbms_capability {
+ my ($self, $capname) = @_;
+
+ my $use = $self->get_inherited ($capname);
+ return defined $use
+ ? $use
+ : do { $capname =~ s/^_use_/_supports_/; $self->get_dbms_capability ($capname) }
+ ;
+}
+
+sub set_dbms_capability {
+ $_[0]->_dbh_details->{capability}{$_[1]} = $_[2];
+}
+
+sub get_dbms_capability {
+ my ($self, $capname) = @_;
+
+ my $cap = $self->_dbh_details->{capability}{$capname};
+
+ unless (defined $cap) {
+ if (my $meth = $self->can ("_determine$capname")) {
+ $cap = $self->$meth ? 1 : 0;
+ }
+ else {
+ $cap = 0;
+ }
+
+ $self->set_dbms_capability ($capname, $cap);
+ }
+
+ return $cap;
+}
+
sub _server_info {
my $self = shift;
- unless ($self->_server_info_hash) {
+ my $info;
+ unless ($info = $self->_dbh_details->{info}) {
- my %info;
+ $info = {};
my $server_version = try { $self->_get_server_version };
if (defined $server_version) {
- $info{dbms_version} = $server_version;
+ $info->{dbms_version} = $server_version;
my ($numeric_version) = $server_version =~ /^([\d\.]+)/;
my @verparts = split (/\./, $numeric_version);
}
push @use_parts, 0 while @use_parts < 3;
- $info{normalized_dbms_version} = sprintf "%d.%03d%03d", @use_parts;
+ $info->{normalized_dbms_version} = sprintf "%d.%03d%03d", @use_parts;
}
}
- $self->_server_info_hash(\%info);
+ $self->_dbh_details->{info} = $info;
}
- return $self->_server_info_hash
+ return $info;
}
sub _get_server_version {
}
# Check if placeholders are supported at all
-sub _placeholders_supported {
+sub _determine_supports_placeholders {
my $self = shift;
my $dbh = $self->_get_dbh;
# Check if placeholders bound to non-string types throw exceptions
#
-sub _typeless_placeholders_supported {
+sub _determine_supports_typeless_placeholders {
my $self = shift;
my $dbh = $self->_get_dbh;
=cut
-sub _supports_insert_returning { 1 }
+# set default
+__PACKAGE__->_use_insert_returning (1);
sub _sequence_fetch {
my ($self, $nextval, $sequence) = @_;
warn __PACKAGE__.": DBD::Pg 2.9.2 or greater is strongly recommended\n"
if ($DBD::Pg::VERSION < 2.009002); # pg uses (used?) version::qv()
-sub _supports_insert_returning {
- my $self = shift;
-
- return 1
- if $self->_server_info->{normalized_dbms_version} >= 8.002;
-
- return 0;
+sub _determine_supports_insert_returning {
+ return shift->_server_info->{normalized_dbms_version} >= 8.002
+ ? 1
+ : 0
+ ;
}
sub with_deferred_fk_checks {
backup
is_datatype_numeric
- _supports_insert_returning
_count_select
_subq_update_delete
svp_rollback
_parse_connect_do
_dbh_commit
_execute_array
- _placeholders_supported
savepoints
_sqlt_minimum_version
_sql_maker_opts
_conn_pid
- _typeless_placeholders_supported
_conn_tid
_dbh_autocommit
_native_data_type
_dbh_sth
_dbh_execute
_prefetch_insert_auto_nextvals
- _server_info_hash
/],
);
_preserve_foreign_dbh
_verify_pid
_verify_tid
+
+ get_use_dbms_capability
+ set_use_dbms_capability
+ get_dbms_capability
+ set_dbms_capability
+
+ _dbh_details
+
+ _use_insert_returning
+ _supports_insert_returning
+
+ _use_placeholders
+ _supports_placeholders
+ _determine_supports_placeholders
+
+ _use_typeless_placeholders
+ _supports_typeless_placeholders
+ _determine_supports_typeless_placeholders
);
for my $method (@unimplemented) {
return min map $_->_ping, $self->all_storages;
}
+# not using the normalized_version, because we want to preserve
+# version numbers much longer than the conventional xxx.yyyzzz
my $numify_ver = sub {
my $ver = shift;
my @numparts = split /\D+/, $ver;
- my $format = '%d.' . (join '', ('%05d') x (@numparts - 1));
+ my $format = '%d.' . (join '', ('%06d') x (@numparts - 1));
return sprintf $format, @numparts;
};
-
sub _server_info {
my $self = shift;
- if (not $self->_server_info_hash) {
- my $min_version_info = (
+ if (not $self->_dbh_details->{info}) {
+ $self->_dbh_details->{info} = (
reduce { $a->[0] < $b->[0] ? $a : $b }
map [ $numify_ver->($_->{dbms_version}), $_ ],
map $_->_server_info, $self->all_storages
)->[1];
-
- $self->_server_info_hash($min_version_info); # on master
}
- return $self->_server_info_hash;
+ return $self->next::method;
}
sub _get_server_version {
variable.
EOF
- if (not $self->_typeless_placeholders_supported) {
- if ($self->_placeholders_supported) {
+ if (not $self->_use_typeless_placeholders) {
+ if ($self->_use_placeholders) {
$self->auto_cast(1);
}
else {
$self->_rebless;
}
# this is highly unlikely, but we check just in case
- elsif (not $self->_typeless_placeholders_supported) {
+ elsif (not $self->_use_typeless_placeholders) {
$self->auto_cast(1);
}
}
my $dbh = $self->_get_dbh;
return if ref $self ne __PACKAGE__;
-
- if (not $self->_typeless_placeholders_supported) {
+ if (not $self->_use_typeless_placeholders) {
require
DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars;
bless $self,
use Test::More;
use Test::Exception;
+use Sub::Name;
use lib qw(t/lib);
use DBICTest;
our @test_classes; #< array that will be pushed into by test classes defined in this file
DBICTest::Schema->load_classes( map {s/.+:://;$_} @test_classes ) if @test_classes;
-my $test_server_supports_insert_returning = do {
- my $s = DBICTest::Schema->connect($dsn, $user, $pass);
- $s->storage->_determine_driver;
- $s->storage->_supports_insert_returning;
-};
-
-my $schema;
-
-for my $use_insert_returning ($test_server_supports_insert_returning
- ? (0,1)
- : (0)
-) {
- no warnings qw/redefine once/;
- local *DBIx::Class::Storage::DBI::Pg::_supports_insert_returning = sub {
- $use_insert_returning
- };
-
### pre-connect tests (keep each test separate as to make sure rebless() runs)
{
my $s = DBICTest::Schema->connect($dsn, $user, $pass);
ok (!$s->storage->_dbh, 'still not connected');
}
+
{
my $s = DBICTest::Schema->connect($dsn, $user, $pass);
# make sure sqlt_type overrides work (::Storage::DBI::Pg does this)
ok (!$s->storage->_dbh, 'still not connected');
}
+# check if we indeed do support stuff
+my $test_server_supports_insert_returning = do {
+ my $v = DBICTest::Schema->connect($dsn, $user, $pass)
+ ->storage
+ ->_get_dbh
+ ->get_info(18);
+ $v =~ /^(\d+)\.(\d+)/
+ or die "Unparseable Pg server version: $v\n";
+
+ ( sprintf ('%d.%d', $1, $2) >= 8.2 ) ? 1 : 0;
+};
+is (
+ DBICTest::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning,
+ $test_server_supports_insert_returning,
+ 'insert returning capability guessed correctly'
+);
+
+my $schema;
+for my $use_insert_returning ($test_server_supports_insert_returning
+ ? (0,1)
+ : (0)
+) {
+
+ no warnings qw/once/;
+ local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
+ my $s = shift->next::method (@_);
+ $s->storage->_use_insert_returning ($use_insert_returning);
+ $s;
+ };
+
+### test capability override
+ {
+ my $s = DBICTest::Schema->connect($dsn, $user, $pass);
+
+ ok (!$s->storage->_dbh, 'definitely not connected');
+
+ ok (
+ ! ($s->storage->_use_insert_returning xor $use_insert_returning),
+ 'insert returning capability set correctly',
+ );
+ ok (!$s->storage->_dbh, 'still not connected (capability override works)');
+ }
+
### connect, create postgres-specific test schema
$schema = DBICTest::Schema->connect($dsn, $user, $pass);
######## test non-serial auto-pk
- if ($schema->storage->_supports_insert_returning) {
+ if ($schema->storage->_use_insert_returning) {
$schema->source('TimestampPrimaryKey')->name('dbic_t_schema.timestamp_primary_key_test');
my $row = $schema->resultset('TimestampPrimaryKey')->create({});
ok $row->id;
use strict;
-use warnings;
+use warnings;
# use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else
BEGIN {
plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test'
unless ($dsn);
-my @storage_types = (
- 'DBI::Sybase::Microsoft_SQL_Server',
+my $testdb_supports_placeholders = DBICTest::Schema->connect($dsn, $user, $pass)
+ ->storage
+ ->_supports_typeless_placeholders;
+my @test_storages = (
+ $testdb_supports_placeholders ? 'DBI::Sybase::Microsoft_SQL_Server' : (),
'DBI::Sybase::Microsoft_SQL_Server::NoBindVars',
);
-my $storage_idx = -1;
-my $schema;
-
-my $NUMBER_OF_TESTS_IN_BLOCK = 18;
-for my $storage_type (@storage_types) {
- $storage_idx++;
-
- $schema = DBICTest::Schema->clone;
-
- $schema->connection($dsn, $user, $pass);
- if ($storage_idx != 0) { # autodetect
- no warnings 'redefine';
- local *DBIx::Class::Storage::DBI::_typeless_placeholders_supported =
- sub { 0 };
-# $schema->storage_type("::$storage_type");
- $schema->storage->ensure_connected;
- }
- else {
- $schema->storage->ensure_connected;
- }
+my $schema;
+for my $storage_type (@test_storages) {
+ $schema = DBICTest::Schema->connect($dsn, $user, $pass);
- if ($storage_idx == 0 && ref($schema->storage) =~ /NoBindVars\z/) {
- my $tb = Test::More->builder;
- $tb->skip('no placeholders') for 1..$NUMBER_OF_TESTS_IN_BLOCK;
- next;
+ if ($storage_type =~ /NoBindVars\z/) {
+ # since we want to use the nobindvar - disable the capability so the
+ # rebless happens to the correct class
+ $schema->storage->_use_typeless_placeholders (0);
}
+ $schema->storage->ensure_connected;
isa_ok($schema->storage, "DBIx::Class::Storage::$storage_type");
SKIP: {
local $storage->{_sql_maker} = undef;
local $storage->{_sql_maker_opts} = undef;
- local $storage->{_server_info_hash} = { %{ $storage->_server_info_hash } }; # clone
- delete @{$storage->{_server_info_hash}}{qw/dbms_version normalized_dbms_version/};
+ local $storage->{_dbh_details}{info} = {}; # delete cache
$storage->sql_maker;
projects / dbsrgits/DBIx-Class.git / commitdiff