From: John Napiorkowski Date: Wed, 30 Apr 2008 20:26:26 +0000 (+0000) Subject: got first pass on the replication and balancer, passing all of the old test suite... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=26ab719a4d6ee414537c815677b9884b64417539;p=dbsrgits%2FDBIx-Class-Historic.git got first pass on the replication and balancer, passing all of the old test suite (which is not much, but it is a milestone of some sort) --- diff --git a/Makefile.PL b/Makefile.PL index 3a896d7..0af4f15 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -20,6 +20,7 @@ requires 'JSON::Any' => 1.00; requires 'Scope::Guard' => 0.03; requires 'Digest::SHA1' => 2.00; requires 'Path::Class' => 0; +requires 'List::Util' => 1.19; # Perl 5.8.0 doesn't have utf8::is_utf8() requires 'Encode' => 0 if ($] <= 5.008000); diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index 69997d4..a9be9ab 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -1,9 +1,12 @@ package DBIx::Class::Storage::DBI::Replicated; use Moose; +use DBIx::Class::Storage::DBI; use DBIx::Class::Storage::DBI::Replicated::Pool; +use DBIx::Class::Storage::DBI::Replicated::Balancer; +use Scalar::Util qw(blessed); -#extends 'DBIx::Class::Storage::DBI', 'Moose::Object'; +extends 'DBIx::Class::Storage::DBI', 'Moose::Object'; =head1 NAME @@ -83,7 +86,6 @@ has 'master' => ( handles=>[qw/ on_connect_do on_disconnect_do - columns_info_for connect_info throw_exception sql_maker @@ -151,121 +153,127 @@ has 'current_replicant' => ( ); -=head2 replicant_storage_pool_type +=head2 pool_type -Contains the classname which will instantiate the L -object. Defaults to: L. +Contains the classname which will instantiate the L object. Defaults +to: L. =cut -has 'replicant_storage_pool_type' => ( +has 'pool_type' => ( is=>'ro', isa=>'ClassName', required=>1, + lazy=>1, default=>'DBIx::Class::Storage::DBI::Replicated::Pool', - handles=> { - 'create_replicant_storage_pool' => 'new', + handles=>{ + 'create_pool' => 'new', }, ); -=head2 pool_balancer_type +=head2 balancer_type The replication pool requires a balance class to provider the methods for choose how to spread the query load across each replicant in the pool. =cut -has 'pool_balancer_type' => ( +has 'balancer_type' => ( is=>'ro', isa=>'ClassName', required=>1, - default=>'DBIx::Class::Storage::DBI::Replicated::Pool::Balancer', - handles=> { - 'create_replicant_storage_pool' => 'new', + lazy=>1, + default=>'DBIx::Class::Storage::DBI::Replicated::Balancer', + handles=>{ + 'create_balancer' => 'new', }, ); -=head2 replicant_storage_pool +=head2 pool -Holds the list of connected replicants, their status and other housekeeping or -reporting methods. +Is a or derived class. This is a +container class for one or more replicated databases. =cut -has 'replicant_storage_pool' => ( +has 'pool' => ( is=>'ro', isa=>'DBIx::Class::Storage::DBI::Replicated::Pool', lazy_build=>1, - handles=>[qw/replicant_storages/], + handles=>[qw/ + replicants + has_replicants + create_replicants + num_replicants + delete_replicant + /], ); +=head2 balancer -=head1 METHODS - -This class defines the following methods. +Is a or derived class. This +is a class that takes a pool () -=head2 new +=cut -Make sure we properly inherit from L. +has 'balancer' => ( + is=>'ro', + isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer', + lazy_build=>1, + handles=>[qw/next_storage/], +); -=cut +=head1 METHODS -sub new { - my $class = shift @_; - my $obj = $class->SUPER::new(@_); - - return $class->meta->new_object( - __INSTANCE__ => $obj, @_ - ); -} +This class defines the following methods. -=head2 _build_master_storage +=head2 _build_master -Lazy builder for the L attribute. +Lazy builder for the L attribute. =cut -sub _build_next_replicant_storage { +sub _build_master { DBIx::Class::Storage::DBI->new; } -=head2 _build_current_replicant_storage +=head2 _build_current_replicant Lazy builder for the L attribute. =cut -sub _build_current_replicant_storage { - shift->replicant_storage_pool->first; +sub _build_current_replicant { + my $self = shift @_; + $self->next_storage($self->pool); } -=head2 _build_replicant_storage_pool +=head2 _build_pool -Lazy builder for the L attribute. +Lazy builder for the L attribute. =cut -sub _build_replicant_storage_pool { +sub _build_pool { my $self = shift @_; - $self->create_replicant_storage_pool; + $self->create_pool; } -=head2 around: create_replicant_storage_pool +=head2 _build_balancer -Make sure all calles to the method set a default balancer type to our current -balancer type. +Lazy builder for the L attribute. =cut -around 'create_replicant_storage_pool' => sub { - my ($method, $self, @args) = @_; - return $self->$method(balancer_type=>$self->pool_balancer_type, @args); +sub _build_balancer { + my $self = shift @_; + $self->create_balancer; } @@ -277,24 +285,14 @@ the load evenly (hopefully) across existing capacity. =cut -after 'get_current_replicant_storage' => sub { +after 'get_current_replicant' => sub { my $self = shift @_; - my $next_replicant = $self->replicant_storage_pool->next; - $self->next_replicant_storage($next_replicant); + my $next_replicant = $self->next_storage($self->pool); + + $self->set_current_replicant($next_replicant); }; -=head2 find_or_create - -First do a find on the replicant. If no rows are found, pass it on to the -L - -=cut - -sub find_or_create { - my $self = shift @_; -} - =head2 all_storages Returns an array of of all the connected storage backends. The first element @@ -306,9 +304,9 @@ replicants. sub all_storages { my $self = shift @_; - return ( - $self->master_storage, - $self->replicant_storages, + return grep {defined $_ && blessed $_} ( + $self->master, + $self->replicants, ); } @@ -323,8 +321,8 @@ sub connected { my $self = shift @_; return - $self->master_storage->connected && - $self->replicant_storage_pool->has_connected_slaves; + $self->master->connected && + $self->pool->connected_replicants; } @@ -336,7 +334,7 @@ Make sure all the storages are connected. sub ensure_connected { my $self = shift @_; - foreach $source (shift->all_sources) { + foreach my $source ($self->all_storages) { $source->ensure_connected(@_); } } @@ -350,8 +348,8 @@ Set the limit_dialect for all existing storages sub limit_dialect { my $self = shift @_; - foreach $source (shift->all_sources) { - $source->name_sep(@_); + foreach my $source ($self->all_storages) { + $source->limit_dialect(@_); } } @@ -364,8 +362,8 @@ Set the quote_char for all existing storages sub quote_char { my $self = shift @_; - foreach $source (shift->all_sources) { - $source->name_sep(@_); + foreach my $source ($self->all_storages) { + $source->quote_char(@_); } } @@ -378,7 +376,7 @@ Set the name_sep for all existing storages sub name_sep { my $self = shift @_; - foreach $source (shift->all_sources) { + foreach my $source ($self->all_storages) { $source->name_sep(@_); } } @@ -392,7 +390,7 @@ Set the schema object for all existing storages sub set_schema { my $self = shift @_; - foreach $source (shift->all_sources) { + foreach my $source ($self->all_storages) { $source->set_schema(@_); } } @@ -406,7 +404,7 @@ set a debug flag across all storages sub debug { my $self = shift @_; - foreach $source (shift->all_sources) { + foreach my $source ($self->all_storages) { $source->debug(@_); } } @@ -420,7 +418,7 @@ set a debug object across all storages sub debugobj { my $self = shift @_; - foreach $source (shift->all_sources) { + foreach my $source ($self->all_storages) { $source->debugobj(@_); } } @@ -434,7 +432,7 @@ set a debugfh object across all storages sub debugfh { my $self = shift @_; - foreach $source (shift->all_sources) { + foreach my $source ($self->all_storages) { $source->debugfh(@_); } } @@ -448,7 +446,7 @@ set a debug callback across all storages sub debugcb { my $self = shift @_; - foreach $source (shift->all_sources) { + foreach my $source ($self->all_storages) { $source->debugcb(@_); } } @@ -462,7 +460,7 @@ disconnect everything sub disconnect { my $self = shift @_; - foreach $source (shift->all_sources) { + foreach my $source ($self->all_storages) { $source->disconnect(@_); } } diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm new file mode 100644 index 0000000..293fe09 --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm @@ -0,0 +1,56 @@ +package DBIx::Class::Storage::DBI::Replicated::Balancer; + +use Moose; +use List::Util qw(shuffle); + +=head1 NAME + +DBIx::Class::Storage::DBI::Replicated::Balancer; A Software Load Balancer + +=head1 SYNOPSIS + +This class is used internally by L. You +shouldn't need to create instances of this class. + +=head1 DESCRIPTION + +Given a pool (L) of replicated +database's (L), defines a +method by which query load can be spread out across each replicant in the pool. + +=head1 ATTRIBUTES + +This class defines the following attributes. + +=head1 METHODS + +This class defines the following methods. + +=head2 next_storage ($pool) + +Given a pool object, return the next replicant that will serve queries. The +default behavior is to randomize but you can write your own subclasses of +L to support other balance +systems. + +=cut + +sub next_storage { + my $self = shift @_; + my $pool = shift @_; + + return (shuffle($pool->all_replicants))[0]; +} + + +=head1 AUTHOR + +John Napiorkowski + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut + +1; \ No newline at end of file diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm new file mode 100644 index 0000000..3bf1ac8 --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm @@ -0,0 +1,176 @@ +package DBIx::Class::Storage::DBI::Replicated::Pool; + +use Moose; +use MooseX::AttributeHelpers; +use DBIx::Class::Storage::DBI::Replicated::Replicant; +use List::Util qw(sum); + +=head1 NAME + +DBIx::Class::Storage::DBI::Replicated::Pool; Manage a pool of replicants + +=head1 SYNOPSIS + +This class is used internally by L. 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 +read only traffic. The Pool class manages this replicant, or list of +replicants, and gives some methods for querying information about their status. + +=head1 ATTRIBUTES + +This class defines the following attributes. + +=head2 replicant_type + +Base class used to instantiate replicants that are in the pool. Unless you +need to subclass L you should +just leave this alone. + +=cut + +has 'replicant_type' => ( + is=>'ro', + isa=>'ClassName', + required=>1, + default=>'DBIx::Class::Storage::DBI::Replicated::Replicant', + handles=>{ + 'create_replicant' => 'new', + }, +); + + +=head2 replicants + +A hashref of replicant, with the key being the dsn and the value returning the +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 + +=item set_replicant($key=>$storage) + +Pushes a replicant onto the HashRef under $key + +=item get_replicant($key) + +Retrieves the named replicant + +=item has_replicants + +Returns true if the Pool defines replicants. + +=item num_replicants + +The number of replicants in the pool + +=item delete_replicant ($key) + +removes the replicant under $key from the pool + +=back + +=cut + +has 'replicants' => ( + is=>'rw', + metaclass => 'Collection::Hash', + isa=>'HashRef[DBIx::Class::Storage::DBI::Replicated::Replicant]', + default=>sub {{}}, + provides => { + 'set' => 'set_replicant', + 'get' => 'get_replicant', + 'empty' => 'has_replicants', + 'count' => 'num_replicants', + 'delete' => 'delete_replicant', + }, +); + + +=head1 METHODS + +This class defines the following methods. + +=head2 create_replicants (Array[$connect_info]) + +Given an array of $dsn suitable for connected to a database, create an +L object and store it in the +L attribute. + +=cut + +sub create_replicants { + my $self = shift @_; + + my @newly_created = (); + foreach my $connect_info (@_) { + my $replicant = $self->create_replicant; + $replicant->connect_info($connect_info); + $replicant->ensure_connected; + my ($key) = ($connect_info->[0]=~m/^dbi\:.+\:(.+)$/); + $self->set_replicant( $key => $replicant); + push @newly_created, $replicant; + } + + return @newly_created; +} + + +=head2 connected_replicants + +Returns true if there are connected replicants. Actually is overloaded to +return the number of replicants. So you can do stuff like: + + if( my $num_connected = $storage->has_connected_replicants ) { + print "I have $num_connected connected replicants"; + } else { + print "Sorry, no replicants."; + } + +This method will actually test that each replicant in the L hashref +is actually connected, try not to hit this 10 times a second. + +=cut + +sub connected_replicants { + my $self = shift @_; + return sum( map { + $_->connected ? 1:0 + } $self->all_replicants ); +} + +=head2 all_replicants + +Just a simple array of all the replicant storages. No particular order to the +array is given, nor should any meaning be derived. + +=cut + +sub all_replicants { + my $self = shift @_; + return values %{$self->replicants}; +} + + +=head1 AUTHOR + +John Napiorkowski + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut + + +1; \ No newline at end of file diff --git a/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm new file mode 100644 index 0000000..22ca9fe --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm @@ -0,0 +1,41 @@ +package DBIx::Class::Storage::DBI::Replicated::Replicant; + +use Moose; +extends 'DBIx::Class::Storage::DBI', 'Moose::Object'; + +=head1 NAME + +DBIx::Class::Storage::DBI::Replicated::Replicant; A replicated DBI Storage + +=head1 SYNOPSIS + +This class is used internally by L. You +shouldn't need to create instances of this class. + +=head1 DESCRIPTION + +Replicants are DBI Storages that follow a master DBI Storage. Typically this +is accomplished via an external replication system. Please see the documents +for L for more details. + +This class exists to define methods of a DBI Storage that only make sense when +it's a classic 'slave' in a pool of slave databases which replicate from a +given master database. + +=head1 ATTRIBUTES + +This class defines the following attributes. + +=head1 METHODS + +This class defines the following methods. + +=head1 AUTHOR + +John Napiorkowski + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut \ No newline at end of file diff --git a/t/93storage_replication.t b/t/93storage_replication.t index 43d3e77..146a549 100644 --- a/t/93storage_replication.t +++ b/t/93storage_replication.t @@ -8,8 +8,13 @@ BEGIN { eval "use Moose"; plan $@ ? ( skip_all => 'needs Moose for testing' ) - : ( tests => 2 ); -} + : ( tests => 30 ); +} + +use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool'; +use_ok 'DBIx::Class::Storage::DBI::Replicated::Balancer'; +use_ok 'DBIx::Class::Storage::DBI::Replicated::Replicant'; +use_ok 'DBIx::Class::Storage::DBI::Replicated'; ## ---------------------------------------------------------------------------- ## Build a class to hold all our required testing data and methods. @@ -20,55 +25,193 @@ TESTSCHEMACLASS: { package DBIx::Class::DBI::Replicated::TestReplication; use DBICTest; + use File::Copy; + use base qw/Class::Accessor::Fast/; - __PACKAGE__->mk_accessors( qw/schema/ ); + __PACKAGE__->mk_accessors( qw/schema master_path slave_paths/ ); ## Initialize the object sub new { - my $proto = shift; - my $class = ref( $proto ) || $proto; - my $self = {}; - - bless( $self, $class ); + my $class = shift @_; + my $self = $class->SUPER::new(@_); $self->schema( $self->init_schema ); + $self->master_path("t/var/DBIxClass.db"); return $self; } - ## get the Schema and set the replication storage type + ## Get the Schema and set the replication storage type sub init_schema { my $class = shift @_; my $schema = DBICTest->init_schema(storage_type=>'::DBI::Replicated'); return $schema; } + + ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for + ## $storage->connect_info to be used for connecting replicants. + + sub generate_replicant_connect_info { + my $self = shift @_; + my @dsn = map { + "dbi:SQLite:${_}"; + } @{$self->slave_paths}; + + return map { [$_,'','',{}] } @dsn; + } + + ## Do a 'good enough' replication by copying the master dbfile over each of + ## the slave dbfiles. + + sub replicate { + my $self = shift @_; + foreach my $slave (@{$self->slave_paths}) { + copy($self->master_path, $slave); + } + } + + ## Cleanup after ourselves. Unlink all gthe slave paths. + + sub cleanup { + my $self = shift @_; + foreach my $slave (@{$self->slave_paths}) { + unlink $slave; + } + } } ## ---------------------------------------------------------------------------- ## Create an object and run some tests ## ---------------------------------------------------------------------------- -my %params = ( - db_paths => [ - "t/var/DBIxClass.db", - "t/var/DBIxClass_slave1.db", - "t/var/DBIxClass_slave2.db", - ], -); +## Thi first bunch of tests are basic, just make sure all the bits are behaving -ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new() - => 'Created a replication object'; +ok my $replicated = DBIx::Class::DBI::Replicated::TestReplication + ->new({ + slave_paths=>[ + "t/var/DBIxClass_slave1.db", + "t/var/DBIxClass_slave2.db", + ], + }) => 'Created a replication object'; -isa_ok $replicate->schema +isa_ok $replicated->schema => 'DBIx::Class::Schema'; +isa_ok $replicated->schema->storage + => 'DBIx::Class::Storage::DBI::Replicated'; + +ok $replicated->schema->storage->meta + => 'has a meta object'; + +isa_ok $replicated->schema->storage->master + => 'DBIx::Class::Storage::DBI'; + +isa_ok $replicated->schema->storage->pool + => 'DBIx::Class::Storage::DBI::Replicated::Pool'; + +isa_ok $replicated->schema->storage->balancer + => 'DBIx::Class::Storage::DBI::Replicated::Balancer'; + +ok my @replicant_connects = $replicated->generate_replicant_connect_info + => 'got replication connect information'; + +ok my @replicated_storages = $replicated->schema->storage->create_replicants(@replicant_connects) + => 'Created some storages suitable for replicants'; + +isa_ok $replicated->schema->storage->current_replicant + => 'DBIx::Class::Storage::DBI'; + +ok $replicated->schema->storage->pool->has_replicants + => 'does have replicants'; + +is $replicated->schema->storage->num_replicants => 2 + => 'has two replicants'; + +isa_ok $replicated_storages[0] + => 'DBIx::Class::Storage::DBI::Replicated::Replicant'; + +isa_ok $replicated_storages[1] + => 'DBIx::Class::Storage::DBI::Replicated::Replicant'; + +isa_ok $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave1.db"} + => 'DBIx::Class::Storage::DBI::Replicated::Replicant'; + +isa_ok $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave2.db"} + => 'DBIx::Class::Storage::DBI::Replicated::Replicant'; + +## Add some info to the database + +$replicated + ->schema + ->populate('Artist', [ + [ qw/artistid name/ ], + [ 4, "Ozric Tentacles"], + ]); + +## Make sure all the slaves have the table definitions + +$replicated->replicate; + +## Make sure we can read the data. + +ok my $artist1 = $replicated->schema->resultset('Artist')->find(4) + => 'Created Result'; + +isa_ok $artist1 + => 'DBICTest::Artist'; + +is $artist1->name, 'Ozric Tentacles' + => 'Found expected name for first result'; + +## 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 + ->populate('Artist', [ + [ qw/artistid name/ ], + [ 5, "Doom's Children"], + [ 6, "Dead On Arrival"], + [ 7, "Watergate"], + ]); + +## Alright, the database 'cluster' is not in a consistent state. When we do +## a read now we expect bad news + +is $replicated->schema->resultset('Artist')->find(5), undef + => 'read after disconnect fails because it uses a replicant which we have neglected to "replicate" yet'; + +## Make sure all the slaves have the table definitions +$replicated->replicate; + +## Should find some data now + +ok my $artist2 = $replicated->schema->resultset('Artist')->find(5) + => 'Sync succeed'; - warn dump $replicate->schema->storage->meta; +isa_ok $artist2 + => 'DBICTest::Artist'; - warn dump $replicate->schema->storage->master; +is $artist2->name, "Doom's Children" + => 'Found expected name for first result'; + +## What happens when we disconnect all the replicants? + +$replicated->schema->storage->replicants->{"t/var/DBIxClass_slave1.db"}->disconnect; +$replicated->schema->storage->replicants->{"t/var/DBIxClass_slave2.db"}->disconnect; + +ok my $artist3 = $replicated->schema->resultset('Artist')->find(6) + => 'Still finding stuff.'; + +isa_ok $artist3 + => 'DBICTest::Artist'; + +is $artist3->name, "Dead On Arrival" + => 'Found expected name for first result'; __END__