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