lib/DBIx/Class/Storage/DBI/Replication.pm

   1 package DBIx::Class::Storage::DBI::Replication;
   2
   3 use strict;
   4 use warnings;
   5
   6 use DBIx::Class::Storage::DBI;
   7 use DBD::Multi;
   8 use base qw/Class::Accessor::Fast/;
   9
  10 __PACKAGE__->mk_accessors( qw/read_source write_source/ );
  11
  12 =head1 NAME
  13
  14 DBIx::Class::Storage::DBI::Replication - Replicated database support
  15
  16 =head1 SYNOPSIS
  17
  18   # change storage_type in your schema class
  19     $schema->storage_type( '::DBI::Replication' );
  20     $schema->connect_info( [
  21                      [ "dbi:mysql:database=test;hostname=master", "username", "password", { AutoCommit => 1 } ], # master
  22                      [ "dbi:mysql:database=test;hostname=slave1", "username", "password", { priority => 10 } ],  # slave1
  23                      [ "dbi:mysql:database=test;hostname=slave2", "username", "password", { priority => 10 } ],  # slave2
  24                      <...>,
  25                      { limit_dialect => 'LimitXY' } # If needed, see below
  26                     ] );
  27
  28 =head1 DESCRIPTION
  29
  30 This class implements replicated data store for DBI. Currently you can define one master and numerous slave database
  31 connections. All write-type queries (INSERT, UPDATE, DELETE and even LAST_INSERT_ID) are routed to master database,
  32 all read-type queries (SELECTs) go to the slave database.
  33
  34 For every slave database you can define a priority value, which controls data source usage pattern. It uses
  35 L<DBD::Multi>, so first the lower priority data sources used (if they have the same priority, the are used
  36 randomized), than if all low priority data sources fail, higher ones tried in order.
  37
  38 =head1 CONFIGURATION
  39
  40 =head2 Limit dialect
  41
  42 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.
  43 DBIC can not set it up automatically, since it can not guess DBD::Multi connection types.
  44
  45 =cut
  46
  47 sub new {
  48     my $proto = shift;
  49     my $class = ref( $proto ) || $proto;
  50     my $self = {};
  51
  52     bless( $self, $class );
  53
  54     $self->write_source( DBIx::Class::Storage::DBI->new );
  55     $self->read_source( DBIx::Class::Storage::DBI->new );
  56
  57     return $self;
  58 }
  59
  60 sub all_sources {
  61     my $self = shift;
  62
  63     my @sources = ($self->read_source, $self->write_source);
  64
  65     return wantarray ? @sources : \@sources;
  66 }
  67
  68 sub connect_info {
  69     my( $self, $source_info ) = @_;
  70
  71     my $last_info = ref $source_info->[-1] eq 'HASH' ? pop( @$source_info ) : undef;
  72
  73     $self->write_source->connect_info( $source_info->[0], $last_info );
  74
  75     my @dsns = map { ($_->[3]->{priority} || 10) => $_ } @{$source_info}[1..@$source_info-1];
  76     $self->read_source->connect_info( [ 'dbi:Multi:', undef, undef, { dsns => \@dsns } ], $last_info );
  77 }
  78
  79 sub select {
  80     shift->read_source->select( @_ );
  81 }
  82 sub select_single {
  83     shift->read_source->select_single( @_ );
  84 }
  85 sub throw_exception {
  86     shift->read_source->throw_exception( @_ );
  87 }
  88 sub sql_maker {
  89     shift->read_source->sql_maker( @_ );
  90 }
  91 sub columns_info_for {
  92     shift->read_source->columns_info_for( @_ );
  93 }
  94 sub sqlt_type {
  95     shift->read_source->sqlt_type( @_ );
  96 }
  97 sub create_ddl_dir {
  98     shift->read_source->create_ddl_dir( @_ );
  99 }
 100 sub deployment_statements {
 101     shift->read_source->deployment_statements( @_ );
 102 }
 103 sub datetime_parser {
 104     shift->read_source->datetime_parser( @_ );
 105 }
 106 sub datetime_parser_type {
 107     shift->read_source->datetime_parser_type( @_ );
 108 }
 109 sub build_datetime_parser {
 110     shift->read_source->build_datetime_parser( @_ );
 111 }
 112
 113 sub limit_dialect {
 114     my $self = shift;
 115     $self->$_->limit_dialect( @_ ) for( $self->all_sources );
 116 }
 117 sub quote_char {
 118     my $self = shift;
 119     $self->$_->quote_char( @_ ) for( $self->all_sources );
 120 }
 121 sub name_sep {
 122     my $self = shift;
 123     $self->$_->quote_char( @_ ) for( $self->all_sources );
 124 }
 125 sub disconnect {
 126     my $self = shift;
 127     $self->$_->disconnect( @_ ) for( $self->all_sources );
 128 }
 129 sub DESTROY {
 130     my $self = shift;
 131
 132     undef $self->{write_source};
 133     undef $self->{read_sources};
 134 }
 135
 136 sub last_insert_id {
 137     shift->write_source->last_insert_id( @_ );
 138 }
 139 sub insert {
 140     shift->write_source->insert( @_ );
 141 }
 142 sub update {
 143     shift->write_source->update( @_ );
 144 }
 145 sub update_all {
 146     shift->write_source->update_all( @_ );
 147 }
 148 sub delete {
 149     shift->write_source->delete( @_ );
 150 }
 151 sub delete_all {
 152     shift->write_source->delete_all( @_ );
 153 }
 154 sub create {
 155     shift->write_source->create( @_ );
 156 }
 157 sub find_or_create {
 158     shift->write_source->find_or_create( @_ );
 159 }
 160 sub update_or_create {
 161     shift->write_source->update_or_create( @_ );
 162 }
 163 sub connected {
 164     shift->write_source->connected( @_ );
 165 }
 166 sub ensure_connected {
 167     shift->write_source->ensure_connected( @_ );
 168 }
 169 sub dbh {
 170     shift->write_source->dbh( @_ );
 171 }
 172 sub txn_begin {
 173     shift->write_source->txn_begin( @_ );
 174 }
 175 sub txn_commit {
 176     shift->write_source->txn_commit( @_ );
 177 }
 178 sub txn_rollback {
 179     shift->write_source->txn_rollback( @_ );
 180 }
 181 sub sth {
 182     shift->write_source->sth( @_ );
 183 }
 184 sub deploy {
 185     shift->write_source->deploy( @_ );
 186 }
 187
 188
 189 sub debugfh { shift->_not_supported( 'debugfh' ) };
 190 sub debugcb { shift->_not_supported( 'debugcb' ) };
 191
 192 sub _not_supported {
 193     my( $self, $method ) = @_;
 194
 195     die "This Storage does not support $method method.";
 196 }
 197
 198 =head1 SEE ALSO
 199
 200 L<DBI::Class::Storage::DBI>, L<DBD::Multi>, L<DBI>
 201
 202 =head1 AUTHOR
 203
 204 Norbert Csongrádi <bert@cpan.org>
 205
 206 Peter Siklósi <einon@einon.hu>
 207
 208 =head1 LICENSE
 209
 210 You may distribute this code under the same terms as Perl itself.
 211
 212 =cut
 213
 214 1;