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 DBD::Multi";
   9     plan $@
  10         ? ( skip_all => 'needs DBD::Multi for testing' )
  11         : ( tests => 18 );
  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::Replication::TestReplication;
  21
  22         use DBI;
  23         use DBICTest;
  24         use File::Copy;
  25
  26         ## Create a constructor
  27
  28         sub new {
  29                 my $class = shift @_;
  30                 my %params = @_;
  31
  32                 my $self = bless {
  33                         db_paths => $params{db_paths},
  34                         dsns => $class->init_dsns(%params),
  35                         schema=>$class->init_schema,
  36                 }, $class;
  37
  38                 $self->connect;
  39                 return $self;
  40         }
  41
  42         ## get the DSNs.  We build this up from the list of file paths
  43
  44         sub init_dsns {
  45                 my $class = shift @_;
  46                 my %params = @_;
  47                 my $db_paths = $params{db_paths};
  48
  49                 my @dsn = map {
  50                         "dbi:SQLite:${_}";
  51                 } @$db_paths;
  52
  53                 return \@dsn;
  54         }
  55
  56         ## get the Schema and set the replication storage type
  57
  58         sub init_schema {
  59                 my $class = shift @_;
  60                 my $schema = DBICTest->init_schema();
  61                 $schema->storage_type( '::DBI::Replication' );
  62
  63                 return $schema;
  64         }
  65
  66         ## connect the Schema
  67
  68         sub connect {
  69                 my $self = shift @_;
  70                 my ($master, @slaves) = @{$self->{dsns}};
  71                 my @connections = ([$master, '','', {AutoCommit=>1, PrintError=>0}]);
  72                 my @slavesob;
  73
  74                 foreach my $slave (@slaves)
  75                 {
  76                         my $dbh = shift @{$self->{slaves}}
  77                          || DBI->connect($slave,"","",{PrintError=>0, PrintWarn=>0});
  78
  79                         push @connections,
  80                          [$dbh, '','',{priority=>10}];
  81
  82                         push @slavesob,
  83                          $dbh;
  84                 }
  85
  86                 ## Keep track of the created slave databases
  87                 $self->{slaves} = \@slavesob;
  88
  89                 $self
  90                         ->{schema}
  91                         ->connect([
  92                                 @connections,
  93                                 {limit_dialect => 'LimitXY'}
  94                         ]);
  95         }
  96
  97         ## replication
  98
  99         sub replicate {
 100                 my $self = shift @_;
 101                 my ($master, @slaves) = @{$self->{db_paths}};
 102
 103                 foreach my $slave (@slaves) {
 104                         copy($master, $slave);
 105                 }
 106         }
 107
 108         ## Cleanup afer ourselves.
 109
 110         sub cleanup {
 111                 my $self = shift @_;
 112                 my ($master, @slaves) = @{$self->{db_paths}};
 113
 114                 foreach my $slave (@slaves) {
 115                         unlink $slave;
 116                 }
 117         }
 118
 119         ## Force a reconnection
 120
 121         sub reconnect {
 122                 my $self = shift @_;
 123                 my $schema = $self->connect;
 124                 $self->{schema} = $schema;
 125                 return $schema;
 126         }
 127 }
 128
 129 ## ----------------------------------------------------------------------------
 130 ## Create an object and run some tests
 131 ## ----------------------------------------------------------------------------
 132
 133 my %params = (
 134         db_paths => [
 135                 "t/var/DBIxClass.db",
 136                 "t/var/DBIxClass_slave1.db",
 137                 "t/var/DBIxClass_slave2.db",
 138         ],
 139 );
 140
 141 ok my $replicate = DBIx::Class::DBI::Replication::TestReplication->new(%params)
 142         => 'Created a replication object';
 143
 144 isa_ok $replicate->{schema}
 145         => 'DBIx::Class::Schema';
 146
 147 ## Add some info to the database
 148
 149 $replicate
 150         ->{schema}
 151         ->populate('Artist', [
 152                 [ qw/artistid name/ ],
 153                 [ 4, "Ozric Tentacles"],
 154         ]);
 155
 156 ## Make sure all the slaves have the table definitions
 157
 158 $replicate->replicate;
 159
 160 ## Make sure we can read the data.
 161
 162 ok my $artist1 = $replicate->{schema}->resultset('Artist')->find(4)
 163         => 'Created Result';
 164
 165 isa_ok $artist1
 166         => 'DBICTest::Artist';
 167
 168 is $artist1->name, 'Ozric Tentacles'
 169         => 'Found expected name for first result';
 170
 171 ## Add some new rows that only the master will have  This is because
 172 ## we overload any type of write operation so that is must hit the master
 173 ## database.
 174
 175 use Fcntl qw (:flock);
 176
 177 my $master_path = $replicate->{db_paths}->[0];
 178 open LOCKFILE, ">>$master_path"
 179  or die "Cannot open $master_path";
 180 flock(LOCKFILE, LOCK_EX);
 181
 182 $replicate
 183         ->{schema}
 184         ->populate('Artist', [
 185                 [ qw/artistid name/ ],
 186                 [ 5, "Doom's Children"],
 187                 [ 6, "Dead On Arrival"],
 188                 [ 7, "Watergate"],
 189         ]);
 190
 191 ## Reconnect the database
 192 $replicate->reconnect;
 193
 194 ## Alright, the database 'cluster' is not in a consistent state.  When we do
 195 ## a read now we expect bad news
 196
 197 is $replicate->{schema}->resultset('Artist')->find(5), undef
 198         => 'read after disconnect fails because it uses slave 1 which we have neglected to "replicate" yet';
 199
 200 ## Make sure all the slaves have the table definitions
 201 $replicate->replicate;
 202
 203 ## Should find some data now
 204
 205 ok my $artist2 = $replicate->{schema}->resultset('Artist')->find(5)
 206         => 'Sync succeed';
 207
 208 isa_ok $artist2
 209         => 'DBICTest::Artist';
 210
 211 is $artist2->name, "Doom's Children"
 212         => 'Found expected name for first result';
 213
 214 ## What happens when we delete one of the slaves?
 215
 216 ok my $slave1 = @{$replicate->{slaves}}[0]
 217         => 'Got Slave1';
 218
 219 ok $slave1->disconnect
 220         => 'disconnected slave1';
 221
 222 $replicate->reconnect;
 223
 224 ok my $artist3 = $replicate->{schema}->resultset('Artist')->find(6)
 225         => 'Still finding stuff.';
 226
 227 isa_ok $artist3
 228         => 'DBICTest::Artist';
 229
 230 is $artist3->name, "Dead On Arrival"
 231         => 'Found expected name for first result';
 232
 233 ## Let's delete all the slaves
 234
 235 ok my $slave2 = @{$replicate->{slaves}}[1]
 236         => 'Got Slave2';
 237
 238 ok $slave2->disconnect
 239         => 'Disconnected slave2';
 240
 241 $replicate->reconnect;
 242
 243 ## We expect an error now, since all the slaves are dead
 244
 245 eval {
 246         $replicate->{schema}->resultset('Artist')->find(4)->name;
 247 };
 248
 249 ok $@ => 'Got error when trying to find artistid 4';
 250
 251 ## This should also be an error
 252
 253 eval {
 254         my $artist4 = $replicate->{schema}->resultset('Artist')->find(7);
 255 };
 256
 257 ok $@ => 'Got read errors after everything failed';
 258
 259 ## Delete the old database files
 260 $replicate->cleanup;
 261
 262
 263
 264
 265
 266