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

   1 package DBIx::Class::Storage::DBI::Replicated;
   2
   3 use Moose;
   4 use DBIx::Class::Storage::DBI;
   5 use DBIx::Class::Storage::DBI::Replicated::Pool;
   6 use DBIx::Class::Storage::DBI::Replicated::Balancer;
   7 use Scalar::Util qw(blessed);
   8
   9 extends 'DBIx::Class::Storage::DBI', 'Moose::Object';
  10
  11 =head1 NAME
  12
  13 DBIx::Class::Storage::DBI::Replicated - ALPHA Replicated database support
  14
  15 =head1 SYNOPSIS
  16
  17 The Following example shows how to change an existing $schema to a replicated
  18 storage type, add some replicated (readonly) databases, and perform reporting
  19 tasks.
  20
  21     ## Change storage_type in your schema class
  22     $schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
  23
  24     ## Add some slaves.  Basically this is an array of arrayrefs, where each
  25     ## arrayref is database connect information
  26
  27     $schema->storage->connect_replicants(
  28         [$dsn1, $user, $pass, \%opts],
  29         [$dsn1, $user, $pass, \%opts],
  30         [$dsn1, $user, $pass, \%opts],
  31     );
  32
  33 =head1 DESCRIPTION
  34
  35 Warning: This class is marked ALPHA.  We are using this in development and have
  36 some basic test coverage but the code hasn't yet been stressed by a variety
  37 of databases.  Individual DB's may have quirks we are not aware of.  Please
  38 use this in development and pass along your experiences/bug fixes.
  39
  40 This class implements replicated data store for DBI. Currently you can define
  41 one master and numerous slave database connections. All write-type queries
  42 (INSERT, UPDATE, DELETE and even LAST_INSERT_ID) are routed to master
  43 database, all read-type queries (SELECTs) go to the slave database.
  44
  45 Basically, any method request that L<DBIx::Class::Storage::DBI> would normally
  46 handle gets delegated to one of the two attributes: L</master_storage> or to
  47 L</current_replicant_storage>.  Additionally, some methods need to be distributed
  48 to all existing storages.  This way our storage class is a drop in replacement
  49 for L<DBIx::Class::Storage::DBI>.
  50
  51 Read traffic is spread across the replicants (slaves) occuring to a user
  52 selected algorithm.  The default algorithm is random weighted.
  53
  54 TODO more details about the algorithm.
  55
  56 =head1 ATTRIBUTES
  57
  58 This class defines the following attributes.
  59
  60 =head2 pool_type
  61
  62 Contains the classname which will instantiate the L</pool> object.  Defaults
  63 to: L<DBIx::Class::Storage::DBI::Replicated::Pool>.
  64
  65 =cut
  66
  67 has 'pool_type' => (
  68     is=>'ro',
  69     isa=>'ClassName',
  70     lazy_build=>1,
  71     handles=>{
  72         'create_pool' => 'new',
  73     },
  74 );
  75
  76 =head2 pool_args
  77
  78 Contains a hashref of initialized information to pass to the Balancer object.
  79 See L<DBIx::Class::Storage::Replicated::Pool> for available arguments.
  80
  81 =cut
  82
  83 has 'pool_args' => (
  84     is=>'ro',
  85     isa=>'HashRef',
  86     lazy=>1,
  87     required=>1,
  88     default=>sub { {} },
  89 );
  90
  91
  92 =head2 balancer_type
  93
  94 The replication pool requires a balance class to provider the methods for
  95 choose how to spread the query load across each replicant in the pool.
  96
  97 =cut
  98
  99 has 'balancer_type' => (
 100     is=>'ro',
 101     isa=>'ClassName',
 102     lazy_build=>1,
 103     handles=>{
 104         'create_balancer' => 'new',
 105     },
 106 );
 107
 108 =head2 balancer_args
 109
 110 Contains a hashref of initialized information to pass to the Balancer object.
 111 See L<DBIx::Class::Storage::Replicated::Balancer> for available arguments.
 112
 113 =cut
 114
 115 has 'balancer_args' => (
 116     is=>'ro',
 117     isa=>'HashRef',
 118     lazy=>1,
 119     required=>1,
 120     default=>sub { {} },
 121 );
 122
 123 =head2 pool
 124
 125 Is a <DBIx::Class::Storage::DBI::Replicated::Pool> or derived class.  This is a
 126 container class for one or more replicated databases.
 127
 128 =cut
 129
 130 has 'pool' => (
 131     is=>'ro',
 132     isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
 133     lazy_build=>1,
 134     handles=>[qw/
 135         connect_replicants
 136         replicants
 137         has_replicants
 138     /],
 139 );
 140
 141 =head2 balancer
 142
 143 Is a <DBIx::Class::Storage::DBI::Replicated::Balancer> or derived class.  This
 144 is a class that takes a pool (<DBIx::Class::Storage::DBI::Replicated::Pool>)
 145
 146 =cut
 147
 148 has 'balancer' => (
 149     is=>'ro',
 150     isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
 151     lazy_build=>1,
 152     handles=>[qw/auto_validate_every/],
 153 );
 154
 155 =head2 master
 156
 157 The master defines the canonical state for a pool of connected databases.  All
 158 the replicants are expected to match this databases state.  Thus, in a classic
 159 Master / Slaves distributed system, all the slaves are expected to replicate
 160 the Master's state as quick as possible.  This is the only database in the
 161 pool of databases that is allowed to handle write traffic.
 162
 163 =cut
 164
 165 has 'master' => (
 166     is=> 'ro',
 167     isa=>'DBIx::Class::Storage::DBI',
 168     lazy_build=>1,
 169 );
 170
 171 =head1 ATTRIBUTES IMPLEMENTING THE DBIx::Storage::DBI INTERFACE
 172
 173 The following methods are delegated all the methods required for the
 174 L<DBIx::Class::Storage::DBI> interface.
 175
 176 =head2 read_handler
 177
 178 Defines an object that implements the read side of L<BIx::Class::Storage::DBI>.
 179
 180 =cut
 181
 182 has 'read_handler' => (
 183     is=>'rw',
 184     isa=>'Object',
 185     lazy_build=>1,
 186     handles=>[qw/
 187         select
 188         select_single
 189         columns_info_for
 190     /],
 191 );
 192
 193 =head2 write_handler
 194
 195 Defines an object that implements the write side of L<BIx::Class::Storage::DBI>.
 196
 197 =cut
 198
 199 has 'write_handler' => (
 200     is=>'ro',
 201     isa=>'Object',
 202     lazy_build=>1,
 203     lazy_build=>1,
 204     handles=>[qw/
 205         on_connect_do
 206         on_disconnect_do
 207         connect_info
 208         throw_exception
 209         sql_maker
 210         sqlt_type
 211         create_ddl_dir
 212         deployment_statements
 213         datetime_parser
 214         datetime_parser_type
 215         last_insert_id
 216         insert
 217         insert_bulk
 218         update
 219         delete
 220         dbh
 221         txn_do
 222         txn_commit
 223         txn_rollback
 224         sth
 225         deploy
 226         schema
 227     /],
 228 );
 229
 230 =head1 METHODS
 231
 232 This class defines the following methods.
 233
 234 =head2 new
 235
 236 L<DBIx::Class::Schema> when instantiating it's storage passed itself as the
 237 first argument.  We need to invoke L</new> on the underlying parent class, make
 238 sure we properly give it a L<Moose> meta class, and then correctly instantiate
 239 our attributes.  Basically we pass on whatever the schema has in it's class
 240 data for 'storage_type_args' to our replicated storage type.
 241
 242 =cut
 243
 244 sub new {
 245     my $class = shift @_;
 246     my $schema = shift @_;
 247     my $storage_type_args = shift @_;
 248     my $obj = $class->SUPER::new($schema, $storage_type_args, @_);
 249
 250     ## Hate to do it this way, but can't seem to get advice on the attribute working right
 251     ## maybe we can do a type and coercion for it.
 252     if( $storage_type_args->{balancer_type} && $storage_type_args->{balancer_type}=~m/^::/) {
 253         $storage_type_args->{balancer_type} = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$storage_type_args->{balancer_type};
 254         eval "require $storage_type_args->{balancer_type}";
 255     }
 256
 257     return $class->meta->new_object(
 258         __INSTANCE__ => $obj,
 259         %$storage_type_args,
 260         @_,
 261     );
 262 }
 263
 264 =head2 _build_master
 265
 266 Lazy builder for the L</master> attribute.
 267
 268 =cut
 269
 270 sub _build_master {
 271         DBIx::Class::Storage::DBI->new;
 272 }
 273
 274 =head2 _build_pool_type
 275
 276 Lazy builder for the L</pool_type> attribute.
 277
 278 =cut
 279
 280 sub _build_pool_type {
 281     return 'DBIx::Class::Storage::DBI::Replicated::Pool';
 282 }
 283
 284 =head2 _build_pool
 285
 286 Lazy builder for the L</pool> attribute.
 287
 288 =cut
 289
 290 sub _build_pool {
 291         my $self = shift @_;
 292     $self->create_pool(%{$self->pool_args});
 293 }
 294
 295 =head2 _build_balancer_type
 296
 297 Lazy builder for the L</balancer_type> attribute.
 298
 299 =cut
 300
 301 sub _build_balancer_type {
 302     return 'DBIx::Class::Storage::DBI::Replicated::Balancer::First';
 303 }
 304
 305 =head2 _build_balancer
 306
 307 Lazy builder for the L</balancer> attribute.  This takes a Pool object so that
 308 the balancer knows which pool it's balancing.
 309
 310 =cut
 311
 312 sub _build_balancer {
 313     my $self = shift @_;
 314     $self->create_balancer(
 315         pool=>$self->pool,
 316         master=>$self->master,
 317         %{$self->balancer_args},);
 318 }
 319
 320 =head2 _build_write_handler
 321
 322 Lazy builder for the L</write_handler> attribute.  The default is to set this to
 323 the L</master>.
 324
 325 =cut
 326
 327 sub _build_write_handler {
 328     return shift->master;
 329 }
 330
 331 =head2 _build_read_handler
 332
 333 Lazy builder for the L</read_handler> attribute.  The default is to set this to
 334 the L</balancer>.
 335
 336 =cut
 337
 338 sub _build_read_handler {
 339     return shift->balancer;
 340 }
 341
 342 =head2 around: connect_replicants
 343
 344 All calls to connect_replicants needs to have an existing $schema tacked onto
 345 top of the args, since L<DBIx::Storage::DBI> needs it.
 346
 347 =cut
 348
 349 around 'connect_replicants' => sub {
 350         my ($method, $self, @args) = @_;
 351         $self->$method($self->schema, @args);
 352 };
 353
 354 =head2 all_storages
 355
 356 Returns an array of of all the connected storage backends.  The first element
 357 in the returned array is the master, and the remainings are each of the
 358 replicants.
 359
 360 =cut
 361
 362 sub all_storages {
 363         my $self = shift @_;
 364
 365         return grep {defined $_ && blessed $_} (
 366            $self->master,
 367            $self->replicants,
 368         );
 369 }
 370
 371 =head2 set_reliable_storage
 372
 373 Sets the current $schema to be 'reliable', that is all queries, both read and
 374 write are sent to the master
 375
 376 =cut
 377
 378 sub set_reliable_storage {
 379         my $self = shift @_;
 380         my $schema = $self->schema;
 381         my $write_handler = $self->schema->storage->write_handler;
 382
 383         $schema->storage->read_handler($write_handler);
 384 }
 385
 386 =head2 set_balanced_storage
 387
 388 Sets the current $schema to be use the </balancer> for all reads, while all
 389 writea are sent to the master only
 390
 391 =cut
 392
 393 sub set_balanced_storage {
 394     my $self = shift @_;
 395     my $schema = $self->schema;
 396     my $write_handler = $self->schema->storage->balancer;
 397
 398     $schema->storage->read_handler($write_handler);
 399 }
 400
 401 =head2 connected
 402
 403 Check that the master and at least one of the replicants is connected.
 404
 405 =cut
 406
 407 sub connected {
 408         my $self = shift @_;
 409
 410         return
 411            $self->master->connected &&
 412            $self->pool->connected_replicants;
 413 }
 414
 415 =head2 ensure_connected
 416
 417 Make sure all the storages are connected.
 418
 419 =cut
 420
 421 sub ensure_connected {
 422     my $self = shift @_;
 423     foreach my $source ($self->all_storages) {
 424         $source->ensure_connected(@_);
 425     }
 426 }
 427
 428 =head2 limit_dialect
 429
 430 Set the limit_dialect for all existing storages
 431
 432 =cut
 433
 434 sub limit_dialect {
 435     my $self = shift @_;
 436     foreach my $source ($self->all_storages) {
 437         $source->limit_dialect(@_);
 438     }
 439 }
 440
 441 =head2 quote_char
 442
 443 Set the quote_char for all existing storages
 444
 445 =cut
 446
 447 sub quote_char {
 448     my $self = shift @_;
 449     foreach my $source ($self->all_storages) {
 450         $source->quote_char(@_);
 451     }
 452 }
 453
 454 =head2 name_sep
 455
 456 Set the name_sep for all existing storages
 457
 458 =cut
 459
 460 sub name_sep {
 461     my $self = shift @_;
 462     foreach my $source ($self->all_storages) {
 463         $source->name_sep(@_);
 464     }
 465 }
 466
 467 =head2 set_schema
 468
 469 Set the schema object for all existing storages
 470
 471 =cut
 472
 473 sub set_schema {
 474         my $self = shift @_;
 475         foreach my $source ($self->all_storages) {
 476                 $source->set_schema(@_);
 477         }
 478 }
 479
 480 =head2 debug
 481
 482 set a debug flag across all storages
 483
 484 =cut
 485
 486 sub debug {
 487     my $self = shift @_;
 488     foreach my $source ($self->all_storages) {
 489         $source->debug(@_);
 490     }
 491 }
 492
 493 =head2 debugobj
 494
 495 set a debug object across all storages
 496
 497 =cut
 498
 499 sub debugobj {
 500     my $self = shift @_;
 501     foreach my $source ($self->all_storages) {
 502         $source->debugobj(@_);
 503     }
 504 }
 505
 506 =head2 debugfh
 507
 508 set a debugfh object across all storages
 509
 510 =cut
 511
 512 sub debugfh {
 513     my $self = shift @_;
 514     foreach my $source ($self->all_storages) {
 515         $source->debugfh(@_);
 516     }
 517 }
 518
 519 =head2 debugcb
 520
 521 set a debug callback across all storages
 522
 523 =cut
 524
 525 sub debugcb {
 526     my $self = shift @_;
 527     foreach my $source ($self->all_storages) {
 528         $source->debugcb(@_);
 529     }
 530 }
 531
 532 =head2 disconnect
 533
 534 disconnect everything
 535
 536 =cut
 537
 538 sub disconnect {
 539     my $self = shift @_;
 540     foreach my $source ($self->all_storages) {
 541         $source->disconnect(@_);
 542     }
 543 }
 544
 545 =head1 AUTHOR
 546
 547 Norbert Csongrádi <bert@cpan.org>
 548
 549 Peter Siklósi <einon@einon.hu>
 550
 551 John Napiorkowski <john.napiorkowski@takkle.com>
 552
 553 =head1 LICENSE
 554
 555 You may distribute this code under the same terms as Perl itself.
 556
 557 =cut
 558
 559 1;