,
# t/93storage_replication.t
- 'Moose', => 0.54,
- 'Moose::Util::TypeConstraints' => 0.54,
+ 'Moose', => 0.77,
'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,
## 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;
if @didnt_load;
}
+use Moose;
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 MooseX::Types::Moose qw/ClassName HashRef Object/;
+use Scalar::Util 'reftype';
+use Carp::Clan qw/^DBIx::Class/;
+
+use namespace::clean -except => 'meta';
=head1 NAME
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.
=cut
has 'pool_type' => (
- is=>'ro',
- isa=>'ClassName',
- required=>1,
+ is=>'rw',
+ isa=>ClassName,
default=>'DBIx::Class::Storage::DBI::Replicated::Pool',
handles=>{
'create_pool' => 'new',
=cut
has 'pool_args' => (
- is=>'ro',
- isa=>'HashRef',
+ is=>'rw',
+ isa=>HashRef,
lazy=>1,
- required=>1,
default=>sub { {} },
);
=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',
+ is=>'rw',
+ isa=>BalancerClassNamePart,
coerce=>1,
required=>1,
default=> 'DBIx::Class::Storage::DBI::Replicated::Balancer::First',
=cut
has 'balancer_args' => (
- is=>'ro',
- isa=>'HashRef',
+ is=>'rw',
+ isa=>HashRef,
lazy=>1,
required=>1,
default=>sub { {} },
=cut
has 'balancer' => (
- is=>'ro',
+ is=>'rw',
isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
lazy_build=>1,
handles=>[qw/auto_validate_every/],
has 'read_handler' => (
is=>'rw',
- isa=>'Object',
+ isa=>Object,
lazy_build=>1,
handles=>[qw/
select
has 'write_handler' => (
is=>'ro',
- isa=>'Object',
- lazy_build=>1,
+ isa=>Object,
lazy_build=>1,
handles=>[qw/
on_connect_do
/],
);
+has _master_connect_info_opts =>
+ (is => 'rw', isa => HashRef, default => sub { {} });
+
+=head2 around: connect_info
+
+Preserve master's C<connect_info> options (for merging with replicants.)
+Also set any Replicated related options from connect_info, such as
+C<pool_type>, C<pool_args>, C<balancer_type> and C<balancer_args>.
+
+=cut
+
+around connect_info => sub {
+ my ($next, $self, $info, @extra) = @_;
+
+ my %opts;
+ for my $arg (@$info) {
+ next unless (reftype($arg)||'') eq 'HASH';
+ %opts = (%opts, %$arg);
+ }
+ delete $opts{dsn};
+
+ if (@opts{qw/pool_type pool_args/}) {
+ $self->pool_type(delete $opts{pool_type})
+ if $opts{pool_type};
+
+ $self->pool_args({
+ %{ $self->pool_args },
+ %{ delete $opts{pool_args} || {} }
+ });
+
+ $self->pool($self->_build_pool);
+ }
+
+ if (@opts{qw/balancer_type balancer_args/}) {
+ $self->balancer_type(delete $opts{balancer_type})
+ if $opts{balancer_type};
+
+ $self->balancer_args({
+ %{ $self->balancer_args },
+ %{ delete $opts{balancer_args} || {} }
+ });
+
+ $self->balancer($self->_build_balancer);
+ }
+
+ $self->_master_connect_info_opts(\%opts);
+
+ $self->$next($info, @extra);
+};
+
=head1 METHODS
This class defines the following methods.
sub _build_master {
my $self = shift @_;
- DBIx::Class::Storage::DBI->new($self->schema);
+ my $master = DBIx::Class::Storage::DBI->new($self->schema);
+ DBIx::Class::Storage::DBI::Replicated::WithDSN->meta->apply($master);
+ $master
}
=head2 _build_pool
=head2 around: connect_replicants
All calls to connect_replicants needs to have an existing $schema tacked onto
-top of the args, since L<DBIx::Storage::DBI> needs it.
+top of the args, since L<DBIx::Storage::DBI> needs it, and any C<connect_info>
+options merged with the master, with replicant opts having higher priority.
=cut
-around 'connect_replicants' => sub {
- my ($method, $self, @args) = @_;
- $self->$method($self->schema, @args);
+around connect_replicants => sub {
+ my ($next, $self, @args) = @_;
+
+ for my $r (@args) {
+ $r = [ $r ] unless reftype $r eq 'ARRAY';
+
+ croak "coderef replicant connect_info not supported"
+ if ref $r->[0] && reftype $r->[0] eq 'CODE';
+
+# any connect_info options?
+ my $i = 0;
+ $i++ while $i < @$r && (reftype($r->[$i])||'') ne 'HASH';
+
+# make one if none
+ $r->[$i] = {} unless $r->[$i];
+
+# merge if two hashes
+ my %opts = map %$_, @$r[$i .. $#{$r}];
+ splice @$r, $i+1, ($#{$r} - $i), ();
+
+# merge with master
+ %opts = (%{ $self->_master_connect_info_opts }, %opts);
+
+# update
+ $r->[$i] = \%opts;
+ }
+
+ $self->$next($self->schema, @args);
};
=head2 all_storages
my $self = shift @_;
return grep {defined $_ && blessed $_} (
$self->master,
- $self->replicants,
+ values %{ $self->replicants },
);
}
}
}
+=head2 cursor_class
+
+set cursor class on all storages, or return master's
+
+=cut
+
+sub cursor_class {
+ my ($self, $cursor_class) = @_;
+
+ if ($cursor_class) {
+ $_->cursor_class($cursor_class) for $self->all_storages;
+ }
+ $self->master->cursor_class;
+}
+
=head1 GOTCHAS
Due to the fact that replicants can lag behind a master, you must take care to
use Moose::Role;
requires 'next_storage';
+use MooseX::Types::Moose qw/Int/;
+
+use namespace::clean -except => 'meta';
=head1 NAME
has 'auto_validate_every' => (
is=>'rw',
- isa=>'Int',
+ isa=>Int,
predicate=>'has_auto_validate_every',
);
use Moose;
with 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+use namespace::clean -except => 'meta';
=head1 NAME
__PACKAGE__->meta->make_immutable;
-1;
\ No newline at end of file
+1;
use Moose;
with 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+use DBIx::Class::Storage::DBI::Replicated::Types 'Weight';
+use namespace::clean -except => 'meta';
=head1 NAME
This class defines the following attributes.
+=head2 master_read_weight
+
+A number from 0 to 1 that specifies what weight to give the master when choosing
+which backend to execute a read query on. A value of 0, which is the default,
+does no reads from master, while a value of 1 gives it the same priority as any
+single replicant.
+
+=cut
+
+has master_read_weight => (is => 'rw', isa => Weight, default => sub { 0 });
+
=head1 METHODS
This class defines the following methods.
sub next_storage {
my $self = shift @_;
- my @active_replicants = $self->pool->active_replicants;
- my $count_active_replicants = $#active_replicants +1;
- my $random_replicant = int(rand($count_active_replicants));
-
- return $active_replicants[$random_replicant];
+
+ my @replicants = $self->pool->active_replicants;
+
+ if (not @replicants) {
+ # will fall back to master anyway
+ return;
+ }
+
+ my $master = $self->master;
+
+ my $rnd = $self->_random_number(@replicants + $self->master_read_weight);
+
+ return $rnd >= @replicants ? $master : $replicants[int $rnd];
+}
+
+sub _random_number {
+ rand($_[1])
}
=head1 AUTHOR
__PACKAGE__->meta->make_immutable;
-1;
\ No newline at end of file
+1;
use Moose;
use MooseX::AttributeHelpers;
use DBIx::Class::Storage::DBI::Replicated::Replicant;
-use List::Util qw(sum);
+use List::Util 'sum';
+use Scalar::Util 'reftype';
+use Carp::Clan qw/^DBIx::Class/;
+use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
+
+use namespace::clean -except => 'meta';
=head1 NAME
has 'maximum_lag' => (
is=>'rw',
- isa=>'Num',
+ isa=>Num,
required=>1,
lazy=>1,
default=>0,
has 'last_validated' => (
is=>'rw',
- isa=>'Int',
+ isa=>Int,
reader=>'last_validated',
writer=>'_last_validated',
lazy=>1,
has 'replicant_type' => (
is=>'ro',
- isa=>'ClassName',
+ isa=>ClassName,
required=>1,
default=>'DBIx::Class::Storage::DBI',
handles=>{
has 'replicants' => (
is=>'rw',
metaclass => 'Collection::Hash',
- isa=>'HashRef[DBIx::Class::Storage::DBI]',
+ isa=>HashRef['DBIx::Class::Storage::DBI'],
default=>sub {{}},
provides => {
'set' => 'set_replicant',
my @newly_created = ();
foreach my $connect_info (@_) {
+ $connect_info = [ $connect_info ]
+ if reftype $connect_info ne 'ARRAY';
+
+ croak "coderef replicant 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]=~m/^dbi\:.+\:(.+)$/);
+
+ my $key = $connect_info->[0];
+ $key = $key->{dsn} if ref $key && reftype $key eq 'HASH';
+ ($key) = ($key =~ m/^dbi\:.+\:(.+)$/);
+
$self->set_replicant( $key => $replicant);
push @newly_created, $replicant;
}
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) {
use Moose::Role;
requires qw/_query_start/;
+with 'DBIx::Class::Storage::DBI::Replicated::WithDSN';
+use MooseX::Types::Moose 'Bool';
+
+use namespace::clean -except => 'meta';
=head1 NAME
has 'active' => (
is=>'rw',
- isa=>'Bool',
+ isa=>Bool,
lazy=>1,
required=>1,
default=>1,
This class defines the following methods.
-=head2 around: _query_start
-
-advice iof the _query_start method to add more debuggin
-
-=cut
-
-around '_query_start' => sub {
- my ($method, $self, $sql, @bind) = @_;
- my $dsn = $self->_dbi_connect_info->[0];
- $self->$method("DSN: $dsn SQL: $sql", @bind);
-};
-
=head2 debugobj
Override the debugobj method to redirect this method call back to the master.
=head1 ALSO SEE
-L<<a href="http://en.wikipedia.org/wiki/Replicant">http://en.wikipedia.org/wiki/Replicant</a>>
+L<http://en.wikipedia.org/wiki/Replicant>,
+L<DBIx::Class::Storage::DBI::Replicated>
=head1 AUTHOR
=cut
-1;
\ No newline at end of file
+1;
--- /dev/null
+package # hide from PAUSE
+ DBIx::Class::Storage::DBI::Replicated::Types;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Types - Types used internally by
+L<DBIx::Class::Storage::DBI::Replicated>
+
+=cut
+
+use MooseX::Types
+ -declare => [qw/BalancerClassNamePart Weight/];
+use MooseX::Types::Moose qw/ClassName Str Num/;
+
+class_type 'DBIx::Class::Storage::DBI';
+class_type 'DBIx::Class::Schema';
+
+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;
+ };
+
+subtype Weight,
+ as Num,
+ where { $_ >= 0 && $_ <= 1 },
+ message { 'weight must be a decimal between 0 and 1' };
+
+=head1 AUTHOR
+
+ John Napiorkowski <john.napiorkowski@takkle.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
--- /dev/null
+package DBIx::Class::Storage::DBI::Replicated::WithDSN;
+
+use Moose::Role;
+requires qw/_query_start/;
+
+use namespace::clean -except => 'meta';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::WithDSN - A DBI Storage Role with DSN
+information in trace output
+
+=head1 SYNOPSIS
+
+This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
+
+=head1 DESCRIPTION
+
+This role adds C<DSN: > info to storage debugging output.
+
+=head1 METHODS
+
+This class defines the following methods.
+
+=head2 around: _query_start
+
+Add C<DSN: > to debugging output.
+
+=cut
+
+around '_query_start' => sub {
+ my ($method, $self, $sql, @bind) = @_;
+ my $dsn = $self->_dbi_connect_info->[0];
+ $self->$method("DSN: $dsn SQL: $sql", @bind);
+};
+
+=head1 ALSO SEE
+
+L<DBIx::Class::Storage::DBI>
+
+=head1 AUTHOR
+
+John Napiorkowski <john.napiorkowski@takkle.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
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
sub print {
my ($self, $msg) = @_;
+ return if $self->silence;
+
if(!defined($self->debugfh())) {
my $fh;
my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
$self->debugfh->print($msg);
}
+=head2 silence
+
+Turn off all output if set to true.
+
=head2 txn_begin
Called when a transaction begins.
use Test::More;
use Test::Exception;
use DBICTest;
+use List::Util 'first';
+use Scalar::Util 'reftype';
+use IO::Handle;
BEGIN {
eval "use DBIx::Class::Storage::DBI::Replicated; use Test::Moose";
plan $@
? ( skip_all => "Deps not installed: $@" )
- : ( tests => 79 );
+ : ( tests => 90 );
}
use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
## Initialize the object
sub new {
- my $class = shift @_;
+ my ($class, $schema_method) = (shift, shift);
my $self = $class->SUPER::new(@_);
- $self->schema( $self->init_schema );
+ $self->schema( $self->init_schema($schema_method) );
return $self;
}
# current SQLT SQLite producer does not handle DROP TABLE IF EXISTS, trap warnings here
local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /no such table.+DROP TABLE/ };
- my $class = shift @_;
-
- my $schema = DBICTest->init_schema(
- sqlite_use_file => 1,
- storage_type=>{
- '::DBI::Replicated' => {
- balancer_type=>'::Random',
- balancer_args=>{
- auto_validate_every=>100,
- },
- }
- },
- deploy_args=>{
- add_drop_table => 1,
- },
- );
+ my ($class, $schema_method) = @_;
+
+ my $method = "get_schema_$schema_method";
+ my $schema = $class->$method;
return $schema;
}
-
+
+ sub get_schema_by_storage_type {
+ DBICTest->init_schema(
+ sqlite_use_file => 1,
+ storage_type=>{
+ '::DBI::Replicated' => {
+ balancer_type=>'::Random',
+ balancer_args=>{
+ auto_validate_every=>100,
+ master_read_weight => 1
+ },
+ }
+ },
+ deploy_args=>{
+ add_drop_table => 1,
+ },
+ );
+ }
+
+ sub get_schema_by_connect_info {
+ DBICTest->init_schema(
+ sqlite_use_file => 1,
+ storage_type=> '::DBI::Replicated',
+ balancer_type=>'::Random',
+ balancer_args=> {
+ auto_validate_every=>100,
+ master_read_weight => 1
+ },
+ deploy_args=>{
+ add_drop_table => 1,
+ },
+ );
+ }
+
sub generate_replicant_connect_info {}
sub replicate {}
sub cleanup {}
+ ## --------------------------------------------------------------------- ##
+ ## Add a connect_info option to test option merging.
+ ## --------------------------------------------------------------------- ##
+ {
+ package DBIx::Class::Storage::DBI::Replicated;
+
+ use Moose;
+
+ __PACKAGE__->meta->make_mutable;
+
+ around connect_info => sub {
+ my ($next, $self, $info) = @_;
+ $info->[3]{master_option} = 1;
+ $self->$next($info);
+ };
+
+ __PACKAGE__->meta->make_immutable;
+
+ no Moose;
+ }
## --------------------------------------------------------------------- ##
## Subclass for when you are using SQLite for testing, this provides a fake
"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.
'DBIx::Class::DBI::Replicated::TestReplication::Custom' :
'DBIx::Class::DBI::Replicated::TestReplication::SQLite';
-ok my $replicated = $replicated_class->new
- => 'Created a replication object';
-
-isa_ok $replicated->schema
- => 'DBIx::Class::Schema';
-
-isa_ok $replicated->schema->storage
- => 'DBIx::Class::Storage::DBI::Replicated';
+my $replicated;
+
+for my $method (qw/by_connect_info by_storage_type/) {
+ ok $replicated = $replicated_class->new($method)
+ => "Created a replication object $method";
+
+ isa_ok $replicated->schema
+ => 'DBIx::Class::Schema';
+
+ isa_ok $replicated->schema->storage
+ => 'DBIx::Class::Storage::DBI::Replicated';
+
+ isa_ok $replicated->schema->storage->balancer
+ => 'DBIx::Class::Storage::DBI::Replicated::Balancer::Random'
+ => 'configured balancer_type';
+}
ok $replicated->schema->storage->meta
=> 'has a meta object';
ok my @replicated_storages = $replicated->schema->storage->connect_replicants(@replicant_connects)
=> 'Created some storages suitable for replicants';
-
+
+ok my @all_storages = $replicated->schema->storage->all_storages
+ => '->all_storages';
+
+is scalar @all_storages,
+ 3
+ => 'correct number of ->all_storages';
+
+is ((grep $_->isa('DBIx::Class::Storage::DBI'), @all_storages),
+ 3
+ => '->all_storages are correct type');
+
+my @all_storage_opts =
+ grep { (reftype($_)||'') eq 'HASH' }
+ map @{ $_->_connect_info }, @all_storages;
+
+is ((grep $_->{master_option}, @all_storage_opts),
+ 3
+ => 'connect_info was merged from master to 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';
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';
$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)
is $artist1->name, 'Ozric Tentacles'
=> 'Found expected name for first result';
+## Check that master_read_weight is honored
+{
+ no warnings 'once';
+
+ # turn off redefined warning
+ local $SIG{__WARN__} = sub {};
+
+ local
+ *DBIx::Class::Storage::DBI::Replicated::Balancer::Random::_random_number =
+ sub { 999 };
+
+ $replicated->schema->storage->balancer->increment_storage;
+
+ is $replicated->schema->storage->balancer->current_replicant,
+ $replicated->schema->storage->master
+ => 'master_read_weight is honored';
+
+ ## turn it off for the duration of the test
+ $replicated->schema->storage->balancer->master_read_weight(0);
+ $replicated->schema->storage->balancer->increment_storage;
+}
+
## Add some new rows that only the master will have This is because
## we overload any type of write operation so that is must hit the master
## database.
$replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
$replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
-
-ok $replicated->schema->resultset('Artist')->find(2)
- => 'Fallback to master';
+
+{
+ ## catch the fallback to master warning
+ open my $debugfh, '>', \my $fallback_warning;
+ my $oldfh = $replicated->schema->storage->debugfh;
+ $replicated->schema->storage->debugfh($debugfh);
+
+ ok $replicated->schema->resultset('Artist')->find(2)
+ => 'Fallback to master';
+
+ like $fallback_warning, qr/falling back to master/
+ => 'emits falling back to master warning';
+
+ $replicated->schema->storage->debugfh($oldfh);
+}
$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';
## Delete the old database files
$replicated->cleanup;
+
+# vim: sw=4 sts=4 :
my $dbuser = $ENV{"DBICTEST_DBUSER"} || '';
my $dbpass = $ENV{"DBICTEST_DBPASS"} || '';
- my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1 });
+ my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1, %args });
return @connect_info;
}