[Bast-commits] r4491 - in
DBIx-Class/0.08/branches/replication_dedux: lib/DBIx/Class
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/Replicated
lib/DBIx/Class/Storage/DBI/Replicated/Balancer t
t/lib/DBICTest/Schema
jnapiorkowski at dev.catalyst.perl.org
jnapiorkowski at dev.catalyst.perl.org
Wed Jun 11 16:01:00 BST 2008
Author: jnapiorkowski
Date: 2008-06-11 16:01:00 +0100 (Wed, 11 Jun 2008)
New Revision: 4491
Modified:
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t
DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TreeLike.pm
Log:
1) changed all 4 space indentation to 2 space style indents for replication code, 2) fixed broken index test that was broken after pulling from trunk, 3) updated some docs and better internal docs for replication test, 4) added a couple of new tests to make sure replication does not explode if you are careless about transactions inside of transactions inside of execute_reliably, etc.
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema.pm 2008-06-11 14:41:07 UTC (rev 4490)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Schema.pm 2008-06-11 15:01:00 UTC (rev 4491)
@@ -699,14 +699,14 @@
}
sub _normalize_storage_type {
- my ($self, $storage_type) = @_;
- if(ref $storage_type eq 'ARRAY') {
- return @$storage_type;
- } elsif(ref $storage_type eq 'HASH') {
- return %$storage_type;
- } else {
- $self->throw_exception('Unsupported REFTYPE given: '. ref $storage_type);
- }
+ my ($self, $storage_type) = @_;
+ if(ref $storage_type eq 'ARRAY') {
+ return @$storage_type;
+ } elsif(ref $storage_type eq 'HASH') {
+ return %$storage_type;
+ } else {
+ $self->throw_exception('Unsupported REFTYPE given: '. ref $storage_type);
+ }
}
=head2 connect
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm 2008-06-11 14:41:07 UTC (rev 4490)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm 2008-06-11 15:01:00 UTC (rev 4491)
@@ -36,7 +36,7 @@
=cut
sub next_storage {
- return (shift->pool->active_replicants)[0];
+ return (shift->pool->active_replicants)[0];
}
=head1 AUTHOR
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm 2008-06-11 14:41:07 UTC (rev 4490)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm 2008-06-11 15:01:00 UTC (rev 4491)
@@ -40,7 +40,7 @@
=cut
sub next_storage {
- return (shuffle(shift->pool->active_replicants))[0];
+ return (shuffle(shift->pool->active_replicants))[0];
}
=head1 AUTHOR
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm 2008-06-11 14:41:07 UTC (rev 4490)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm 2008-06-11 15:01:00 UTC (rev 4491)
@@ -30,9 +30,9 @@
=cut
has 'auto_validate_every' => (
- is=>'rw',
- isa=>'Int',
- predicate=>'has_auto_validate_every',
+ is=>'rw',
+ isa=>'Int',
+ predicate=>'has_auto_validate_every',
);
=head2 master
@@ -44,9 +44,9 @@
=cut
has 'master' => (
- is=>'ro',
- isa=>'DBIx::Class::Storage::DBI',
- required=>1,
+ is=>'ro',
+ isa=>'DBIx::Class::Storage::DBI',
+ required=>1,
);
=head2 pool
@@ -57,9 +57,9 @@
=cut
has 'pool' => (
- is=>'ro',
- isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
- required=>1,
+ is=>'ro',
+ isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
+ required=>1,
);
=head2 current_replicant
@@ -76,14 +76,14 @@
=cut
has 'current_replicant' => (
- is=> 'rw',
- isa=>'DBIx::Class::Storage::DBI',
- lazy_build=>1,
- handles=>[qw/
- select
- select_single
- columns_info_for
- /],
+ is=> 'rw',
+ isa=>'DBIx::Class::Storage::DBI',
+ lazy_build=>1,
+ handles=>[qw/
+ select
+ select_single
+ columns_info_for
+ /],
);
=head1 METHODS
@@ -97,8 +97,8 @@
=cut
sub _build_current_replicant {
- my $self = shift @_;
- $self->next_storage;
+ my $self = shift @_;
+ $self->next_storage;
}
=head2 next_storage
@@ -124,20 +124,20 @@
=cut
around 'next_storage' => sub {
- my ($next_storage, $self, @args) = @_;
- my $now = time;
+ my ($next_storage, $self, @args) = @_;
+ my $now = time;
- ## Do we need to validate the replicants?
- if(
- $self->has_auto_validate_every &&
- ($self->auto_validate_every + $self->pool->last_validated) <= $now
- ) {
- $self->pool->validate_replicants;
- }
+ ## Do we need to validate the replicants?
+ if(
+ $self->has_auto_validate_every &&
+ ($self->auto_validate_every + $self->pool->last_validated) <= $now
+ ) {
+ $self->pool->validate_replicants;
+ }
- ## Get a replicant, or the master if none
- my $next = $self->$next_storage(@args);
- return $next ? $next:$self->master;
+ ## Get a replicant, or the master if none
+ my $next = $self->$next_storage(@args);
+ return $next ? $next:$self->master;
};
=head2 before: select
@@ -149,9 +149,9 @@
=cut
before 'select' => sub {
- my $self = shift @_;
- my $next_replicant = $self->next_storage;
- $self->current_replicant($next_replicant);
+ my $self = shift @_;
+ my $next_replicant = $self->next_storage;
+ $self->current_replicant($next_replicant);
};
=head2 before: select_single
@@ -163,9 +163,9 @@
=cut
before 'select_single' => sub {
- my $self = shift @_;
- my $next_replicant = $self->next_storage;
- $self->current_replicant($next_replicant);
+ my $self = shift @_;
+ my $next_replicant = $self->next_storage;
+ $self->current_replicant($next_replicant);
};
=head2 before: columns_info_for
@@ -177,9 +177,9 @@
=cut
before 'columns_info_for' => sub {
- my $self = shift @_;
- my $next_replicant = $self->next_storage;
- $self->current_replicant($next_replicant);
+ my $self = shift @_;
+ my $next_replicant = $self->next_storage;
+ $self->current_replicant($next_replicant);
};
=head1 AUTHOR
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2008-06-11 14:41:07 UTC (rev 4490)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2008-06-11 15:01:00 UTC (rev 4491)
@@ -13,7 +13,7 @@
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
@@ -36,11 +36,11 @@
=cut
has 'maximum_lag' => (
- is=>'rw',
- isa=>'Num',
- required=>1,
- lazy=>1,
- default=>0,
+ is=>'rw',
+ isa=>'Num',
+ required=>1,
+ lazy=>1,
+ default=>0,
);
=head2 last_validated
@@ -52,14 +52,12 @@
=cut
has 'last_validated' => (
- is=>'rw',
- isa=>'Int',
- reader=>'last_validated',
- writer=>'_last_validated',
- lazy=>1,
- default=>sub {
- 0;
- },
+ is=>'rw',
+ isa=>'Int',
+ reader=>'last_validated',
+ writer=>'_last_validated',
+ lazy=>1,
+ default=>0,
);
=head2 replicant_type ($classname)
@@ -71,13 +69,13 @@
=cut
has 'replicant_type' => (
- is=>'ro',
- isa=>'ClassName',
- required=>1,
- default=>'DBIx::Class::Storage::DBI',
- handles=>{
- 'create_replicant' => 'new',
- },
+ is=>'ro',
+ isa=>'ClassName',
+ required=>1,
+ default=>'DBIx::Class::Storage::DBI',
+ handles=>{
+ 'create_replicant' => 'new',
+ },
);
=head2 replicants
@@ -85,13 +83,13 @@
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"
-
+ "dbi:SQLite:dbname=dbfile"
+
You could access the specific replicant via:
- $schema->storage->replicants->{'dbname=dbfile'}
-
-This attributes also supports the following helper methods
+ $schema->storage->replicants->{'dbname=dbfile'}
+
+This attributes also supports the following helper methods:
=over 4
@@ -120,17 +118,17 @@
=cut
has 'replicants' => (
- is=>'rw',
- metaclass => 'Collection::Hash',
- isa=>'HashRef[DBIx::Class::Storage::DBI]',
- default=>sub {{}},
- provides => {
- 'set' => 'set_replicant',
- 'get' => 'get_replicant',
- 'empty' => 'has_replicants',
- 'count' => 'num_replicants',
- 'delete' => 'delete_replicant',
- },
+ is=>'rw',
+ metaclass => 'Collection::Hash',
+ isa=>'HashRef[DBIx::Class::Storage::DBI]',
+ default=>sub {{}},
+ provides => {
+ 'set' => 'set_replicant',
+ 'get' => 'get_replicant',
+ 'empty' => 'has_replicants',
+ 'count' => 'num_replicants',
+ 'delete' => 'delete_replicant',
+ },
);
=head1 METHODS
@@ -146,23 +144,21 @@
=cut
sub connect_replicants {
- my $self = shift @_;
- my $schema = shift @_;
-
- my @newly_created = ();
- foreach my $connect_info (@_) {
-
- my $replicant = $self->create_replicant($schema);
- $replicant->connect_info($connect_info);
- $replicant->ensure_connected;
- DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);
-
- my ($key) = ($connect_info->[0]=~m/^dbi\:.+\:(.+)$/);
- $self->set_replicant( $key => $replicant);
- push @newly_created, $replicant;
- }
-
- return @newly_created;
+ my $self = shift @_;
+ my $schema = shift @_;
+
+ my @newly_created = ();
+ foreach my $connect_info (@_) {
+ my $replicant = $self->create_replicant($schema);
+ $replicant->connect_info($connect_info);
+ $replicant->ensure_connected;
+ DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);
+ my ($key) = ($connect_info->[0]=~m/^dbi\:.+\:(.+)$/);
+ $self->set_replicant( $key => $replicant);
+ push @newly_created, $replicant;
+ }
+
+ return @newly_created;
}
=head2 connected_replicants
@@ -170,11 +166,11 @@
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.";
- }
+ 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</replicants> hashref
is actually connected, try not to hit this 10 times a second.
@@ -182,10 +178,10 @@
=cut
sub connected_replicants {
- my $self = shift @_;
- return sum( map {
- $_->connected ? 1:0
- } $self->all_replicants );
+ my $self = shift @_;
+ return sum( map {
+ $_->connected ? 1:0
+ } $self->all_replicants );
}
=head2 active_replicants
@@ -197,10 +193,10 @@
=cut
sub active_replicants {
- my $self = shift @_;
- return ( grep {$_} map {
- $_->active ? $_:0
- } $self->all_replicants );
+ my $self = shift @_;
+ return ( grep {$_} map {
+ $_->active ? $_:0
+ } $self->all_replicants );
}
=head2 all_replicants
@@ -211,8 +207,8 @@
=cut
sub all_replicants {
- my $self = shift @_;
- return values %{$self->replicants};
+ my $self = shift @_;
+ return values %{$self->replicants};
}
=head2 validate_replicants
@@ -234,23 +230,22 @@
=cut
sub validate_replicants {
- my $self = shift @_;
- foreach my $replicant($self->all_replicants) {
- if(
- $replicant->is_replicating &&
- $replicant->lag_behind_master <= $self->maximum_lag &&
- $replicant->ensure_connected
- ) {
- ## TODO:: Hook debug for this
- $replicant->active(1)
- } else {
- ## TODO:: Hook debug for this
- $replicant->active(0);
- }
+ my $self = shift @_;
+ foreach my $replicant($self->all_replicants) {
+ if(
+ $replicant->is_replicating &&
+ $replicant->lag_behind_master <= $self->maximum_lag &&
+ $replicant->ensure_connected
+ ) {
+ ## TODO:: Hook debug for this
+ $replicant->active(1)
+ } else {
+ ## TODO:: Hook debug for this
+ $replicant->active(0);
}
-
- ## Mark that we completed this validation.
- $self->_last_validated(time);
+ }
+ ## Mark that we completed this validation.
+ $self->_last_validated(time);
}
=head1 AUTHOR
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2008-06-11 14:41:07 UTC (rev 4490)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2008-06-11 15:01:00 UTC (rev 4491)
@@ -40,11 +40,11 @@
=cut
has 'active' => (
- is=>'rw',
- isa=>'Bool',
- lazy=>1,
- required=>1,
- default=>1,
+ is=>'rw',
+ isa=>'Bool',
+ lazy=>1,
+ required=>1,
+ default=>1,
);
=head1 METHODS
@@ -58,9 +58,9 @@
=cut
around '_query_start' => sub {
- my ($method, $self, $sql, @bind) = @_;
- my $dsn = $self->connect_info->[0];
- $self->$method("DSN: $dsn SQL: $sql", @bind);
+ my ($method, $self, $sql, @bind) = @_;
+ my $dsn = $self->connect_info->[0];
+ $self->$method("DSN: $dsn SQL: $sql", @bind);
};
=head1 AUTHOR
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm 2008-06-11 14:41:07 UTC (rev 4490)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/DBIx/Class/Storage/DBI/Replicated.pm 2008-06-11 15:01:00 UTC (rev 4491)
@@ -18,18 +18,18 @@
storage type, add some replicated (readonly) databases, and perform reporting
tasks.
- ## Change storage_type in your schema class
- $schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
-
- ## Add some slaves. Basically this is an array of arrayrefs, where each
- ## arrayref is database connect information
-
- $schema->storage->connect_replicants(
- [$dsn1, $user, $pass, \%opts],
- [$dsn2, $user, $pass, \%opts],
- [$dsn3, $user, $pass, \%opts],
- );
-
+ ## Change storage_type in your schema class
+ $schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
+
+ ## Add some slaves. Basically this is an array of arrayrefs, where each
+ ## arrayref is database connect information
+
+ $schema->storage->connect_replicants(
+ [$dsn1, $user, $pass, \%opts],
+ [$dsn2, $user, $pass, \%opts],
+ [$dsn3, $user, $pass, \%opts],
+ );
+
=head1 DESCRIPTION
Warning: This class is marked ALPHA. We are using this in development and have
@@ -71,12 +71,12 @@
=cut
has 'pool_type' => (
- is=>'ro',
- isa=>'ClassName',
- lazy_build=>1,
- handles=>{
- 'create_pool' => 'new',
- },
+ is=>'ro',
+ isa=>'ClassName',
+ lazy_build=>1,
+ handles=>{
+ 'create_pool' => 'new',
+ },
);
=head2 pool_args
@@ -87,11 +87,11 @@
=cut
has 'pool_args' => (
- is=>'ro',
- isa=>'HashRef',
- lazy=>1,
- required=>1,
- default=>sub { {} },
+ is=>'ro',
+ isa=>'HashRef',
+ lazy=>1,
+ required=>1,
+ default=>sub { {} },
);
@@ -103,12 +103,12 @@
=cut
has 'balancer_type' => (
- is=>'ro',
- isa=>'ClassName',
- lazy_build=>1,
- handles=>{
- 'create_balancer' => 'new',
- },
+ is=>'ro',
+ isa=>'ClassName',
+ lazy_build=>1,
+ handles=>{
+ 'create_balancer' => 'new',
+ },
);
=head2 balancer_args
@@ -119,11 +119,11 @@
=cut
has 'balancer_args' => (
- is=>'ro',
- isa=>'HashRef',
- lazy=>1,
- required=>1,
- default=>sub { {} },
+ is=>'ro',
+ isa=>'HashRef',
+ lazy=>1,
+ required=>1,
+ default=>sub { {} },
);
=head2 pool
@@ -134,14 +134,14 @@
=cut
has 'pool' => (
- is=>'ro',
- isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
- lazy_build=>1,
- handles=>[qw/
- connect_replicants
- replicants
- has_replicants
- /],
+ is=>'ro',
+ isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
+ lazy_build=>1,
+ handles=>[qw/
+ connect_replicants
+ replicants
+ has_replicants
+ /],
);
=head2 balancer
@@ -152,10 +152,10 @@
=cut
has 'balancer' => (
- is=>'ro',
- isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
- lazy_build=>1,
- handles=>[qw/auto_validate_every/],
+ is=>'ro',
+ isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
+ lazy_build=>1,
+ handles=>[qw/auto_validate_every/],
);
=head2 master
@@ -169,9 +169,9 @@
=cut
has 'master' => (
- is=> 'ro',
- isa=>'DBIx::Class::Storage::DBI',
- lazy_build=>1,
+ is=> 'ro',
+ isa=>'DBIx::Class::Storage::DBI',
+ lazy_build=>1,
);
=head1 ATTRIBUTES IMPLEMENTING THE DBIx::Storage::DBI INTERFACE
@@ -186,14 +186,14 @@
=cut
has 'read_handler' => (
- is=>'rw',
- isa=>'Object',
- lazy_build=>1,
- handles=>[qw/
- select
- select_single
- columns_info_for
- /],
+ is=>'rw',
+ isa=>'Object',
+ lazy_build=>1,
+ handles=>[qw/
+ select
+ select_single
+ columns_info_for
+ /],
);
=head2 write_handler
@@ -203,35 +203,35 @@
=cut
has 'write_handler' => (
- is=>'ro',
- isa=>'Object',
- lazy_build=>1,
- lazy_build=>1,
- handles=>[qw/
- on_connect_do
- on_disconnect_do
- connect_info
- throw_exception
- sql_maker
- sqlt_type
- create_ddl_dir
- deployment_statements
- datetime_parser
- datetime_parser_type
- last_insert_id
- insert
- insert_bulk
- update
- delete
- dbh
- txn_do
- txn_commit
- txn_rollback
- sth
- deploy
- schema
- reload_row
- /],
+ is=>'ro',
+ isa=>'Object',
+ lazy_build=>1,
+ lazy_build=>1,
+ handles=>[qw/
+ on_connect_do
+ on_disconnect_do
+ connect_info
+ throw_exception
+ sql_maker
+ sqlt_type
+ create_ddl_dir
+ deployment_statements
+ datetime_parser
+ datetime_parser_type
+ last_insert_id
+ insert
+ insert_bulk
+ update
+ delete
+ dbh
+ txn_do
+ txn_commit
+ txn_rollback
+ sth
+ deploy
+ schema
+ reload_row
+ /],
);
=head1 METHODS
@@ -249,23 +249,23 @@
=cut
sub new {
- my $class = shift @_;
- my $schema = shift @_;
- my $storage_type_args = shift @_;
- my $obj = $class->SUPER::new($schema, $storage_type_args, @_);
-
- ## Hate to do it this way, but can't seem to get advice on the attribute working right
- ## maybe we can do a type and coercion for it.
- if( $storage_type_args->{balancer_type} && $storage_type_args->{balancer_type}=~m/^::/) {
- $storage_type_args->{balancer_type} = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$storage_type_args->{balancer_type};
- eval "require $storage_type_args->{balancer_type}";
- }
-
- return $class->meta->new_object(
- __INSTANCE__ => $obj,
- %$storage_type_args,
- @_,
- );
+ my $class = shift @_;
+ my $schema = shift @_;
+ my $storage_type_args = shift @_;
+ my $obj = $class->SUPER::new($schema, $storage_type_args, @_);
+
+ ## Hate to do it this way, but can't seem to get advice on the attribute working right
+ ## maybe we can do a type and coercion for it.
+ if( $storage_type_args->{balancer_type} && $storage_type_args->{balancer_type}=~m/^::/) {
+ $storage_type_args->{balancer_type} = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$storage_type_args->{balancer_type};
+ eval "require $storage_type_args->{balancer_type}";
+ }
+
+ return $class->meta->new_object(
+ __INSTANCE__ => $obj,
+ %$storage_type_args,
+ @_,
+ );
}
=head2 _build_master
@@ -275,7 +275,7 @@
=cut
sub _build_master {
- DBIx::Class::Storage::DBI->new;
+ DBIx::Class::Storage::DBI->new;
}
=head2 _build_pool_type
@@ -285,7 +285,7 @@
=cut
sub _build_pool_type {
- return 'DBIx::Class::Storage::DBI::Replicated::Pool';
+ return 'DBIx::Class::Storage::DBI::Replicated::Pool';
}
=head2 _build_pool
@@ -295,8 +295,8 @@
=cut
sub _build_pool {
- my $self = shift @_;
- $self->create_pool(%{$self->pool_args});
+ my $self = shift @_;
+ $self->create_pool(%{$self->pool_args});
}
=head2 _build_balancer_type
@@ -306,7 +306,7 @@
=cut
sub _build_balancer_type {
- return 'DBIx::Class::Storage::DBI::Replicated::Balancer::First';
+ return 'DBIx::Class::Storage::DBI::Replicated::Balancer::First';
}
=head2 _build_balancer
@@ -317,12 +317,12 @@
=cut
sub _build_balancer {
- my $self = shift @_;
- $self->create_balancer(
- pool=>$self->pool,
- master=>$self->master,
- %{$self->balancer_args},
- );
+ my $self = shift @_;
+ $self->create_balancer(
+ pool=>$self->pool,
+ master=>$self->master,
+ %{$self->balancer_args},
+ );
}
=head2 _build_write_handler
@@ -333,7 +333,7 @@
=cut
sub _build_write_handler {
- return shift->master;
+ return shift->master;
}
=head2 _build_read_handler
@@ -344,7 +344,7 @@
=cut
sub _build_read_handler {
- return shift->balancer;
+ return shift->balancer;
}
=head2 around: connect_replicants
@@ -355,8 +355,8 @@
=cut
around 'connect_replicants' => sub {
- my ($method, $self, @args) = @_;
- $self->$method($self->schema, @args);
+ my ($method, $self, @args) = @_;
+ $self->$method($self->schema, @args);
};
=head2 all_storages
@@ -368,12 +368,11 @@
=cut
sub all_storages {
- my $self = shift @_;
-
- return grep {defined $_ && blessed $_} (
- $self->master,
- $self->replicants,
- );
+ my $self = shift @_;
+ return grep {defined $_ && blessed $_} (
+ $self->master,
+ $self->replicants,
+ );
}
=head2 execute_reliably ($coderef, ?@args)
@@ -384,14 +383,14 @@
Example:
- my $reliably = sub {
- my $name = shift @_;
- $schema->resultset('User')->create({name=>$name});
- my $user_rs = $schema->resultset('User')->find({name=>$name});
- return $user_rs;
- };
+ my $reliably = sub {
+ my $name = shift @_;
+ $schema->resultset('User')->create({name=>$name});
+ my $user_rs = $schema->resultset('User')->find({name=>$name});
+ return $user_rs;
+ };
- my $user_rs = $schema->storage->execute_reliably($reliably, 'John');
+ my $user_rs = $schema->storage->execute_reliably($reliably, 'John');
Use this when you must be certain of your database state, such as when you just
inserted something and need to get a resultset including it, etc.
@@ -399,77 +398,76 @@
=cut
sub execute_reliably {
- my ($self, $coderef, @args) = @_;
-
- unless( ref $coderef eq 'CODE') {
- $self->throw_exception('Second argument must be a coderef');
- }
-
- ##Get copy of master storage
- my $master = $self->master;
-
- ##Get whatever the current read hander is
- my $current = $self->read_handler;
-
- ##Set the read handler to master
- $self->read_handler($master);
-
- ## do whatever the caller needs
- my @result;
- my $want_array = wantarray;
-
- eval {
- if($want_array) {
- @result = $coderef->(@args);
- }
- elsif(defined $want_array) {
- ($result[0]) = ($coderef->(@args));
- } else {
- $coderef->(@args);
- }
- };
-
- ##Reset to the original state
- $self->read_handler($current);
-
- ##Exception testing has to come last, otherwise you might leave the
- ##read_handler set to master.
-
- if($@) {
- $self->throw_exception("coderef returned an error: $@");
+ my ($self, $coderef, @args) = @_;
+
+ unless( ref $coderef eq 'CODE') {
+ $self->throw_exception('Second argument must be a coderef');
+ }
+
+ ##Get copy of master storage
+ my $master = $self->master;
+
+ ##Get whatever the current read hander is
+ my $current = $self->read_handler;
+
+ ##Set the read handler to master
+ $self->read_handler($master);
+
+ ## do whatever the caller needs
+ my @result;
+ my $want_array = wantarray;
+
+ eval {
+ if($want_array) {
+ @result = $coderef->(@args);
+ } elsif(defined $want_array) {
+ ($result[0]) = ($coderef->(@args));
} else {
- return $want_array ? @result : $result[0];
- }
+ $coderef->(@args);
+ }
+ };
+
+ ##Reset to the original state
+ $self->read_handler($current);
+
+ ##Exception testing has to come last, otherwise you might leave the
+ ##read_handler set to master.
+
+ if($@) {
+ $self->throw_exception("coderef returned an error: $@");
+ } else {
+ return $want_array ? @result : $result[0];
+ }
}
=head2 set_reliable_storage
Sets the current $schema to be 'reliable', that is all queries, both read and
write are sent to the master
-
+
=cut
sub set_reliable_storage {
- my $self = shift @_;
- my $schema = $self->schema;
- my $write_handler = $self->schema->storage->write_handler;
-
- $schema->storage->read_handler($write_handler);
+ my $self = shift @_;
+ my $schema = $self->schema;
+ my $write_handler = $self->schema->storage->write_handler;
+
+ $schema->storage->read_handler($write_handler);
}
=head2 set_balanced_storage
Sets the current $schema to be use the </balancer> for all reads, while all
writea are sent to the master only
-
+
=cut
sub set_balanced_storage {
- my $self = shift @_;
- my $schema = $self->schema;
- my $write_handler = $self->schema->storage->balancer;
-
- $schema->storage->read_handler($write_handler);
+ my $self = shift @_;
+ my $schema = $self->schema;
+ my $write_handler = $self->schema->storage->balancer;
+
+ $schema->storage->read_handler($write_handler);
}
=head2 around: txn_do ($coderef)
@@ -481,8 +479,8 @@
=cut
around 'txn_do' => sub {
- my($txn_do, $self, $coderef, @args) = @_;
- $self->execute_reliably(sub {$self->$txn_do($coderef, @args)});
+ my($txn_do, $self, $coderef, @args) = @_;
+ $self->execute_reliably(sub {$self->$txn_do($coderef, @args)});
};
=head2 reload_row ($row)
@@ -493,10 +491,10 @@
=cut
around 'reload_row' => sub {
- my ($reload_row, $self, $row) = @_;
- return $self->execute_reliably(sub {
- return $self->$reload_row(shift);
- }, $row);
+ my ($reload_row, $self, $row) = @_;
+ return $self->execute_reliably(sub {
+ return $self->$reload_row(shift);
+ }, $row);
};
=head2 connected
@@ -506,11 +504,10 @@
=cut
sub connected {
- my $self = shift @_;
-
- return
- $self->master->connected &&
- $self->pool->connected_replicants;
+ my $self = shift @_;
+ return
+ $self->master->connected &&
+ $self->pool->connected_replicants;
}
=head2 ensure_connected
@@ -520,10 +517,10 @@
=cut
sub ensure_connected {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->ensure_connected(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->ensure_connected(@_);
+ }
}
=head2 limit_dialect
@@ -533,10 +530,10 @@
=cut
sub limit_dialect {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->limit_dialect(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->limit_dialect(@_);
+ }
}
=head2 quote_char
@@ -546,10 +543,10 @@
=cut
sub quote_char {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->quote_char(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->quote_char(@_);
+ }
}
=head2 name_sep
@@ -559,10 +556,10 @@
=cut
sub name_sep {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->name_sep(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->name_sep(@_);
+ }
}
=head2 set_schema
@@ -572,10 +569,10 @@
=cut
sub set_schema {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->set_schema(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->set_schema(@_);
+ }
}
=head2 debug
@@ -585,10 +582,10 @@
=cut
sub debug {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->debug(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->debug(@_);
+ }
}
=head2 debugobj
@@ -598,10 +595,10 @@
=cut
sub debugobj {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->debugobj(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->debugobj(@_);
+ }
}
=head2 debugfh
@@ -611,10 +608,10 @@
=cut
sub debugfh {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->debugfh(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->debugfh(@_);
+ }
}
=head2 debugcb
@@ -624,10 +621,10 @@
=cut
sub debugcb {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->debugcb(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->debugcb(@_);
+ }
}
=head2 disconnect
@@ -637,20 +634,20 @@
=cut
sub disconnect {
- my $self = shift @_;
- foreach my $source ($self->all_storages) {
- $source->disconnect(@_);
- }
+ my $self = shift @_;
+ foreach my $source ($self->all_storages) {
+ $source->disconnect(@_);
+ }
}
=head1 AUTHOR
- John Napiorkowski <john.napiorkowski at takkle.com>
+ John Napiorkowski <john.napiorkowski at takkle.com>
Based on code originated by:
- Norbert Csongrádi <bert at cpan.org>
- Peter Siklósi <einon at einon.hu>
+ Norbert Csongrádi <bert at cpan.org>
+ Peter Siklósi <einon at einon.hu>
=head1 LICENSE
Modified: DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t 2008-06-11 14:41:07 UTC (rev 4490)
+++ DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t 2008-06-11 15:01:00 UTC (rev 4491)
@@ -9,7 +9,7 @@
eval "use Moose; use Test::Moose";
plan $@
? ( skip_all => 'needs Moose for testing' )
- : ( tests => 71 );
+ : ( tests => 77 );
}
use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
@@ -478,12 +478,15 @@
[ $id, "Children of the Grave"],
]);
- ok my $result = $replicated->schema->resultset('Artist')->find($id);
- ok my $more = $replicated->schema->resultset('Artist')->find(1);
-
+ ok my $result = $replicated->schema->resultset('Artist')->find($id)
+ => 'Found expected artist';
+
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'Found expected artist again';
+
return ($result, $more);
-};
+} => 'Created a coderef properly';
## Test the transaction with multi return
{
@@ -510,7 +513,8 @@
{
ok my $result = $replicated->schema->txn_do(sub {
- ok my $more = $replicated->schema->resultset('Artist')->find(1);
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'found inside a transaction';
return $more;
}) => 'successfully processed transaction';
@@ -532,7 +536,39 @@
ok $artist->discard_changes
=> 'properly discard changes';
}
-
+
+## Test some edge cases, like trying to do a transaction inside a transaction, etc
+
+{
+ ok my $result = $replicated->schema->txn_do(sub {
+ return $replicated->schema->txn_do(sub {
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'found inside a transaction inside a transaction';
+ return $more;
+ });
+ }) => 'successfully processed transaction';
+
+ is $result->id, 1
+ => 'Got expected single result from transaction';
+}
+
+{
+ ok my $result = $replicated->schema->txn_do(sub {
+ return $replicated->schema->storage->execute_reliably(sub {
+ return $replicated->schema->txn_do(sub {
+ return $replicated->schema->storage->execute_reliably(sub {
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'found inside crazy deep transactions and execute_reliably';
+ return $more;
+ });
+ });
+ });
+ }) => 'successfully processed transaction';
+
+ is $result->id, 1
+ => 'Got expected single result from transaction';
+}
+
## Delete the old database files
$replicated->cleanup;
Modified: DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TreeLike.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TreeLike.pm 2008-06-11 14:41:07 UTC (rev 4490)
+++ DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TreeLike.pm 2008-06-11 15:01:00 UTC (rev 4491)
@@ -22,6 +22,7 @@
sub sqlt_deploy_hook {
my ($self, $sqlt_table) = @_;
- $sqlt_table->add_index(name => 'idx_name', fields => ['name']);
+ ## We don't seem to need this anymore, but keeping it for the moment
+ ## $sqlt_table->add_index(name => 'idx_name', fields => ['name']);
}
1;
More information about the Bast-commits
mailing list