From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Thu, 19 Mar 2015 22:26:04 +0000 (+0000)
Subject: Port ::Replicated from Moose to Moo+Type::Tiny
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1e1cc55ea27a0f41b4f300b41de94e4d2f45d12d;p=dbsrgits%2FDBIx-Class.git

Port ::Replicated from Moose to Moo+Type::Tiny
---

diff --git a/lib/DBIx/Class/Optional/Dependencies.pm b/lib/DBIx/Class/Optional/Dependencies.pm
index 7e69eea..dfe78e5 100644
--- a/lib/DBIx/Class/Optional/Dependencies.pm
+++ b/lib/DBIx/Class/Optional/Dependencies.pm
@@ -46,6 +46,15 @@ my $dbic_reqs = {
     },
   },
 
+  _types_common => {
+    req => {
+      'Type::Utils' => '0',
+      'Type::Library' => '0',
+      'Types::Standard' => '0',
+      'Types::LoadableClass' => '0',
+    },
+  },
+
   # a common placeholder for engines with IC::DT support based off DT::F::S
   _icdt_strptime_based => {
     augment => {
@@ -84,7 +93,7 @@ my $dbic_reqs = {
   },
 
   replicated => {
-    req => $moose_basic,
+    include => '_types_common',
     pod => {
       title => 'Storage::Replicated',
       desc => 'Modules required for L<DBIx::Class::Storage::DBI::Replicated>',
@@ -93,9 +102,6 @@ my $dbic_reqs = {
 
   test_replicated => {
     include => 'replicated',
-    req => {
-      'Test::Moose' => '0',
-    },
   },
 
   admin => {
@@ -192,7 +198,7 @@ my $dbic_reqs = {
 
   test_strictures => {
     req => {
-      'Test::Strict'              => '0.20',
+      'Test::Strict'              => '0.24',
     },
     release_testing_mandatory => 1,
   },
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index 273b218..852c816 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -10,19 +10,22 @@ BEGIN {
   }
 }
 
-use Moose;
+use Moo;
 use DBIx::Class::Storage::DBI;
 use DBIx::Class::Storage::DBI::Replicated::Pool;
 use DBIx::Class::Storage::DBI::Replicated::Balancer;
 use DBIx::Class::Storage::DBI::Replicated::Types qw/BalancerClassNamePart DBICSchema DBICStorageDBI/;
-use MooseX::Types::Moose qw/ClassName HashRef Object/;
-use Scalar::Util 'reftype';
+use Types::Standard qw/ClassName HashRef Object/;
+use Type::Utils qw(class_type role_type);
+use Scalar::Util qw(reftype blessed);
+use Sub::Name qw(subname);
 use Hash::Merge;
 use List::Util qw/min max reduce/;
 use Context::Preserve 'preserve_context';
+use Class::Inspector;
 use Try::Tiny;
 
-use namespace::clean -except => 'meta';
+use namespace::clean;
 
 =head1 NAME
 
@@ -203,8 +206,11 @@ container class for one or more replicated databases.
 
 has 'pool' => (
   is=>'ro',
-  isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
-  lazy_build=>1,
+  isa=>class_type('DBIx::Class::Storage::DBI::Replicated::Pool'),
+  lazy=>1,
+  builder=>1,
+  predicate=>1,
+  clearer=>1,
   handles=>[qw/
     connect_replicants
     replicants
@@ -221,8 +227,11 @@ is a class that takes a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>)
 
 has 'balancer' => (
   is=>'rw',
-  isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
-  lazy_build=>1,
+  isa=>role_type('DBIx::Class::Storage::DBI::Replicated::Balancer'),
+  lazy=>1,
+  builder=>1,
+  predicate=>1,
+  clearer=>1,
   handles=>[qw/auto_validate_every/],
 );
 
@@ -239,7 +248,10 @@ pool of databases that is allowed to handle write traffic.
 has 'master' => (
   is=> 'ro',
   isa=>DBICStorageDBI,
-  lazy_build=>1,
+  lazy=>1,
+  builder=>1,
+  predicate=>1,
+  clearer=>1,
 );
 
 =head1 ATTRIBUTES IMPLEMENTING THE DBIx::Storage::DBI INTERFACE
@@ -322,7 +334,7 @@ my $method_dispatch = {
     _execute
     _do_query
     _dbh_execute
-  /, Class::MOP::Class->initialize('DBIx::Class::Storage::DBIHacks')->get_method_list ],
+  /, @{Class::Inspector->functions('DBIx::Class::Storage::DBIHacks')} ],
   reader => [qw/
     select
     select_single
@@ -366,10 +378,9 @@ my $method_dispatch = {
     _bind_sth_params
   /,(
     # the capability framework
-    # not sure if CMOP->initialize does evil things to DBIC::S::DBI, fix if a problem
     grep
       { $_ =~ /^ _ (?: use | supports | determine_supports ) _ /x and $_ ne '_use_multicolumn_in' }
-      ( Class::MOP::Class->initialize('DBIx::Class::Storage::DBI')->get_all_method_names )
+      @{Class::Inspector->functions('DBIx::Class::Storage::DBI')}
   )],
 };
 
@@ -400,10 +411,11 @@ if (DBIx::Class::_ENV_::DBICTEST) {
 }
 
 for my $method (@{$method_dispatch->{unimplemented}}) {
-  __PACKAGE__->meta->add_method($method, sub {
+  no strict 'refs';
+  *{$method} = subname $method, sub {
     my $self = shift;
     $self->throw_exception("$method() must not be called on ".(blessed $self).' objects');
-  });
+  };
 }
 
 =head2 read_handler
@@ -415,7 +427,10 @@ Defines an object that implements the read side of L<DBIx::Class::Storage::DBI>.
 has 'read_handler' => (
   is=>'rw',
   isa=>Object,
-  lazy_build=>1,
+  lazy=>1,
+  builder=>1,
+  predicate=>1,
+  clearer=>1,
   handles=>$method_dispatch->{reader},
 );
 
@@ -431,7 +446,10 @@ run on a replicant.
 has 'write_handler' => (
   is=>'ro',
   isa=>Object,
-  lazy_build=>1,
+  lazy=>1,
+  builder=>1,
+  predicate=>1,
+  clearer=>1,
   handles=>$method_dispatch->{writer},
 );
 
@@ -498,9 +516,11 @@ around connect_info => sub {
     # Make sure master is blessed into the correct class and apply role to it.
     my $master = $self->master;
     $master->_determine_driver;
-    Moose::Meta::Class->initialize(ref $master);
 
-    DBIx::Class::Storage::DBI::Replicated::WithDSN->meta->apply($master);
+    Moo::Role->apply_roles_to_object(
+      $master,
+      'DBIx::Class::Storage::DBI::Replicated::WithDSN',
+    );
 
     # link pool back to master
     $self->pool->master($master);
@@ -1131,6 +1151,4 @@ L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 
 =cut
 
-__PACKAGE__->meta->make_immutable;
-
 1;
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
index 26e3580..8226ff7 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
@@ -1,11 +1,13 @@
 package DBIx::Class::Storage::DBI::Replicated::Balancer;
 
-use Moose::Role;
+use Moo::Role;
 requires 'next_storage';
-use MooseX::Types::Moose qw/Int/;
+use Types::Standard qw/Int/;
+use Type::Utils qw/class_type/;
+use Scalar::Util qw/blessed/;
 use DBIx::Class::Storage::DBI::Replicated::Pool;
 use DBIx::Class::Storage::DBI::Replicated::Types qw/DBICStorageDBI/;
-use namespace::clean -except => 'meta';
+use namespace::clean;
 
 =head1 NAME
 
@@ -63,7 +65,7 @@ balance.
 
 has 'pool' => (
   is=>'ro',
-  isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
+  isa=>class_type('DBIx::Class::Storage::DBI::Replicated::Pool'),
   required=>1,
 );
 
@@ -83,7 +85,10 @@ via its balancer object.
 has 'current_replicant' => (
   is=> 'rw',
   isa=>DBICStorageDBI,
-  lazy_build=>1,
+  lazy=>1,
+  builder=>1,
+  predicate=>1,
+  clearer=>1,
   handles=>[qw/
     select
     select_single
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm
index c7a160e..0474959 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm
@@ -1,8 +1,8 @@
 package DBIx::Class::Storage::DBI::Replicated::Balancer::First;
 
-use Moose;
+use Moo;
 with 'DBIx::Class::Storage::DBI::Replicated::Balancer';
-use namespace::clean -except => 'meta';
+use namespace::clean;
 
 =head1 NAME
 
@@ -52,6 +52,4 @@ L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 
 =cut
 
-__PACKAGE__->meta->make_immutable;
-
 1;
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm
index 6b430f4..ae600c2 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm
@@ -1,9 +1,9 @@
 package DBIx::Class::Storage::DBI::Replicated::Balancer::Random;
 
-use Moose;
+use Moo;
 with 'DBIx::Class::Storage::DBI::Replicated::Balancer';
 use DBIx::Class::Storage::DBI::Replicated::Types 'Weight';
-use namespace::clean -except => 'meta';
+use namespace::clean;
 
 =head1 NAME
 
@@ -91,6 +91,4 @@ L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 
 =cut
 
-__PACKAGE__->meta->make_immutable;
-
 1;
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
index 9980b4d..6d55835 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
@@ -1,11 +1,11 @@
 package DBIx::Class::Storage::DBI::Replicated::Pool;
 
-use Moose;
+use Moo;
 use DBIx::Class::Storage::DBI::Replicated::Replicant;
 use List::Util 'sum';
 use Scalar::Util 'reftype';
 use DBI ();
-use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
+use Types::Standard qw/Num Int ClassName HashRef Object/;
 use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
 use Try::Tiny;
 
@@ -44,7 +44,6 @@ return a number of seconds that the replicating database is lagging.
 has 'maximum_lag' => (
   is=>'rw',
   isa=>Num,
-  required=>1,
   lazy=>1,
   default=>0,
 );
@@ -125,34 +124,28 @@ Removes the replicant under $key from the pool
 
 has 'replicants' => (
   is=>'rw',
-  traits => ['Hash'],
-  isa=>HashRef['Object'],
+  isa=>HashRef[Object],
   default=>sub {{}},
-  handles  => {
-    'set_replicant' => 'set',
-    'get_replicant' => 'get',
-    'has_replicants' => 'is_empty',
-    'num_replicants' => 'count',
-    'delete_replicant' => 'delete',
-    'all_replicant_storages' => 'values',
-  },
 );
 
-around has_replicants => sub {
-    my ($orig, $self) = @_;
-    return !$self->$orig;
-};
+sub set_replicant { $_[0]->replicants->{$_[1]} = $_[2] }
+sub get_replicant { $_[0]->replicants->{$_[1]} }
+sub has_replicants { !!keys %{$_[0]->replicants} }
+sub num_replicants { 0+keys %{$_[0]->replicants} }
+sub delete_replicant { delete $_[0]->replicants->{$_[1]} }
+sub all_replicant_storages { values %{$_[0]->replicants} }
 
 has next_unknown_replicant_id => (
   is => 'rw',
-  traits => ['Counter'],
   isa => Int,
   default => 1,
-  handles => {
-    'inc_unknown_replicant_id' => 'inc',
-  },
 );
 
+sub inc_unknown_replicant_id {
+  my ($self) = @_;
+  $self->next_unknown_replicant_id($self->next_unknown_replicant_id + 1);
+}
+
 =head2 master
 
 Reference to the master Storage.
@@ -252,9 +245,10 @@ sub connect_replicant {
     $replicant->_determine_driver
   });
 
-  Moose::Meta::Class->initialize(ref $replicant);
-
-  DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);
+  Moo::Role->apply_roles_to_object(
+    $replicant,
+    'DBIx::Class::Storage::DBI::Replicated::Replicant',
+  );
 
   # link back to master
   $replicant->master($self->master);
@@ -423,6 +417,4 @@ L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 
 =cut
 
-__PACKAGE__->meta->make_immutable;
-
 1;
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
index 7c6084b..957f08c 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
@@ -1,12 +1,12 @@
 package DBIx::Class::Storage::DBI::Replicated::Replicant;
 
-use Moose::Role;
+use Moo::Role;
 requires qw/_query_start/;
 with 'DBIx::Class::Storage::DBI::Replicated::WithDSN';
-use MooseX::Types::Moose qw/Bool Str/;
+use Types::Standard qw/Bool Str/;
 use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
 
-use namespace::clean -except => 'meta';
+use namespace::clean;
 
 =head1 NAME
 
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
index 0782a6e..e14c1e4 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
@@ -4,20 +4,18 @@ package # hide from PAUSE
 # DBIx::Class::Storage::DBI::Replicated::Types - Types used internally by
 # L<DBIx::Class::Storage::DBI::Replicated>
 
-# Workaround for https://rt.cpan.org/Public/Bug/Display.html?id=83336
 use warnings;
 use strict;
 
-use MooseX::Types
-  -declare => [qw/BalancerClassNamePart Weight DBICSchema DBICStorageDBI/];
-use MooseX::Types::Moose qw/ClassName Str Num/;
-use MooseX::Types::LoadableClass qw/LoadableClass/;
+use Type::Library
+  -base,
+  -declare => qw/BalancerClassNamePart Weight DBICSchema DBICStorageDBI/;
+use Type::Utils -all;
+use Types::Standard qw/Str Num/;
+use Types::LoadableClass qw/LoadableClass/;
 
-class_type 'DBIx::Class::Storage::DBI';
-class_type 'DBIx::Class::Schema';
-
-subtype DBICSchema, as 'DBIx::Class::Schema';
-subtype DBICStorageDBI, as 'DBIx::Class::Storage::DBI';
+class_type DBICSchema, { class => 'DBIx::Class::Schema' };
+class_type DBICStorageDBI, { class => 'DBIx::Class::Storage::DBI' };
 
 subtype BalancerClassNamePart,
   as LoadableClass;
diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm b/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
index 46b1430..3466bfa 100644
--- a/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
@@ -1,11 +1,11 @@
 package DBIx::Class::Storage::DBI::Replicated::WithDSN;
 
-use Moose::Role;
+use Moo::Role;
 use Scalar::Util 'reftype';
 requires qw/_query_start/;
 
 use Try::Tiny;
-use namespace::clean -except => 'meta';
+use namespace::clean;
 
 =head1 NAME
 
diff --git a/t/storage/replicated.t b/t/storage/replicated.t
index 82c809d..79201e1 100644
--- a/t/storage/replicated.t
+++ b/t/storage/replicated.t
@@ -7,23 +7,12 @@ use Test::More;
 use DBIx::Class::_Util 'modver_gt_or_eq_and_lt';
 use lib qw(t/lib);
 use DBICTest;
-
-BEGIN {
-  plan skip_all => "A trial version of Moose detected known to break replication - skipping test known to fail" if (
-    DBICTest::RunMode->is_smoker
-      and
-    modver_gt_or_eq_and_lt( 'Moose', '1.99', '1.9903' )
-  )
-}
-
-use Test::Moose;
+use Class::Inspector;
 use Test::Exception;
 use List::Util 'first';
 use Scalar::Util 'reftype';
 use File::Spec;
-use Moose();
-use MooseX::Types();
-note "Using Moose version $Moose::VERSION and MooseX::Types version $MooseX::Types::VERSION";
+use Moo::Role ();
 
 my $var_dir = quotemeta ( File::Spec->catdir(qw/t var/) );
 
@@ -32,9 +21,7 @@ use DBIx::Class::Storage::DBI::Replicated;
 {
     package DBIx::Class::Storage::DBI::Replicated;
 
-    use Moose;
-
-    __PACKAGE__->meta->make_mutable;
+    use Moo;
 
     around connect_info => sub {
       my ($next, $self, $info) = @_;
@@ -42,12 +29,14 @@ use DBIx::Class::Storage::DBI::Replicated;
       $self->$next($info);
     };
 
-    __PACKAGE__->meta->make_immutable;
-
-    no Moose;
 }
 
-
+sub does_ok($$;$) {
+  my ($thing, $role, $desc) = @_;
+  $desc ||= 'The object';
+  local $Test::Builder::Level = $Test::Builder::Level + 1;
+  ok Moo::Role::does_role($thing, $role), "$desc does $role";
+}
 
 =head1 HOW TO USE
 
@@ -270,11 +259,11 @@ for my $method (qw/by_connect_info by_storage_type/) {
 
 ### check that all Storage::DBI methods are handled by ::Replicated
 {
-  my @storage_dbi_methods = Class::MOP::Class
-    ->initialize('DBIx::Class::Storage::DBI')->get_all_method_names;
+  my @storage_dbi_methods = @{Class::Inspector
+    ->methods('DBIx::Class::Storage::DBI')};
 
-  my @replicated_methods  = DBIx::Class::Storage::DBI::Replicated->meta
-    ->get_all_method_names;
+  my @replicated_methods  = @{Class::Inspector
+    ->methods('DBIx::Class::Storage::DBI::Replicated')};
 
 # remove constants and OTHER_CRAP
   @storage_dbi_methods = grep !/^[A-Z_]+\z/, @storage_dbi_methods;
@@ -283,8 +272,7 @@ for my $method (qw/by_connect_info by_storage_type/) {
   @storage_dbi_methods = grep !/_accessor\z/, @storage_dbi_methods;
 
 # remove DBIx::Class (the root parent, with CAG and stuff) methods
-  my @root_methods = Class::MOP::Class->initialize('DBIx::Class')
-    ->get_all_method_names;
+  my @root_methods = @{Class::Inspector->methods('DBIx::Class')};
   my %count;
   $count{$_}++ for (@storage_dbi_methods, @root_methods);
 
@@ -318,9 +306,6 @@ for my $method (qw/by_connect_info by_storage_type/) {
   }
 }
 
-ok $replicated->schema->storage->meta
-    => 'has a meta object';
-
 isa_ok $replicated->schema->storage->master
     => 'DBIx::Class::Storage::DBI';
 
diff --git a/xt/dist/pod_coverage.t b/xt/dist/pod_coverage.t
index 88bcb81..144b058 100644
--- a/xt/dist/pod_coverage.t
+++ b/xt/dist/pod_coverage.t
@@ -106,10 +106,28 @@ my $exceptions = {
         /]
      },
 
-    'DBIx::Class::Storage::DBI::Replicated*'        => {
+    'DBIx::Class::Storage::DBI::Replicated' => {
         ignore => [ qw/
             connect_call_do_sql
             disconnect_call_do_sql
+            get_dbms_capability
+            get_use_dbms_capability
+            set_dbms_capability
+            set_use_dbms_capability
+            sql_limit_dialect
+            sql_name_sep
+            sql_quote_char
+            has_balancer
+            has_master
+            has_pool
+            has_read_handler
+            has_write_handler
+        /]
+    },
+
+    'DBIx::Class::Storage::DBI::Replicated::Balanced' => {
+        ignore => [ qw/
+            has_auto_validate_every
         /]
     },