X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FReplicated.pm;h=0dc50d784f5d07bf13eec5b33bc367caf3bdf449;hb=f2469db16c251b4a6554f244943db6d902203d3c;hp=a241ff45a37389777aff6415aed17e40ef64afc5;hpb=41916570b3a93b05746e23b73c9a9b5005bc0d2e;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index a241ff4..0dc50d7 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -11,6 +11,7 @@ BEGIN { MooseX::AttributeHelpers => '0.12', MooseX::Types => '0.10', namespace::clean => '0.11', + Hash::Merge => '0.11' ); my @didnt_load; @@ -25,11 +26,15 @@ BEGIN { 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 Hash::Merge 'merge'; use namespace::clean -except => 'meta'; @@ -107,6 +112,7 @@ Replicated Storage has additional requirements not currently part of L 0.12 MooseX::Types => 0.10 namespace::clean => 0.11 + Hash::Merge => 0.11 You will need to install these modules manually via CPAN or make them part of the Makefile for your distribution. @@ -136,9 +142,8 @@ to: L. =cut has 'pool_type' => ( - is=>'ro', + is=>'rw', isa=>ClassName, - required=>1, default=>'DBIx::Class::Storage::DBI::Replicated::Pool', handles=>{ 'create_pool' => 'new', @@ -153,10 +158,9 @@ See L for available arguments. =cut has 'pool_args' => ( - is=>'ro', + is=>'rw', isa=>HashRef, lazy=>1, - required=>1, default=>sub { {} }, ); @@ -169,7 +173,7 @@ choose how to spread the query load across each replicant in the pool. =cut has 'balancer_type' => ( - is=>'ro', + is=>'rw', isa=>BalancerClassNamePart, coerce=>1, required=>1, @@ -187,7 +191,7 @@ See L for available arguments. =cut has 'balancer_args' => ( - is=>'ro', + is=>'rw', isa=>HashRef, lazy=>1, required=>1, @@ -220,7 +224,7 @@ is a class that takes a pool () =cut has 'balancer' => ( - is=>'ro', + is=>'rw', isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer', lazy_build=>1, handles=>[qw/auto_validate_every/], @@ -274,7 +278,6 @@ has 'write_handler' => ( is=>'ro', isa=>Object, lazy_build=>1, - lazy_build=>1, handles=>[qw/ on_connect_do on_disconnect_do @@ -307,6 +310,56 @@ has 'write_handler' => ( /], ); +has _master_connect_info_opts => + (is => 'rw', isa => HashRef, default => sub { {} }); + +=head2 around: connect_info + +Preserve master's C options (for merging with replicants.) +Also set any Replicated related options from connect_info, such as +C, C, C and C. + +=cut + +around connect_info => sub { + my ($next, $self, $info, @extra) = @_; + + my %opts; + for my $arg (@$info) { + next unless (reftype($arg)||'') eq 'HASH'; + %opts = %{ merge($arg, \%opts) }; + } + delete $opts{dsn}; + + if (@opts{qw/pool_type pool_args/}) { + $self->pool_type(delete $opts{pool_type}) + if $opts{pool_type}; + + $self->pool_args( + merge((delete $opts{pool_args} || {}), $self->pool_args) + ); + + $self->pool($self->_build_pool) + if $self->pool; + } + + if (@opts{qw/balancer_type balancer_args/}) { + $self->balancer_type(delete $opts{balancer_type}) + if $opts{balancer_type}; + + $self->balancer_args( + merge((delete $opts{balancer_args} || {}), $self->balancer_args) + ); + + $self->balancer($self->_build_balancer) + if $self->balancer; + } + + $self->_master_connect_info_opts(\%opts); + + $self->$next($info, @extra); +}; + =head1 METHODS This class defines the following methods. @@ -337,7 +390,9 @@ Lazy builder for the L attribute. 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 @@ -392,13 +447,49 @@ sub _build_read_handler { =head2 around: connect_replicants All calls to connect_replicants needs to have an existing $schema tacked onto -top of the args, since L needs it. +top of the args, since L needs it, and any C +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 @hashes = @$r[$i .. $#{$r}]; + + croak "invalid connect_info options" + if (grep { reftype($_) eq 'HASH' } @hashes) != @hashes; + + croak "too many hashrefs in connect_info" + if @hashes > 2; + + my %opts = %{ merge(reverse @hashes) }; + +# delete them + splice @$r, $i+1, ($#{$r} - $i), (); + +# merge with master + %opts = %{ merge(\%opts, $self->_master_connect_info_opts) }; + +# update + $r->[$i] = \%opts; + } + + $self->$next($self->schema, @args); }; =head2 all_storages @@ -683,6 +774,21 @@ sub 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