From: Rafael Kitover Date: Mon, 12 Apr 2010 18:23:11 +0000 (+0000) Subject: better way to find minimal dbms version in ::Replicated X-Git-Tag: v0.08122~119 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7da56142c;hp=a3356adbf416fd1a86f6f699ac76723b5da11bd4;p=dbsrgits%2FDBIx-Class.git better way to find minimal dbms version in ::Replicated --- diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index 37f13d7..20a8d73 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -15,7 +15,7 @@ use DBIx::Class::Storage::DBI::Replicated::Types qw/BalancerClassNamePart DBICSc use MooseX::Types::Moose qw/ClassName HashRef Object/; use Scalar::Util 'reftype'; use Hash::Merge; -use List::Util qw/min max/; +use List::Util qw/min max reduce/; use namespace::clean -except => 'meta'; @@ -1010,20 +1010,23 @@ sub _ping { return min map $_->_ping, $self->all_storages; } +my $numify_ver = sub { + my $ver = shift; + my @numparts = split /\D+/, $ver; + my $format = '%d.' . (join '', ('%05d') x (@numparts - 1)); + + return sprintf $format, @numparts; +}; + sub _server_info { my $self = shift; if (not $self->_server_info_hash) { - no warnings 'numeric'; # in case dbms_version doesn't normalize - - my @infos = - map $_->[1], - sort { $a->[0] <=> $b->[0] } - map [ (defined $_->{normalized_dbms_version} ? $_->{normalized_dbms_version} - : $_->{dbms_version}), $_ ], - map $_->_server_info, $self->all_storages; - - my $min_version_info = $infos[0]; + my $min_version_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 } diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm index c845379..16adca4 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm @@ -89,7 +89,7 @@ sub _select_args { my $data_type = $col_info->{$selected}{data_type}; - if ($data_type && $data_type =~ /^uniqueidentifier\z/i) { + if ($data_type && lc($data_type) eq 'uniqueidentifier') { $select->[$select_idx] = { UUIDTOSTR => $selected }; } }