From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 12 Apr 2016 11:27:14 +0000 (+0200)
Subject: Remove dead code from DBI::Replicated
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=36600771d6808d7ab45110c77a494510568ce3c7;p=dbsrgits%2FDBIx-Class-Historic.git

Remove dead code from DBI::Replicated

This was originally introduced in fecb38cba, without tests nor justification.
Subsequently it got modified a bit in 7da56142c, and then got completely
broken by bbdda2810 which designated _dbh_details() as an off-limits internal
method.

Given nothing has been heard since (6 years), and there is no effective change
of behavior (the snippet below fails identically below and after this change)
go ahead and burninate.

Also adjust the "can't touch this" exception text a bit.

DBICTEST_VIA_REPLICATED=1 perl -Ilib -It/lib -MDBICTest -e '
  eval { DBICTest->init_schema->storage->$_ }, warn $@
    for qw( _dbh_details _server_info _get_server_version _describe_connection )
'
---

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 512c53e..6a2f7ad 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -18,7 +18,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 reduce/;
+use List::Util qw( min max );
 use Context::Preserve 'preserve_context';
 use Try::Tiny;
 use DBIx::Class::_Util 'dbic_internal_try';
@@ -343,6 +343,8 @@ my $method_dispatch = {
     _dbh_details
     _dbh_get_info
     _get_rdbms_name
+    _get_server_version
+    _server_info
 
     _determine_connector_driver
     _extract_driver_from_connect_info
@@ -406,7 +408,10 @@ if ( $INC{"t/lib/ANFANG.pm"} ) {
 for my $method (@{$method_dispatch->{unimplemented}}) {
   __PACKAGE__->meta->add_method($method, sub {
     my $self = shift;
-    $self->throw_exception("$method() must not be called on ".(blessed $self).' objects');
+    $self->throw_exception(
+      "$method() may not be called on '@{[ blessed $self ]}' objects, "
+    . 'call it on a specific pool instance instead'
+    );
   });
 }
 
@@ -1049,35 +1054,6 @@ sub _ping {
   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 '', ('%06d') x (@numparts - 1));
-
-  return sprintf $format, @numparts;
-};
-sub _server_info {
-  my $self = shift;
-
-  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];
-  }
-
-  return $self->next::method;
-}
-
-sub _get_server_version {
-  my $self = shift;
-
-  return $self->_server_info->{dbms_version};
-}
-
 =head1 GOTCHAS
 
 Due to the fact that replicants can lag behind a master, you must take care to