[Bast-commits] r6122 - in DBIx-Class/0.08/branches/storage-tweaks:
. lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI
lib/DBIx/Class/Storage/DBI/Replicated t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Mon May 4 21:07:44 GMT 2009
Author: caelum
Date: 2009-05-04 21:07:43 +0000 (Mon, 04 May 2009)
New Revision: 6122
Added:
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
Modified:
DBIx-Class/0.08/branches/storage-tweaks/Makefile.PL
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/Statistics.pm
DBIx-Class/0.08/branches/storage-tweaks/t/93storage_replication.t
Log:
::Replicated - test hashref for connect_replicants and croak on coderef, switch to MX::Types, make test less noisy
Modified: DBIx-Class/0.08/branches/storage-tweaks/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/Makefile.PL 2009-05-04 18:07:47 UTC (rev 6121)
+++ DBIx-Class/0.08/branches/storage-tweaks/Makefile.PL 2009-05-04 21:07:43 UTC (rev 6122)
@@ -78,9 +78,9 @@
# t/93storage_replication.t
'Moose', => 0.54,
- 'Moose::Util::TypeConstraints' => 0.54,
'MooseX::AttributeHelpers' => 0.12,
- 'Class::MOP' => 0.63,
+ 'MooseX::Types', => 0.10,
+ 'namespace::clean' => 0.11,
# t/96_is_deteministic_value.t
'DateTime::Format::Strptime' => 0,
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-05-04 18:07:47 UTC (rev 6121)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-05-04 21:07:43 UTC (rev 6122)
@@ -3,9 +3,12 @@
use Moose;
use MooseX::AttributeHelpers;
use DBIx::Class::Storage::DBI::Replicated::Replicant;
-use List::Util qw(sum);
-use Scalar::Util ();
+use List::Util 'sum';
+use Scalar::Util 'reftype';
+use Carp::Clan qw/^DBIx::Class/;
+use namespace::clean -except => 'meta';
+
=head1 NAME
DBIx::Class::Storage::DBI::Replicated::Pool - Manage a pool of replicants
@@ -151,12 +154,15 @@
my @newly_created = ();
foreach my $connect_info (@_) {
$connect_info = [ $connect_info ]
- if Scalar::Util::reftype($connect_info) ne 'ARRAY';
+ if reftype $connect_info ne 'ARRAY';
+ croak "coderef connect_info not supported"
+ if ref $connect_info->[0] && reftype $connect_info->[0] eq 'CODE';
+
my $replicant = $self->connect_replicant($schema, $connect_info);
my $key = $connect_info->[0];
- $key = $key->{dsn} if Scalar::Util::reftype($key) eq 'HASH';
+ $key = $key->{dsn} if ref $key && reftype $key eq 'HASH';
($key) = ($key =~ m/^dbi\:.+\:(.+)$/);
$self->set_replicant( $key => $replicant);
@@ -288,13 +294,13 @@
if($self->_safely_ensure_connected($replicant)) {
my $is_replicating = $replicant->is_replicating;
unless(defined $is_replicating) {
- $replicant->debugobj->print("Storage Driver ".ref $self." Does not support the 'is_replicating' method. Assuming you are manually managing.");
+ $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'is_replicating' method. Assuming you are manually managing.\n");
next;
} else {
if($is_replicating) {
my $lag_behind_master = $replicant->lag_behind_master;
unless(defined $lag_behind_master) {
- $replicant->debugobj->print("Storage Driver ".ref $self." Does not support the 'lag_behind_master' method. Assuming you are manually managing.");
+ $replicant->debugobj->print("Storage Driver ".ref($self)." Does not support the 'lag_behind_master' method. Assuming you are manually managing.\n");
next;
} else {
if($lag_behind_master <= $self->maximum_lag) {
Added: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm (rev 0)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm 2009-05-04 21:07:43 UTC (rev 6122)
@@ -0,0 +1,23 @@
+package DBIx::Class::Storage::DBI::Replicated::Types;
+
+use MooseX::Types
+ -declare => [qw/BalancerClassNamePart/];
+use MooseX::Types::Moose qw/ClassName Str/;
+
+class_type 'DBIx::Class::Storage::DBI';
+
+subtype BalancerClassNamePart,
+ as ClassName;
+
+coerce BalancerClassNamePart,
+ from Str,
+ via {
+ my $type = $_;
+ if($type=~m/^::/) {
+ $type = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$type;
+ }
+ Class::MOP::load_class($type);
+ $type;
+ };
+
+1;
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-05-04 18:07:47 UTC (rev 6121)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-05-04 21:07:43 UTC (rev 6122)
@@ -7,10 +7,10 @@
## use, so we explicitly test for these.
my %replication_required = (
- Moose => '0.54',
+ Moose => '0.77',
MooseX::AttributeHelpers => '0.12',
- Moose::Util::TypeConstraints => '0.54',
- Class::MOP => '0.63',
+ MooseX::Types => '0.10',
+ namespace::clean => '0.11',
);
my @didnt_load;
@@ -28,7 +28,10 @@
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 - BETA Replicated database support
@@ -99,10 +102,10 @@
Replicated Storage has additional requirements not currently part of L<DBIx::Class>
- Moose => 0.54
+ Moose => 0.77
MooseX::AttributeHelpers => 0.12
- Moose::Util::TypeConstraints => 0.54
- Class::MOP => 0.63
+ 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.
@@ -164,23 +167,9 @@
=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',
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/Statistics.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/Statistics.pm 2009-05-04 18:07:47 UTC (rev 6121)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/Statistics.pm 2009-05-04 21:07:43 UTC (rev 6122)
@@ -5,7 +5,7 @@
use base qw/Class::Accessor::Grouped/;
use IO::File;
-__PACKAGE__->mk_group_accessors(simple => qw/callback debugfh/);
+__PACKAGE__->mk_group_accessors(simple => qw/callback debugfh silence/);
=head1 NAME
@@ -56,6 +56,8 @@
sub print {
my ($self, $msg) = @_;
+ return if $self->silence;
+
if(!defined($self->debugfh())) {
my $fh;
my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/93storage_replication.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/93storage_replication.t 2009-05-04 18:07:47 UTC (rev 6121)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/93storage_replication.t 2009-05-04 21:07:43 UTC (rev 6122)
@@ -4,6 +4,7 @@
use Test::More;
use Test::Exception;
use DBICTest;
+use List::Util 'first';
BEGIN {
eval "use DBIx::Class::Storage::DBI::Replicated; use Test::Moose";
@@ -124,9 +125,20 @@
"dbi:SQLite:${_}";
} @{$self->slave_paths};
- return map { [$_,'','',{AutoCommit=>1}] } @dsn;
+ my @connect_infos = map { [$_,'','',{AutoCommit=>1}] } @dsn;
+
+ # try a hashref too
+ my $c = $connect_infos[0];
+ $connect_infos[0] = {
+ dsn => $c->[0],
+ user => $c->[1],
+ password => $c->[2],
+ %{ $c->[3] }
+ };
+
+ @connect_infos
}
-
+
## Do a 'good enough' replication by copying the master dbfile over each of
## the slave dbfiles. If the master is SQLite we do this, otherwise we
## just do a one second pause to let the slaves catch up.
@@ -211,10 +223,19 @@
ok my @replicated_storages = $replicated->schema->storage->connect_replicants(@replicant_connects)
=> 'Created some storages suitable for replicants';
-
+
+my @replicant_names = keys %{ $replicated->schema->storage->replicants };
+
+## Silence warning about not supporting the is_replicating method if using the
+## sqlite dbs.
+$replicated->schema->storage->debugobj->silence(1)
+ if first { m{^t/} } @replicant_names;
+
isa_ok $replicated->schema->storage->balancer->current_replicant
- => 'DBIx::Class::Storage::DBI';
-
+ => 'DBIx::Class::Storage::DBI';
+
+$replicated->schema->storage->debugobj->silence(0);
+
ok $replicated->schema->storage->pool->has_replicants
=> 'does have replicants';
@@ -227,8 +248,6 @@
does_ok $replicated_storages[1]
=> 'DBIx::Class::Storage::DBI::Replicated::Replicant';
-my @replicant_names = keys %{$replicated->schema->storage->replicants};
-
does_ok $replicated->schema->storage->replicants->{$replicant_names[0]}
=> 'DBIx::Class::Storage::DBI::Replicated::Replicant';
@@ -249,8 +268,16 @@
$replicated->replicate;
$replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
$replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
+
+## Silence warning about not supporting the is_replicating method if using the
+## sqlite dbs.
+$replicated->schema->storage->debugobj->silence(1)
+ if first { m{^t/} } @replicant_names;
+
$replicated->schema->storage->pool->validate_replicants;
+$replicated->schema->storage->debugobj->silence(0);
+
## Make sure we can read the data.
ok my $artist1 = $replicated->schema->resultset('Artist')->find(4)
@@ -350,14 +377,27 @@
$replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
$replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
-
+
+## Silence warning about falling back to master.
+$replicated->schema->storage->debugobj->silence(1);
+
ok $replicated->schema->resultset('Artist')->find(2)
=> 'Fallback to master';
+$replicated->schema->storage->debugobj->silence(0);
+
$replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
$replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
+
+## Silence warning about not supporting the is_replicating method if using the
+## sqlite dbs.
+$replicated->schema->storage->debugobj->silence(1)
+ if first { m{^t/} } @replicant_names;
+
$replicated->schema->storage->pool->validate_replicants;
+$replicated->schema->storage->debugobj->silence(0);
+
ok $replicated->schema->resultset('Artist')->find(2)
=> 'Returned to replicates';
More information about the Bast-commits
mailing list