use DBIx::Class::Storage::DBI::Replicated::Replicant;
use List::Util 'sum';
use Scalar::Util 'reftype';
+use DBI ();
use Carp::Clan qw/^DBIx::Class/;
use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>. You
shouldn't need to create instances of this class.
-
+
=head1 DESCRIPTION
In a replicated storage type, there is at least one replicant to handle the
This is a number which defines the maximum allowed lag returned by the
L<DBIx::Class::Storage::DBI/lag_behind_master> method. The default is 0. In
general, this should return a larger number when the replicant is lagging
-behind it's master, however the implementation of this is database specific, so
+behind its master, however the implementation of this is database specific, so
don't count on this number having a fixed meaning. For example, MySQL will
return a number of seconds that the replicating database is lagging.
=head2 last_validated
This is an integer representing a time since the last time the replicants were
-validated. It's nothing fancy, just an integer provided via the perl time
+validated. It's nothing fancy, just an integer provided via the perl L<time|perlfunc/time>
builtin.
=cut
actual replicant storage. For example if the $dsn element is something like:
"dbi:SQLite:dbname=dbfile"
-
+
You could access the specific replicant via:
$schema->storage->replicants->{'dbname=dbfile'}
-
+
This attributes also supports the following helper methods:
=over 4
default=>sub {{}},
provides => {
'set' => 'set_replicant',
- 'get' => 'get_replicant',
+ 'get' => 'get_replicant',
'empty' => 'has_replicants',
'count' => 'num_replicants',
'delete' => 'delete_replicant',
- 'values' => 'all_replicant_storages',
+ 'values' => 'all_replicant_storages',
},
);
sub connect_replicants {
my $self = shift @_;
my $schema = shift @_;
-
+
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];
- $key = $key->{dsn} if ref $key && reftype $key eq 'HASH';
- ($key) = ($key =~ m/^dbi\:.+\:(.+)$/);
+ my $connect_coderef =
+ (reftype($connect_info->[0])||'') eq 'CODE' ? $connect_info->[0]
+ : (reftype($connect_info->[0])||'') eq 'HASH' &&
+ $connect_info->[0]->{dbh_maker};
- $self->set_replicant( $key => $replicant);
+ my $dsn;
+ if (not $connect_coderef) {
+ $dsn = $connect_info->[0];
+ $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH';
+ }
+ else {
+# yes this is evil, but it only usually happens once
+ no warnings 'redefine';
+ my $connect = \&DBI::connect;
+ local *DBI::connect = sub {
+ $dsn = $_[1];
+ goto $connect;
+ };
+ $connect_coderef->();
+ }
+ $replicant->dsn($dsn);
+ my ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i);
+
+ $self->set_replicant($key => $replicant);
push @newly_created, $replicant;
}
-
+
return @newly_created;
}