t/93storage_replication.t

   1 use strict;
   2 use warnings;
   3 use lib qw(t/lib);
   4 use Test::More;
   5 use Data::Dump qw/dump/;
   6
   7 BEGIN {
   8     eval "use Moose";
   9     plan $@
  10         ? ( skip_all => 'needs Moose for testing' )
  11         : ( tests => 2 );
  12 }
  13
  14 ## ----------------------------------------------------------------------------
  15 ## Build a class to hold all our required testing data and methods.
  16 ## ----------------------------------------------------------------------------
  17
  18 TESTSCHEMACLASS: {
  19
  20     package DBIx::Class::DBI::Replicated::TestReplication;
  21
  22     use DBICTest;
  23     use base qw/Class::Accessor::Fast/;
  24
  25     __PACKAGE__->mk_accessors( qw/schema/ );
  26
  27     ## Initialize the object
  28
  29         sub new {
  30             my $proto = shift;
  31             my $class = ref( $proto ) || $proto;
  32             my $self = {};
  33
  34             bless( $self, $class );
  35
  36             $self->schema( $self->init_schema );
  37
  38             return $self;
  39         }
  40
  41     ## get the Schema and set the replication storage type
  42
  43     sub init_schema {
  44         my $class = shift @_;
  45         my $schema = DBICTest->init_schema(storage_type=>'::DBI::Replicated');
  46         return $schema;
  47     }
  48 }
  49
  50 ## ----------------------------------------------------------------------------
  51 ## Create an object and run some tests
  52 ## ----------------------------------------------------------------------------
  53
  54 my %params = (
  55     db_paths => [
  56         "t/var/DBIxClass.db",
  57         "t/var/DBIxClass_slave1.db",
  58         "t/var/DBIxClass_slave2.db",
  59     ],
  60 );
  61
  62 ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new()
  63     => 'Created a replication object';
  64
  65 isa_ok $replicate->schema
  66     => 'DBIx::Class::Schema';
  67
  68
  69     warn dump $replicate->schema->storage->meta;
  70
  71     warn dump $replicate->schema->storage->master;
  72
  73
  74 __END__
  75
  76 ## ----------------------------------------------------------------------------
  77 ## Build a class to hold all our required testing data and methods.
  78 ## ----------------------------------------------------------------------------
  79
  80 TESTSCHEMACLASS: {
  81
  82         package DBIx::Class::DBI::Replicated::TestReplication;
  83
  84         use DBI;
  85         use DBICTest;
  86         use File::Copy;
  87
  88         ## Create a constructor
  89
  90         sub new {
  91                 my $class = shift @_;
  92                 my %params = @_;
  93
  94                 my $self = bless {
  95                         db_paths => $params{db_paths},
  96                         dsns => $class->init_dsns(%params),
  97                         schema=>$class->init_schema,
  98                 }, $class;
  99
 100                 $self->connect;
 101                 return $self;
 102         }
 103
 104         ## get the DSNs.  We build this up from the list of file paths
 105
 106         sub init_dsns {
 107                 my $class = shift @_;
 108                 my %params = @_;
 109                 my $db_paths = $params{db_paths};
 110
 111                 my @dsn = map {
 112                         "dbi:SQLite:${_}";
 113                 } @$db_paths;
 114
 115                 return \@dsn;
 116         }
 117
 118         ## get the Schema and set the replication storage type
 119
 120         sub init_schema {
 121                 my $class = shift @_;
 122                 my $schema = DBICTest->init_schema();
 123                 $schema->storage_type( '::DBI::Replicated' );
 124
 125                 return $schema;
 126         }
 127
 128         ## connect the Schema
 129
 130         sub connect {
 131                 my $self = shift @_;
 132                 my ($master, @slaves) = @{$self->{dsns}};
 133                 my $master_connect_info = [$master, '','', {AutoCommit=>1, PrintError=>0}];
 134
 135                 my @slavesob;
 136                 foreach my $slave (@slaves)
 137                 {
 138                         my $dbh = shift @{$self->{slaves}}
 139                          || DBI->connect($slave,"","",{PrintError=>0, PrintWarn=>0});
 140
 141                         push @{$master_connect_info->[-1]->{slaves_connect_info}},
 142                          [$dbh, '','',{priority=>10}];
 143
 144                         push @slavesob,
 145                          $dbh;
 146                 }
 147
 148                 ## Keep track of the created slave databases
 149                 $self->{slaves} = \@slavesob;
 150
 151                 $self
 152                         ->{schema}
 153                         ->connect(@$master_connect_info);
 154         }
 155
 156         ## replication
 157
 158         sub replicate {
 159                 my $self = shift @_;
 160                 my ($master, @slaves) = @{$self->{db_paths}};
 161
 162                 foreach my $slave (@slaves) {
 163                         copy($master, $slave);
 164                 }
 165         }
 166
 167         ## Cleanup afer ourselves.
 168
 169         sub cleanup {
 170                 my $self = shift @_;
 171                 my ($master, @slaves) = @{$self->{db_paths}};
 172
 173                 foreach my $slave (@slaves) {
 174                         unlink $slave;
 175                 }
 176         }
 177
 178         ## Force a reconnection
 179
 180         sub reconnect {
 181                 my $self = shift @_;
 182                 my $schema = $self->connect;
 183                 $self->{schema} = $schema;
 184                 return $schema;
 185         }
 186 }
 187
 188 ## ----------------------------------------------------------------------------
 189 ## Create an object and run some tests
 190 ## ----------------------------------------------------------------------------
 191
 192 my %params = (
 193         db_paths => [
 194                 "t/var/DBIxClass.db",
 195                 "t/var/DBIxClass_slave1.db",
 196                 "t/var/DBIxClass_slave2.db",
 197         ],
 198 );
 199
 200 ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new(%params)
 201         => 'Created a replication object';
 202
 203 isa_ok $replicate->{schema}
 204         => 'DBIx::Class::Schema';
 205
 206 ## Add some info to the database
 207
 208 $replicate
 209         ->{schema}
 210         ->populate('Artist', [
 211                 [ qw/artistid name/ ],
 212                 [ 4, "Ozric Tentacles"],
 213         ]);
 214
 215 ## Make sure all the slaves have the table definitions
 216
 217 $replicate->replicate;
 218
 219 ## Make sure we can read the data.
 220
 221 ok my $artist1 = $replicate->{schema}->resultset('Artist')->find(4)
 222         => 'Created Result';
 223
 224 isa_ok $artist1
 225         => 'DBICTest::Artist';
 226
 227 is $artist1->name, 'Ozric Tentacles'
 228         => 'Found expected name for first result';
 229
 230 ## Add some new rows that only the master will have  This is because
 231 ## we overload any type of write operation so that is must hit the master
 232 ## database.
 233
 234 $replicate
 235         ->{schema}
 236         ->populate('Artist', [
 237                 [ qw/artistid name/ ],
 238                 [ 5, "Doom's Children"],
 239                 [ 6, "Dead On Arrival"],
 240                 [ 7, "Watergate"],
 241         ]);
 242
 243 ## Reconnect the database
 244 $replicate->reconnect;
 245
 246 ## Alright, the database 'cluster' is not in a consistent state.  When we do
 247 ## a read now we expect bad news
 248
 249 is $replicate->{schema}->resultset('Artist')->find(5), undef
 250         => 'read after disconnect fails because it uses slave 1 which we have neglected to "replicate" yet';
 251
 252 ## Make sure all the slaves have the table definitions
 253 $replicate->replicate;
 254
 255 ## Should find some data now
 256
 257 ok my $artist2 = $replicate->{schema}->resultset('Artist')->find(5)
 258         => 'Sync succeed';
 259
 260 isa_ok $artist2
 261         => 'DBICTest::Artist';
 262
 263 is $artist2->name, "Doom's Children"
 264         => 'Found expected name for first result';
 265
 266 ## What happens when we delete one of the slaves?
 267
 268 ok my $slave1 = @{$replicate->{slaves}}[0]
 269         => 'Got Slave1';
 270
 271 ok $slave1->disconnect
 272         => 'disconnected slave1';
 273
 274 $replicate->reconnect;
 275
 276 ok my $artist3 = $replicate->{schema}->resultset('Artist')->find(6)
 277         => 'Still finding stuff.';
 278
 279 isa_ok $artist3
 280         => 'DBICTest::Artist';
 281
 282 is $artist3->name, "Dead On Arrival"
 283         => 'Found expected name for first result';
 284
 285 ## Let's delete all the slaves
 286
 287 ok my $slave2 = @{$replicate->{slaves}}[1]
 288         => 'Got Slave2';
 289
 290 ok $slave2->disconnect
 291         => 'Disconnected slave2';
 292
 293 $replicate->reconnect;
 294
 295 ## We expect an error now, since all the slaves are dead
 296
 297 eval {
 298         $replicate->{schema}->resultset('Artist')->find(4)->name;
 299 };
 300
 301 ok $@ => 'Got error when trying to find artistid 4';
 302
 303 ## This should also be an error
 304
 305 eval {
 306         my $artist4 = $replicate->{schema}->resultset('Artist')->find(7);
 307 };
 308
 309 ok $@ => 'Got read errors after everything failed';
 310
 311 ## make sure ->connect_info returns something sane
 312
 313 ok $replicate->{schema}->storage->connect_info
 314     => 'got something out of ->connect_info';
 315
 316 ## Force a connection to the write source for testing.
 317
 318 $replicate->{schema}->storage($replicate->{schema}->storage->write_source);
 319
 320 ## What happens when we do a find for something that doesn't exist?
 321
 322 ok ! $replicate->{schema}->resultset('Artist')->find(666)
 323     => 'Correctly did not find a bad artist id';
 324
 325 ## Delete the old database files
 326 $replicate->cleanup;
 327
 328
 329
 330
 331
 332