t/93storage_replication.t

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