t/93storage_replication.t

   1 use strict;
   2 use warnings;
   3 use lib qw(t/lib);
   4 use Test::More;
   5 use Test::Exception;
   6 use DBICTest;
   7 use List::Util 'first';
   8 use Scalar::Util 'reftype';
   9 use File::Spec;
  10 use IO::Handle;
  11
  12 BEGIN {
  13     eval "use DBIx::Class::Storage::DBI::Replicated; use Test::Moose";
  14     plan $@
  15         ? ( skip_all => "Deps not installed: $@" )
  16         : ( tests => 132 );
  17 }
  18
  19 use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
  20 use_ok 'DBIx::Class::Storage::DBI::Replicated::Balancer';
  21 use_ok 'DBIx::Class::Storage::DBI::Replicated::Replicant';
  22 use_ok 'DBIx::Class::Storage::DBI::Replicated';
  23
  24 use Moose();
  25 use MooseX::Types();
  26 diag "Using Moose version $Moose::VERSION and MooseX::Types version $MooseX::Types::VERSION";
  27
  28 =head1 HOW TO USE
  29
  30     This is a test of the replicated storage system.  This will work in one of
  31     two ways, either it was try to fake replication with a couple of SQLite DBs
  32     and creative use of copy, or if you define a couple of %ENV vars correctly
  33     will try to test those.  If you do that, it will assume the setup is properly
  34     replicating.  Your results may vary, but I have demonstrated this to work with
  35     mysql native replication.
  36
  37 =cut
  38
  39
  40 ## ----------------------------------------------------------------------------
  41 ## Build a class to hold all our required testing data and methods.
  42 ## ----------------------------------------------------------------------------
  43
  44 TESTSCHEMACLASSES: {
  45
  46     ## --------------------------------------------------------------------- ##
  47     ## Create an object to contain your replicated stuff.
  48     ## --------------------------------------------------------------------- ##
  49
  50     package DBIx::Class::DBI::Replicated::TestReplication;
  51
  52     use DBICTest;
  53     use base qw/Class::Accessor::Fast/;
  54
  55     __PACKAGE__->mk_accessors( qw/schema/ );
  56
  57     ## Initialize the object
  58
  59     sub new {
  60         my ($class, $schema_method) = (shift, shift);
  61         my $self = $class->SUPER::new(@_);
  62
  63         $self->schema( $self->init_schema($schema_method) );
  64         return $self;
  65     }
  66
  67     ## Get the Schema and set the replication storage type
  68
  69     sub init_schema {
  70         # current SQLT SQLite producer does not handle DROP TABLE IF EXISTS, trap warnings here
  71         local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /no such table.+DROP TABLE/ };
  72
  73         my ($class, $schema_method) = @_;
  74
  75         my $method = "get_schema_$schema_method";
  76         my $schema = $class->$method;
  77
  78         return $schema;
  79     }
  80
  81     sub get_schema_by_storage_type {
  82       DBICTest->init_schema(
  83         sqlite_use_file => 1,
  84         storage_type=>{
  85           '::DBI::Replicated' => {
  86             balancer_type=>'::Random',
  87             balancer_args=>{
  88               auto_validate_every=>100,
  89           master_read_weight => 1
  90             },
  91           }
  92         },
  93         deploy_args=>{
  94           add_drop_table => 1,
  95         },
  96       );
  97     }
  98
  99     sub get_schema_by_connect_info {
 100       DBICTest->init_schema(
 101         sqlite_use_file => 1,
 102         storage_type=> '::DBI::Replicated',
 103         balancer_type=>'::Random',
 104         balancer_args=> {
 105           auto_validate_every=>100,
 106       master_read_weight => 1
 107         },
 108         deploy_args=>{
 109           add_drop_table => 1,
 110         },
 111       );
 112     }
 113
 114     sub generate_replicant_connect_info {}
 115     sub replicate {}
 116     sub cleanup {}
 117
 118     ## --------------------------------------------------------------------- ##
 119     ## Add a connect_info option to test option merging.
 120     ## --------------------------------------------------------------------- ##
 121     {
 122     package DBIx::Class::Storage::DBI::Replicated;
 123
 124     use Moose;
 125
 126     __PACKAGE__->meta->make_mutable;
 127
 128     around connect_info => sub {
 129       my ($next, $self, $info) = @_;
 130       $info->[3]{master_option} = 1;
 131       $self->$next($info);
 132     };
 133
 134     __PACKAGE__->meta->make_immutable;
 135
 136     no Moose;
 137     }
 138
 139     ## --------------------------------------------------------------------- ##
 140     ## Subclass for when you are using SQLite for testing, this provides a fake
 141     ## replication support.
 142     ## --------------------------------------------------------------------- ##
 143
 144     package DBIx::Class::DBI::Replicated::TestReplication::SQLite;
 145
 146     use DBICTest;
 147     use File::Copy;
 148     use base 'DBIx::Class::DBI::Replicated::TestReplication';
 149
 150     __PACKAGE__->mk_accessors(qw/master_path slave_paths/);
 151
 152     ## Set the master path from DBICTest
 153
 154     sub new {
 155         my $class = shift @_;
 156         my $self = $class->SUPER::new(@_);
 157
 158         $self->master_path( DBICTest->_sqlite_dbfilename );
 159         $self->slave_paths([
 160             File::Spec->catfile(qw/t var DBIxClass_slave1.db/),
 161             File::Spec->catfile(qw/t var DBIxClass_slave2.db/),
 162         ]);
 163
 164         return $self;
 165     }
 166
 167     ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
 168     ## $storage->connect_info to be used for connecting replicants.
 169
 170     sub generate_replicant_connect_info {
 171         my $self = shift @_;
 172         my @dsn = map {
 173             "dbi:SQLite:${_}";
 174         } @{$self->slave_paths};
 175
 176         my @connect_infos = map { [$_,'','',{AutoCommit=>1}] } @dsn;
 177
 178         ## Make sure nothing is left over from a failed test
 179         $self->cleanup;
 180
 181         ## try a hashref too
 182         my $c = $connect_infos[0];
 183         $connect_infos[0] = {
 184           dsn => $c->[0],
 185           user => $c->[1],
 186           password => $c->[2],
 187           %{ $c->[3] }
 188         };
 189
 190         @connect_infos
 191     }
 192
 193     ## Do a 'good enough' replication by copying the master dbfile over each of
 194     ## the slave dbfiles.  If the master is SQLite we do this, otherwise we
 195     ## just do a one second pause to let the slaves catch up.
 196
 197     sub replicate {
 198         my $self = shift @_;
 199         foreach my $slave (@{$self->slave_paths}) {
 200             copy($self->master_path, $slave);
 201         }
 202     }
 203
 204     ## Cleanup after ourselves.  Unlink all gthe slave paths.
 205
 206     sub cleanup {
 207         my $self = shift @_;
 208         foreach my $slave (@{$self->slave_paths}) {
 209             if(-e $slave) {
 210                 unlink $slave;
 211             }
 212         }
 213     }
 214
 215     ## --------------------------------------------------------------------- ##
 216     ## Subclass for when you are setting the databases via custom export vars
 217     ## This is for when you have a replicating database setup that you are
 218     ## going to test against.  You'll need to define the correct $ENV and have
 219     ## two slave databases to test against, as well as a replication system
 220     ## that will replicate in less than 1 second.
 221     ## --------------------------------------------------------------------- ##
 222
 223     package DBIx::Class::DBI::Replicated::TestReplication::Custom;
 224     use base 'DBIx::Class::DBI::Replicated::TestReplication';
 225
 226     ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
 227     ## $storage->connect_info to be used for connecting replicants.
 228
 229     sub generate_replicant_connect_info {
 230         return (
 231             [$ENV{"DBICTEST_SLAVE0_DSN"}, $ENV{"DBICTEST_SLAVE0_DBUSER"}, $ENV{"DBICTEST_SLAVE0_DBPASS"}, {AutoCommit => 1}],
 232             [$ENV{"DBICTEST_SLAVE1_DSN"}, $ENV{"DBICTEST_SLAVE1_DBUSER"}, $ENV{"DBICTEST_SLAVE1_DBPASS"}, {AutoCommit => 1}],
 233         );
 234     }
 235
 236     ## pause a bit to let the replication catch up
 237
 238     sub replicate {
 239         sleep 1;
 240     }
 241 }
 242
 243 ## ----------------------------------------------------------------------------
 244 ## Create an object and run some tests
 245 ## ----------------------------------------------------------------------------
 246
 247 ## Thi first bunch of tests are basic, just make sure all the bits are behaving
 248
 249 my $replicated_class = DBICTest->has_custom_dsn ?
 250     'DBIx::Class::DBI::Replicated::TestReplication::Custom' :
 251     'DBIx::Class::DBI::Replicated::TestReplication::SQLite';
 252
 253 my $replicated;
 254
 255 for my $method (qw/by_connect_info by_storage_type/) {
 256   undef $replicated;
 257   ok $replicated = $replicated_class->new($method)
 258       => "Created a replication object $method";
 259
 260   isa_ok $replicated->schema
 261       => 'DBIx::Class::Schema';
 262
 263   isa_ok $replicated->schema->storage
 264       => 'DBIx::Class::Storage::DBI::Replicated';
 265
 266   isa_ok $replicated->schema->storage->balancer
 267       => 'DBIx::Class::Storage::DBI::Replicated::Balancer::Random'
 268       => 'configured balancer_type';
 269 }
 270
 271 ok $replicated->schema->storage->meta
 272     => 'has a meta object';
 273
 274 isa_ok $replicated->schema->storage->master
 275     => 'DBIx::Class::Storage::DBI';
 276
 277 isa_ok $replicated->schema->storage->pool
 278     => 'DBIx::Class::Storage::DBI::Replicated::Pool';
 279
 280 does_ok $replicated->schema->storage->balancer
 281     => 'DBIx::Class::Storage::DBI::Replicated::Balancer';
 282
 283 ok my @replicant_connects = $replicated->generate_replicant_connect_info
 284     => 'got replication connect information';
 285
 286 ok my @replicated_storages = $replicated->schema->storage->connect_replicants(@replicant_connects)
 287     => 'Created some storages suitable for replicants';
 288
 289 our %debug;
 290 $replicated->schema->storage->debug(1);
 291 $replicated->schema->storage->debugcb(sub {
 292     my ($op, $info) = @_;
 293     ##warn "\n$op, $info\n";
 294     %debug = (
 295         op => $op,
 296         info => $info,
 297         dsn => ($info=~m/\[(.+)\]/)[0],
 298         storage_type => $info=~m/REPLICANT/ ? 'REPLICANT' : 'MASTER',
 299     );
 300 });
 301
 302 ok my @all_storages = $replicated->schema->storage->all_storages
 303     => '->all_storages';
 304
 305 is scalar @all_storages,
 306     3
 307     => 'correct number of ->all_storages';
 308
 309 is ((grep $_->isa('DBIx::Class::Storage::DBI'), @all_storages),
 310     3
 311     => '->all_storages are correct type');
 312
 313 my @all_storage_opts =
 314   grep { (reftype($_)||'') eq 'HASH' }
 315     map @{ $_->_connect_info }, @all_storages;
 316
 317 is ((grep $_->{master_option}, @all_storage_opts),
 318     3
 319     => 'connect_info was merged from master to replicants');
 320
 321 my @replicant_names = keys %{ $replicated->schema->storage->replicants };
 322
 323 ok @replicant_names, "found replicant names @replicant_names";
 324
 325 ## Silence warning about not supporting the is_replicating method if using the
 326 ## sqlite dbs.
 327 $replicated->schema->storage->debugobj->silence(1)
 328   if first { m{^t/} } @replicant_names;
 329
 330 isa_ok $replicated->schema->storage->balancer->current_replicant
 331     => 'DBIx::Class::Storage::DBI';
 332
 333 $replicated->schema->storage->debugobj->silence(0);
 334
 335 ok $replicated->schema->storage->pool->has_replicants
 336     => 'does have replicants';
 337
 338 is $replicated->schema->storage->pool->num_replicants => 2
 339     => 'has two replicants';
 340
 341 does_ok $replicated_storages[0]
 342     => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
 343
 344 does_ok $replicated_storages[1]
 345     => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
 346
 347 does_ok $replicated->schema->storage->replicants->{$replicant_names[0]}
 348     => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
 349
 350 does_ok $replicated->schema->storage->replicants->{$replicant_names[1]}
 351     => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
 352
 353 ## Add some info to the database
 354
 355 $replicated
 356     ->schema
 357     ->populate('Artist', [
 358         [ qw/artistid name/ ],
 359         [ 4, "Ozric Tentacles"],
 360     ]);
 361
 362     is $debug{storage_type}, 'MASTER',
 363         "got last query from a master: $debug{dsn}";
 364
 365     like $debug{info}, qr/INSERT/, 'Last was an insert';
 366
 367 ## Make sure all the slaves have the table definitions
 368
 369 $replicated->replicate;
 370 $replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
 371 $replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
 372
 373 ## Silence warning about not supporting the is_replicating method if using the
 374 ## sqlite dbs.
 375 $replicated->schema->storage->debugobj->silence(1)
 376   if first { m{^t/} } @replicant_names;
 377
 378 $replicated->schema->storage->pool->validate_replicants;
 379
 380 $replicated->schema->storage->debugobj->silence(0);
 381
 382 ## Make sure we can read the data.
 383
 384 ok my $artist1 = $replicated->schema->resultset('Artist')->find(4)
 385     => 'Created Result';
 386
 387 ## We removed testing here since master read weight is on, so we can't tell in
 388 ## advance what storage to expect.  We turn master read weight off a bit lower
 389 ## is $debug{storage_type}, 'REPLICANT'
 390 ##     => "got last query from a replicant: $debug{dsn}, $debug{info}";
 391
 392 isa_ok $artist1
 393     => 'DBICTest::Artist';
 394
 395 is $artist1->name, 'Ozric Tentacles'
 396     => 'Found expected name for first result';
 397
 398 ## Check that master_read_weight is honored
 399 {
 400     no warnings qw/once redefine/;
 401
 402     local
 403     *DBIx::Class::Storage::DBI::Replicated::Balancer::Random::_random_number =
 404     sub { 999 };
 405
 406     $replicated->schema->storage->balancer->increment_storage;
 407
 408     is $replicated->schema->storage->balancer->current_replicant,
 409        $replicated->schema->storage->master
 410        => 'master_read_weight is honored';
 411
 412     ## turn it off for the duration of the test
 413     $replicated->schema->storage->balancer->master_read_weight(0);
 414     $replicated->schema->storage->balancer->increment_storage;
 415 }
 416
 417 ## Add some new rows that only the master will have  This is because
 418 ## we overload any type of write operation so that is must hit the master
 419 ## database.
 420
 421 $replicated
 422     ->schema
 423     ->populate('Artist', [
 424         [ qw/artistid name/ ],
 425         [ 5, "Doom's Children"],
 426         [ 6, "Dead On Arrival"],
 427         [ 7, "Watergate"],
 428     ]);
 429
 430     is $debug{storage_type}, 'MASTER',
 431         "got last query from a master: $debug{dsn}";
 432
 433     like $debug{info}, qr/INSERT/, 'Last was an insert';
 434
 435 ## Make sure all the slaves have the table definitions
 436 $replicated->replicate;
 437
 438 ## Should find some data now
 439
 440 ok my $artist2 = $replicated->schema->resultset('Artist')->find(5)
 441     => 'Sync succeed';
 442
 443 is $debug{storage_type}, 'REPLICANT'
 444     => "got last query from a replicant: $debug{dsn}";
 445
 446 isa_ok $artist2
 447     => 'DBICTest::Artist';
 448
 449 is $artist2->name, "Doom's Children"
 450     => 'Found expected name for first result';
 451
 452 ## What happens when we disconnect all the replicants?
 453
 454 is $replicated->schema->storage->pool->connected_replicants => 2
 455     => "both replicants are connected";
 456
 457 $replicated->schema->storage->replicants->{$replicant_names[0]}->disconnect;
 458 $replicated->schema->storage->replicants->{$replicant_names[1]}->disconnect;
 459
 460 is $replicated->schema->storage->pool->connected_replicants => 0
 461     => "both replicants are now disconnected";
 462
 463 ## All these should pass, since the database should automatically reconnect
 464
 465 ok my $artist3 = $replicated->schema->resultset('Artist')->find(6)
 466     => 'Still finding stuff.';
 467
 468 is $debug{storage_type}, 'REPLICANT'
 469     => "got last query from a replicant: $debug{dsn}";
 470
 471 isa_ok $artist3
 472     => 'DBICTest::Artist';
 473
 474 is $artist3->name, "Dead On Arrival"
 475     => 'Found expected name for first result';
 476
 477 is $replicated->schema->storage->pool->connected_replicants => 1
 478     => "At Least One replicant reconnected to handle the job";
 479
 480 ## What happens when we try to select something that doesn't exist?
 481
 482 ok ! $replicated->schema->resultset('Artist')->find(666)
 483     => 'Correctly failed to find something.';
 484
 485 is $debug{storage_type}, 'REPLICANT'
 486     => "got last query from a replicant: $debug{dsn}";
 487
 488 ## test the reliable option
 489
 490 TESTRELIABLE: {
 491
 492     $replicated->schema->storage->set_reliable_storage;
 493
 494     ok $replicated->schema->resultset('Artist')->find(2)
 495         => 'Read from master 1';
 496
 497     is $debug{storage_type}, 'MASTER',
 498         "got last query from a master: $debug{dsn}";
 499
 500     ok $replicated->schema->resultset('Artist')->find(5)
 501         => 'Read from master 2';
 502
 503     is $debug{storage_type}, 'MASTER',
 504         "got last query from a master: $debug{dsn}";
 505
 506     $replicated->schema->storage->set_balanced_storage;
 507
 508     ok $replicated->schema->resultset('Artist')->find(3)
 509         => 'Read from replicant';
 510
 511     is $debug{storage_type}, 'REPLICANT',
 512         "got last query from a replicant: $debug{dsn}";
 513 }
 514
 515 ## Make sure when reliable goes out of scope, we are using replicants again
 516
 517 ok $replicated->schema->resultset('Artist')->find(1)
 518     => 'back to replicant 1.';
 519
 520     is $debug{storage_type}, 'REPLICANT',
 521         "got last query from a replicant: $debug{dsn}";
 522
 523 ok $replicated->schema->resultset('Artist')->find(2)
 524     => 'back to replicant 2.';
 525
 526     is $debug{storage_type}, 'REPLICANT',
 527         "got last query from a replicant: $debug{dsn}";
 528
 529 ## set all the replicants to inactive, and make sure the balancer falls back to
 530 ## the master.
 531
 532 $replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
 533 $replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
 534
 535 {
 536     ## catch the fallback to master warning
 537     open my $debugfh, '>', \my $fallback_warning;
 538     my $oldfh = $replicated->schema->storage->debugfh;
 539     $replicated->schema->storage->debugfh($debugfh);
 540
 541     ok $replicated->schema->resultset('Artist')->find(2)
 542         => 'Fallback to master';
 543
 544     is $debug{storage_type}, 'MASTER',
 545         "got last query from a master: $debug{dsn}";
 546
 547     like $fallback_warning, qr/falling back to master/
 548         => 'emits falling back to master warning';
 549
 550     $replicated->schema->storage->debugfh($oldfh);
 551 }
 552
 553 $replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
 554 $replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
 555
 556 ## Silence warning about not supporting the is_replicating method if using the
 557 ## sqlite dbs.
 558 $replicated->schema->storage->debugobj->silence(1)
 559   if first { m{^t/} } @replicant_names;
 560
 561 $replicated->schema->storage->pool->validate_replicants;
 562
 563 $replicated->schema->storage->debugobj->silence(0);
 564
 565 ok $replicated->schema->resultset('Artist')->find(2)
 566     => 'Returned to replicates';
 567
 568 is $debug{storage_type}, 'REPLICANT',
 569     "got last query from a replicant: $debug{dsn}";
 570
 571 ## Getting slave status tests
 572
 573 SKIP: {
 574     ## We skip this tests unless you have a custom replicants, since the default
 575     ## sqlite based replication tests don't support these functions.
 576
 577     skip 'Cannot Test Replicant Status on Non Replicating Database', 10
 578      unless DBICTest->has_custom_dsn && $ENV{"DBICTEST_SLAVE0_DSN"};
 579
 580     $replicated->replicate; ## Give the slaves a chance to catchup.
 581
 582     ok $replicated->schema->storage->replicants->{$replicant_names[0]}->is_replicating
 583         => 'Replicants are replicating';
 584
 585     is $replicated->schema->storage->replicants->{$replicant_names[0]}->lag_behind_master, 0
 586         => 'Replicant is zero seconds behind master';
 587
 588     ## Test the validate replicants
 589
 590     $replicated->schema->storage->pool->validate_replicants;
 591
 592     is $replicated->schema->storage->pool->active_replicants, 2
 593         => 'Still have 2 replicants after validation';
 594
 595     ## Force the replicants to fail the validate test by required their lag to
 596     ## be negative (ie ahead of the master!)
 597
 598     $replicated->schema->storage->pool->maximum_lag(-10);
 599     $replicated->schema->storage->pool->validate_replicants;
 600
 601     is $replicated->schema->storage->pool->active_replicants, 0
 602         => 'No way a replicant be be ahead of the master';
 603
 604     ## Let's be fair to the replicants again.  Let them lag up to 5
 605
 606     $replicated->schema->storage->pool->maximum_lag(5);
 607     $replicated->schema->storage->pool->validate_replicants;
 608
 609     is $replicated->schema->storage->pool->active_replicants, 2
 610         => 'Both replicants in good standing again';
 611
 612     ## Check auto validate
 613
 614     is $replicated->schema->storage->balancer->auto_validate_every, 100
 615         => "Got the expected value for auto validate";
 616
 617         ## This will make sure we auto validatge everytime
 618         $replicated->schema->storage->balancer->auto_validate_every(0);
 619
 620         ## set all the replicants to inactive, and make sure the balancer falls back to
 621         ## the master.
 622
 623         $replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
 624         $replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
 625
 626         ## Ok, now when we go to run a query, autovalidate SHOULD reconnect
 627
 628     is $replicated->schema->storage->pool->active_replicants => 0
 629         => "both replicants turned off";
 630
 631     ok $replicated->schema->resultset('Artist')->find(5)
 632         => 'replicant reactivated';
 633
 634     is $debug{storage_type}, 'REPLICANT',
 635         "got last query from a replicant: $debug{dsn}";
 636
 637     is $replicated->schema->storage->pool->active_replicants => 2
 638         => "both replicants reactivated";
 639 }
 640
 641 ## Test the reliably callback
 642
 643 ok my $reliably = sub {
 644
 645     ok $replicated->schema->resultset('Artist')->find(5)
 646         => 'replicant reactivated';
 647
 648     is $debug{storage_type}, 'MASTER',
 649         "got last query from a master: $debug{dsn}";
 650
 651 } => 'created coderef properly';
 652
 653 $replicated->schema->storage->execute_reliably($reliably);
 654
 655 ## Try something with an error
 656
 657 ok my $unreliably = sub {
 658
 659     ok $replicated->schema->resultset('ArtistXX')->find(5)
 660         => 'replicant reactivated';
 661
 662 } => 'created coderef properly';
 663
 664 throws_ok {$replicated->schema->storage->execute_reliably($unreliably)}
 665     qr/Can't find source for ArtistXX/
 666     => 'Bad coderef throws proper error';
 667
 668 ## Make sure replication came back
 669
 670 ok $replicated->schema->resultset('Artist')->find(3)
 671     => 'replicant reactivated';
 672
 673 is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
 674
 675 ## make sure transactions are set to execute_reliably
 676
 677 ok my $transaction = sub {
 678
 679     my $id = shift @_;
 680
 681     $replicated
 682         ->schema
 683         ->populate('Artist', [
 684             [ qw/artistid name/ ],
 685             [ $id, "Children of the Grave"],
 686         ]);
 687
 688     ok my $result = $replicated->schema->resultset('Artist')->find($id)
 689         => "Found expected artist for $id";
 690
 691     is $debug{storage_type}, 'MASTER',
 692         "got last query from a master: $debug{dsn}";
 693
 694     ok my $more = $replicated->schema->resultset('Artist')->find(1)
 695         => 'Found expected artist again for 1';
 696
 697     is $debug{storage_type}, 'MASTER',
 698         "got last query from a master: $debug{dsn}";
 699
 700    return ($result, $more);
 701
 702 } => 'Created a coderef properly';
 703
 704 ## Test the transaction with multi return
 705 {
 706     ok my @return = $replicated->schema->txn_do($transaction, 666)
 707         => 'did transaction';
 708
 709         is $return[0]->id, 666
 710             => 'first returned value is correct';
 711
 712         is $debug{storage_type}, 'MASTER',
 713             "got last query from a master: $debug{dsn}";
 714
 715         is $return[1]->id, 1
 716             => 'second returned value is correct';
 717
 718         is $debug{storage_type}, 'MASTER',
 719              "got last query from a master: $debug{dsn}";
 720
 721 }
 722
 723 ## Test that asking for single return works
 724 {
 725     ok my @return = $replicated->schema->txn_do($transaction, 777)
 726         => 'did transaction';
 727
 728         is $return[0]->id, 777
 729             => 'first returned value is correct';
 730
 731         is $return[1]->id, 1
 732             => 'second returned value is correct';
 733 }
 734
 735 ## Test transaction returning a single value
 736
 737 {
 738     ok my $result = $replicated->schema->txn_do(sub {
 739         ok my $more = $replicated->schema->resultset('Artist')->find(1)
 740         => 'found inside a transaction';
 741         is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
 742         return $more;
 743     }) => 'successfully processed transaction';
 744
 745     is $result->id, 1
 746        => 'Got expected single result from transaction';
 747 }
 748
 749 ## Make sure replication came back
 750
 751 ok $replicated->schema->resultset('Artist')->find(1)
 752     => 'replicant reactivated';
 753
 754 is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
 755
 756 ## Test Discard changes
 757
 758 {
 759     ok my $artist = $replicated->schema->resultset('Artist')->find(2)
 760         => 'got an artist to test discard changes';
 761
 762     is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
 763
 764     ok $artist->get_from_storage({force_pool=>'master'})
 765        => 'properly discard changes';
 766
 767     is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
 768
 769     ok $artist->discard_changes({force_pool=>'master'})
 770        => 'properly called discard_changes against master (manual attrs)';
 771
 772     is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
 773
 774     ok $artist->discard_changes()
 775        => 'properly called discard_changes against master (default attrs)';
 776
 777     is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
 778
 779     ok $artist->discard_changes({force_pool=>$replicant_names[0]})
 780        => 'properly able to override the default attributes';
 781
 782     is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}"
 783 }
 784
 785 ## Test some edge cases, like trying to do a transaction inside a transaction, etc
 786
 787 {
 788     ok my $result = $replicated->schema->txn_do(sub {
 789         return $replicated->schema->txn_do(sub {
 790             ok my $more = $replicated->schema->resultset('Artist')->find(1)
 791             => 'found inside a transaction inside a transaction';
 792             is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
 793             return $more;
 794         });
 795     }) => 'successfully processed transaction';
 796
 797     is $result->id, 1
 798        => 'Got expected single result from transaction';
 799 }
 800
 801 {
 802     ok my $result = $replicated->schema->txn_do(sub {
 803         return $replicated->schema->storage->execute_reliably(sub {
 804             return $replicated->schema->txn_do(sub {
 805                 return $replicated->schema->storage->execute_reliably(sub {
 806                     ok my $more = $replicated->schema->resultset('Artist')->find(1)
 807                       => 'found inside crazy deep transactions and execute_reliably';
 808                     is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
 809                     return $more;
 810                 });
 811             });
 812         });
 813     }) => 'successfully processed transaction';
 814
 815     is $result->id, 1
 816        => 'Got expected single result from transaction';
 817 }
 818
 819 ## Test the force_pool resultset attribute.
 820
 821 {
 822     ok my $artist_rs = $replicated->schema->resultset('Artist')
 823         => 'got artist resultset';
 824
 825     ## Turn on Forced Pool Storage
 826     ok my $reliable_artist_rs = $artist_rs->search(undef, {force_pool=>'master'})
 827         => 'Created a resultset using force_pool storage';
 828
 829     ok my $artist = $reliable_artist_rs->find(2)
 830         => 'got an artist result via force_pool storage';
 831
 832     is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
 833 }
 834
 835 ## Test the force_pool resultset attribute part two.
 836
 837 {
 838     ok my $artist_rs = $replicated->schema->resultset('Artist')
 839         => 'got artist resultset';
 840
 841     ## Turn on Forced Pool Storage
 842     ok my $reliable_artist_rs = $artist_rs->search(undef, {force_pool=>$replicant_names[0]})
 843         => 'Created a resultset using force_pool storage';
 844
 845     ok my $artist = $reliable_artist_rs->find(2)
 846         => 'got an artist result via force_pool storage';
 847
 848     is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
 849 }
 850 ## Delete the old database files
 851 $replicated->cleanup;
 852
 853 # vim: sw=4 sts=4 :