package DBIx::Class::Storage::DBI::Replicated;
+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 Moose;
-use Class::MOP;
-use Moose::Util::TypeConstraints;
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
-DBIx::Class::Storage::DBI::Replicated - ALPHA Replicated database support
+DBIx::Class::Storage::DBI::Replicated - BETA Replicated database support
=head1 SYNOPSIS
=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.
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
has 'pool_type' => (
is=>'ro',
- isa=>'ClassName',
+ isa=>ClassName,
required=>1,
default=>'DBIx::Class::Storage::DBI::Replicated::Pool',
handles=>{
has 'pool_args' => (
is=>'ro',
- isa=>'HashRef',
+ 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',
+ isa=>BalancerClassNamePart,
coerce=>1,
required=>1,
default=> 'DBIx::Class::Storage::DBI::Replicated::Balancer::First',
has 'balancer_args' => (
is=>'ro',
- isa=>'HashRef',
+ isa=>HashRef,
lazy=>1,
required=>1,
default=>sub { {} },
has 'read_handler' => (
is=>'rw',
- isa=>'Object',
+ isa=>Object,
lazy_build=>1,
handles=>[qw/
select
has 'write_handler' => (
is=>'ro',
- isa=>'Object',
+ isa=>Object,
lazy_build=>1,
lazy_build=>1,
handles=>[qw/
txn_scope_guard
sth
deploy
+ with_deferred_fk_checks
reload_row
_prep_for_execute
- configure_sqlt
/],
);
+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.)
+
+=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};
+
+ $self->_master_connect_info_opts(\%opts);
+
+ $self->$next($info, @extra);
+};
+
=head1 METHODS
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
=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
=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 },
);
}
foreach my $source ($self->all_storages) {
$source->limit_dialect(@_);
}
+ return $self->master->quote_char;
}
=head2 quote_char
foreach my $source ($self->all_storages) {
$source->quote_char(@_);
}
+ return $self->master->quote_char;
}
=head2 name_sep
foreach my $source ($self->all_storages) {
$source->name_sep(@_);
}
+ return $self->master->name_sep;
}
=head2 set_schema
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
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
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
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
}
}
+=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
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
projects / dbsrgits/DBIx-Class.git / blobdiff