fix ::DBI::Replicated::all_storages

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated.pm

diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm
index d711f84..a25b2a4 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Replicated.pm
+++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm
@@ -1,15 +1,40 @@
 package DBIx::Class::Storage::DBI::Replicated;
 
-use Moose;
-use Class::MOP;
-use Moose::Util::TypeConstraints;
+BEGIN {
+  use Carp::Clan qw/^DBIx::Class/;
+       
+  ## Modules required for Replication support not required for general DBIC
+  ## use, so we explicitly test for these.
+       
+  my %replication_required = (
+    Moose => '0.77',
+    MooseX::AttributeHelpers => '0.12',
+    MooseX::Types => '0.10',
+    namespace::clean => '0.11',
+  );
+       
+  my @didnt_load;
+  
+  for my $module (keys %replication_required) {
+       eval "use $module $replication_required{$module}";
+       push @didnt_load, "$module $replication_required{$module}"
+        if $@;
+  }
+       
+  croak("@{[ join ', ', @didnt_load ]} are missing and are required for Replication")
+    if @didnt_load;    
+}
+
 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 'BalancerClassNamePart';
+
+use namespace::clean -except => 'meta';
 
 =head1 NAME
 
-DBIx::Class::Storage::DBI::Replicated - ALPHA Replicated database support
+DBIx::Class::Storage::DBI::Replicated - BETA Replicated database support
 
 =head1 SYNOPSIS
 
@@ -47,7 +72,7 @@ tasks.
 =head1 DESCRIPTION
 
 Warning: This class is marked BETA.  This has been running a production
-website using MySQL native replication as it's backend and we have some decent
+website using MySQL native replication as its backend and we have some decent
 test coverage but the code hasn't yet been stressed by a variety of databases.
 Individual DB's may have quirks we are not aware of.  Please use this in first
 development and pass along your experiences/bug fixes.
@@ -71,7 +96,19 @@ selected algorithm.  The default algorithm is random weighted.
 The consistancy betweeen master and replicants is database specific.  The Pool
 gives you a method to validate it's replicants, removing and replacing them
 when they fail/pass predefined criteria.  Please make careful use of the ways
-to force a query to run against Master when needed.  
+to force a query to run against Master when needed.
+
+=head1 REQUIREMENTS
+
+Replicated Storage has additional requirements not currently part of L<DBIx::Class>
+
+  Moose => 0.77
+  MooseX::AttributeHelpers => 0.12 
+  MooseX::Types => 0.10
+  namespace::clean => 0.11
+  
+You will need to install these modules manually via CPAN or make them part of the
+Makefile for your distribution.
 
 =head1 ATTRIBUTES
 
@@ -130,23 +167,9 @@ choose how to spread the query load across each replicant in the pool.
 
 =cut
 
-subtype 'DBIx::Class::Storage::DBI::Replicated::BalancerClassNamePart',
-  as 'ClassName';
-    
-coerce 'DBIx::Class::Storage::DBI::Replicated::BalancerClassNamePart',
-  from 'Str',
-  via {
-       my $type = $_;
-    if($type=~m/^::/) {
-      $type = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$type;
-    }  
-    Class::MOP::load_class($type);  
-    $type;     
-  };
-
 has 'balancer_type' => (
   is=>'ro',
-  isa=>'DBIx::Class::Storage::DBI::Replicated::BalancerClassNamePart',
+  isa=>BalancerClassNamePart,
   coerce=>1,
   required=>1,
   default=> 'DBIx::Class::Storage::DBI::Replicated::Balancer::First',
@@ -275,10 +298,10 @@ has 'write_handler' => (
     txn_scope_guard
     sth
     deploy
+    with_deferred_fk_checks
 
     reload_row
     _prep_for_execute
-    configure_sqlt
     
   /],
 );
@@ -287,7 +310,7 @@ has 'write_handler' => (
 
 This class defines the following methods.
 
-=head2 new
+=head2 BUILDARGS
 
 L<DBIx::Class::Schema> when instantiating it's storage passed itself as the
 first argument.  So we need to massage the arguments a bit so that all the
@@ -295,10 +318,15 @@ bits get put into the correct places.
 
 =cut
 
-around 'new' => sub {
-  my ($new, $self, $schema, $storage_type_args, @args) = @_;
-  return $self->$new(schema=>$schema, %$storage_type_args, @args);
-};
+sub BUILDARGS {
+  my ($class, $schema, $storage_type_args, @args) = @_;        
+  
+  return {
+       schema=>$schema, 
+       %$storage_type_args,
+       @args
+  }
+}
 
 =head2 _build_master
 
@@ -384,7 +412,7 @@ sub all_storages {
   my $self = shift @_;
   return grep {defined $_ && blessed $_} (
      $self->master,
-     $self->replicants,
+     values %{ $self->replicants },
   );
 }
 
@@ -533,6 +561,7 @@ sub limit_dialect {
   foreach my $source ($self->all_storages) {
     $source->limit_dialect(@_);
   }
+  return $self->master->quote_char;
 }
 
 =head2 quote_char
@@ -546,6 +575,7 @@ sub quote_char {
   foreach my $source ($self->all_storages) {
     $source->quote_char(@_);
   }
+  return $self->master->quote_char;
 }
 
 =head2 name_sep
@@ -559,6 +589,7 @@ sub name_sep {
   foreach my $source ($self->all_storages) {
     $source->name_sep(@_);
   }
+  return $self->master->name_sep;
 }
 
 =head2 set_schema
@@ -582,9 +613,12 @@ set a debug flag across all storages
 
 sub debug {
   my $self = shift @_;
-  foreach my $source ($self->all_storages) {
-    $source->debug(@_);
+  if(@_) {
+    foreach my $source ($self->all_storages) {
+      $source->debug(@_);
+    }   
   }
+  return $self->master->debug;
 }
 
 =head2 debugobj
@@ -595,9 +629,12 @@ set a debug object across all storages
 
 sub debugobj {
   my $self = shift @_;
-  foreach my $source ($self->all_storages) {
-    $source->debugobj(@_);
+  if(@_) {
+    foreach my $source ($self->all_storages) {
+      $source->debugobj(@_);
+    }  
   }
+  return $self->master->debugobj;
 }
 
 =head2 debugfh
@@ -608,9 +645,12 @@ set a debugfh object across all storages
 
 sub debugfh {
   my $self = shift @_;
-  foreach my $source ($self->all_storages) {
-    $source->debugfh(@_);
+  if(@_) {
+    foreach my $source ($self->all_storages) {
+      $source->debugfh(@_);
+    }   
   }
+  return $self->master->debugfh;
 }
 
 =head2 debugcb
@@ -621,9 +661,12 @@ set a debug callback across all storages
 
 sub debugcb {
   my $self = shift @_;
-  foreach my $source ($self->all_storages) {
-    $source->debugcb(@_);
+  if(@_) {
+    foreach my $source ($self->all_storages) {
+      $source->debugcb(@_);
+    }   
   }
+  return $self->master->debugcb;
 }
 
 =head2 disconnect
@@ -691,4 +734,6 @@ You may distribute this code under the same terms as Perl itself.
 
 =cut
 
+__PACKAGE__->meta->make_immutable;
+
 1;