fixed up the replication test, added some tests for the dbd::multi problem of null...
John Napiorkowski [Fri, 25 Apr 2008 22:33:29 +0000 (22:33 +0000)]
lib/DBIx/Class/Storage/DBI/Replicated.pm
t/93storage_replication.t

index 6ec74e9..d736c41 100644 (file)
@@ -1,36 +1,63 @@
-package DBIx::Class::Storage::DBI::Replication;
+package DBIx::Class::Storage::DBI::Replicated;
 
 use strict;
 use warnings;
 
 use DBIx::Class::Storage::DBI;
 use DBD::Multi;
+
 use base qw/Class::Accessor::Fast/;
 
 __PACKAGE__->mk_accessors( qw/read_source write_source/ );
 
 =head1 NAME
 
-DBIx::Class::Storage::DBI::Replication - EXPERIMENTAL Replicated database support
+DBIx::Class::Storage::DBI::Replicated - ALPHA Replicated database support
 
 =head1 SYNOPSIS
 
-  # change storage_type in your schema class
-    $schema->storage_type( '::DBI::Replication' );
-    $schema->connect_info( [
-                    [ "dbi:mysql:database=test;hostname=master", "username", "password", { AutoCommit => 1 } ], # master
-                    [ "dbi:mysql:database=test;hostname=slave1", "username", "password", { priority => 10 } ],  # slave1
-                    [ "dbi:mysql:database=test;hostname=slave2", "username", "password", { priority => 10 } ],  # slave2
-                    [ $dbh, '','', {priority=>10}], # add in a preexisting database handle
-                    [ sub {  DBI->connect }, '', '', {priority=>10}], # DBD::Multi will call this coderef for connects
-                    <...>,
-                    { limit_dialect => 'LimitXY' } # If needed, see below
-                   ] );
+The Following example shows how to change an existing $schema to a replicated
+storage type and update it's connection information to contain a master DSN and
+an array of slaves.
+
+    ## Change storage_type in your schema class
+    $schema->storage_type( '::DBI::Replicated' );
+    
+    ## Set your connection.
+    $schema->connect(
+        $dsn, $user, $password, {
+               AutoCommit => 1,
+               ## Other standard DBI connection or DBD custom attributes added as
+               ## usual.  Additionally, we have two custom attributes for defining
+               ## slave information and controlling how the underlying DBD::Multi
+               slaves_connect_info => [
+                  ## Define each slave like a 'normal' DBI connection, but you add
+                  ## in a DBD::Multi custom attribute to define how the slave is
+                  ## prioritized.  Please see DBD::Multi for more.
+                  [$slave1dsn, $user, $password, {%slave1opts, priority=>10}],
+               [$slave2dsn, $user, $password, {%slave2opts, priority=>10}],
+               [$slave3dsn, $user, $password, {%slave3opts, priority=>20}],
+               ## add in a preexisting database handle
+               [$dbh, '','', {priority=>30}], 
+               ## DBD::Multi will call this coderef for connects 
+               [sub {  DBI->connect(< DSN info >) }, '', '', {priority=>40}],  
+               ## If the last item is hashref, we use that for DBD::Multi's 
+               ## configuration information.  Again, see DBD::Multi for more.
+               {timeout=>25, failed_max=>2},              
+               ],
+        },
+    );
+    
+    ## Now, just use the schema as normal
+    $schema->resultset('Table')->find(< unique >); ## Reads will use slaves
+    $schema->resultset('Table')->create(\%info); ## Writes will use master
 
 =head1 DESCRIPTION
 
-Warning: This class is marked EXPERIMENTAL. It works for the authors but does
-not currently have automated tests so your mileage may vary.
+Warning: This class is marked ALPHA.  We are using this in development and have
+some basic test coverage but the code hasn't yet been stressed by a variety
+of databases.  Individual DB's may have quirks we are not aware of.  Please
+use this in development and pass along your experiences/bug fixes.
 
 This class implements replicated data store for DBI. Currently you can define
 one master and numerous slave database connections. All write-type queries
@@ -44,13 +71,7 @@ if all low priority data sources fail, higher ones tried in order.
 
 =head1 CONFIGURATION
 
-=head2 Limit dialect
-
-If you use LIMIT in your queries (effectively, if you use
-SQL::Abstract::Limit), do not forget to set up limit_dialect (perldoc
-SQL::Abstract::Limit) by passing it as an option in the (optional) hash
-reference to connect_info.  DBIC can not set it up automatically, since it can
-not guess DBD::Multi connection types.
+Please see L<DBD::Multi> for most configuration information.
 
 =cut
 
@@ -75,37 +96,48 @@ sub all_sources {
     return wantarray ? @sources : \@sources;
 }
 
-sub connect_info {
-    my( $self, $source_info ) = @_;
-
-    my( $info, $global_options, $options, @dsns );
-
-    $info = [ @$source_info ];
-
-    $global_options = ref $info->[-1] eq 'HASH' ? pop( @$info ) : {};
-    if( ref( $options = $info->[0]->[-1] ) eq 'HASH' ) {
-       # Local options present in dsn, merge them with global options
-        map { $global_options->{$_} = $options->{$_} } keys %$options;
-        pop @{$info->[0]};
-    }
+sub _connect_info {
+       my $self = shift;
+    my $master = $self->write_source->_connect_info;
+    $master->[-1]->{slave_connect_info} = $self->read_source->_connect_info;
+    return $master;
+}
 
-    # We need to copy-pass $global_options, since connect_info clears it while
-    # processing options
-    $self->write_source->connect_info( @{$info->[0]}, { %$global_options } );
+sub connect_info {
+       my ($self, $source_info) = @_;
 
-       ## allow either a DSN string or an already connect $dbh.  Just remember if
-       ## you use the $dbh option then DBD::Multi has no idea how to reconnect in
-       ## the event of a failure.
-       
-    @dsns = map {
+    ## if there is no $source_info, treat this sub like an accessor
+    return $self->_connect_info
+     if !$source_info;
+    
+    ## Alright, let's conect the master 
+    $self->write_source->connect_info($source_info);
+  
+    ## Now, build and then connect the Slaves
+    my @slaves_connect_info = @{$source_info->[-1]->{slaves_connect_info}};   
+    my $dbd_multi_config = ref $slaves_connect_info[-1] eq 'HASH' 
+        ? pop @slaves_connect_info : {};
+
+    ## We need to do this since SQL::Abstract::Limit can't guess what DBD::Multi is
+    $dbd_multi_config->{limit_dialect} = $self->write_source->sql_maker->limit_dialect
+        unless defined $dbd_multi_config->{limit_dialect};
+
+    @slaves_connect_info = map {
         ## if the first element in the arrayhash is a ref, make that the value
         my $db = ref $_->[0] ? $_->[0] : $_;
-        ($_->[3]->{priority} || 10) => $db;
-    } @{$info->[0]}[1..@{$info->[0]}-1];
+       my $priority = $_->[-1]->{priority} || 10; ## default priority is 10
+       $priority => $db;
+    } @slaves_connect_info;
     
-    $global_options->{dsns} = \@dsns;
-
-    $self->read_source->connect_info( [ 'dbi:Multi:', undef, undef, { %$global_options } ] );
+    $self->read_source->connect_info([ 
+        'dbi:Multi:', undef, undef, { 
+               dsns => [@slaves_connect_info],
+               %$dbd_multi_config,
+        },
+    ]);
+    
+    ## Return the formated connection information
+    return $self->_connect_info;
 }
 
 sub select {
@@ -191,8 +223,8 @@ sub ensure_connected {
 sub dbh {
     shift->write_source->dbh( @_ );
 }
-sub txn_begin {
-    shift->write_source->txn_begin( @_ );
+sub txn_do {
+    shift->write_source->txn_do( @_ );
 }
 sub txn_commit {
     shift->write_source->txn_commit( @_ );
@@ -206,7 +238,16 @@ sub sth {
 sub deploy {
     shift->write_source->deploy( @_ );
 }
+sub _prep_for_execute {
+       shift->write_source->_prep_for_execute(@_);
+}
 
+sub debugobj {
+       shift->write_source->debugobj(@_);
+}
+sub debug {
+    shift->write_source->debug(@_);
+}
 
 sub debugfh { shift->_not_supported( 'debugfh' ) };
 sub debugcb { shift->_not_supported( 'debugcb' ) };
@@ -227,6 +268,8 @@ Norbert Csongr
 
 Peter Siklósi <einon@einon.hu>
 
+John Napiorkowski <john.napiorkowski@takkle.com>
+
 =head1 LICENSE
 
 You may distribute this code under the same terms as Perl itself.
index afe7b76..62a4d15 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     eval "use DBD::Multi";
     plan $@
         ? ( skip_all => 'needs DBD::Multi for testing' )
-        : ( tests => 18 );
+        : ( tests => 20 );
 }      
 
 ## ----------------------------------------------------------------------------
@@ -16,7 +16,7 @@ BEGIN {
 
 TESTSCHEMACLASS: {
        
-       package DBIx::Class::DBI::Replication::TestReplication;
+       package DBIx::Class::DBI::Replicated::TestReplication;
 
        use DBI;        
        use DBICTest;
@@ -57,7 +57,7 @@ TESTSCHEMACLASS: {
        sub init_schema {
                my $class = shift @_;
                my $schema = DBICTest->init_schema();
-               $schema->storage_type( '::DBI::Replication' );
+               $schema->storage_type( '::DBI::Replicated' );
                
                return $schema;
        }
@@ -67,15 +67,15 @@ TESTSCHEMACLASS: {
        sub connect {
                my $self = shift @_;
                my ($master, @slaves) = @{$self->{dsns}};
-               my @connections = ([$master, '','', {AutoCommit=>1, PrintError=>0}]);
-               my @slavesob;
+               my $master_connect_info = [$master, '','', {AutoCommit=>1, PrintError=>0}];
                
+               my @slavesob;
                foreach my $slave (@slaves)
                {
                        my $dbh = shift @{$self->{slaves}}
                         || DBI->connect($slave,"","",{PrintError=>0, PrintWarn=>0});
                        
-                       push @connections,
+                       push @{$master_connect_info->[-1]->{slaves_connect_info}},
                         [$dbh, '','',{priority=>10}];
                         
                        push @slavesob,
@@ -87,10 +87,7 @@ TESTSCHEMACLASS: {
                
                $self
                        ->{schema}
-                       ->connect([
-                               @connections,
-                               {limit_dialect => 'LimitXY'}
-                       ]);
+                       ->connect(@$master_connect_info);
        }
        
        ## replication
@@ -137,7 +134,7 @@ my %params = (
        ],
 );
 
-ok my $replicate = DBIx::Class::DBI::Replication::TestReplication->new(%params)
+ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new(%params)
        => 'Created a replication object';
        
 isa_ok $replicate->{schema}
@@ -171,13 +168,6 @@ is $artist1->name, 'Ozric Tentacles'
 ## we overload any type of write operation so that is must hit the master
 ## database.
 
-use Fcntl qw (:flock);
-
-my $master_path = $replicate->{db_paths}->[0];
-open LOCKFILE, ">>$master_path"
- or die "Cannot open $master_path";
-flock(LOCKFILE, LOCK_EX);
-
 $replicate
        ->{schema}
        ->populate('Artist', [
@@ -255,6 +245,20 @@ eval {
 
 ok $@ => 'Got read errors after everything failed';
 
+## make sure ->connect_info returns something sane
+
+ok $replicate->{schema}->storage->connect_info
+    => 'got something out of ->connect_info';
+
+## Force a connection to the write source for testing.
+
+$replicate->{schema}->storage($replicate->{schema}->storage->write_source);
+
+## What happens when we do a find for something that doesn't exist?
+
+ok ! $replicate->{schema}->resultset('Artist')->find(666)
+    => 'Correctly did not find a bad artist id';
+
 ## Delete the old database files
 $replicate->cleanup;