fix and regression test for RT #62642
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Replicated.pm
CommitLineData
2156bbdd 1package DBIx::Class::Storage::DBI::Replicated;
f5d3a5de 2
ecb65397 3BEGIN {
4 use Carp::Clan qw/^DBIx::Class/;
a34b0c89 5 use DBIx::Class;
6 croak('The following modules are required for Replication ' . DBIx::Class::Optional::Dependencies->req_missing_for ('replicated') )
7 unless DBIx::Class::Optional::Dependencies->req_ok_for ('replicated');
ecb65397 8}
9
b2e4d522 10use Moose;
26ab719a 11use DBIx::Class::Storage::DBI;
2bf79155 12use DBIx::Class::Storage::DBI::Replicated::Pool;
26ab719a 13use DBIx::Class::Storage::DBI::Replicated::Balancer;
6a151f58 14use DBIx::Class::Storage::DBI::Replicated::Types qw/BalancerClassNamePart DBICSchema DBICStorageDBI/;
41916570 15use MooseX::Types::Moose qw/ClassName HashRef Object/;
b2e4d522 16use Scalar::Util 'reftype';
e666c5fd 17use Hash::Merge;
7da56142 18use List::Util qw/min max reduce/;
ed7ab0f4 19use Try::Tiny;
fd323bf1 20use namespace::clean;
9901aad7 21
22use namespace::clean -except => 'meta';
2bf79155 23
24=head1 NAME
25
ecb65397 26DBIx::Class::Storage::DBI::Replicated - BETA Replicated database support
2bf79155 27
28=head1 SYNOPSIS
29
30The Following example shows how to change an existing $schema to a replicated
48580715 31storage type, add some replicated (read-only) databases, and perform reporting
955a6df6 32tasks.
2bf79155 33
3da4f736 34You should set the 'storage_type attribute to a replicated type. You should
d4daee7b 35also define your arguments, such as which balancer you want and any arguments
3da4f736 36that the Pool object should get.
37
ce854fd3 38 my $schema = Schema::Class->clone;
64cdad22 39 $schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
ce854fd3 40 $schema->connection(...);
d4daee7b 41
fd323bf1 42Next, you need to add in the Replicants. Basically this is an array of
3da4f736 43arrayrefs, where each arrayref is database connect information. Think of these
44arguments as what you'd pass to the 'normal' $schema->connect method.
d4daee7b 45
64cdad22 46 $schema->storage->connect_replicants(
47 [$dsn1, $user, $pass, \%opts],
48 [$dsn2, $user, $pass, \%opts],
49 [$dsn3, $user, $pass, \%opts],
50 );
d4daee7b 51
3da4f736 52Now, just use the $schema as you normally would. Automatically all reads will
53be delegated to the replicants, while writes to the master.
54
7e38d850 55 $schema->resultset('Source')->search({name=>'etc'});
d4daee7b 56
3da4f736 57You can force a given query to use a particular storage using the search
58attribute 'force_pool'. For example:
d4daee7b 59
7e38d850 60 my $RS = $schema->resultset('Source')->search(undef, {force_pool=>'master'});
3da4f736 61
62Now $RS will force everything (both reads and writes) to use whatever was setup
fd323bf1 63as the master storage. 'master' is hardcoded to always point to the Master,
3da4f736 64but you can also use any Replicant name. Please see:
212cc5c2 65L<DBIx::Class::Storage::DBI::Replicated::Pool> and the replicants attribute for more.
3da4f736 66
67Also see transactions and L</execute_reliably> for alternative ways to
68force read traffic to the master. In general, you should wrap your statements
69in a transaction when you are reading and writing to the same tables at the
70same time, since your replicants will often lag a bit behind the master.
212cc5c2 71
72See L<DBIx::Class::Storage::DBI::Replicated::Instructions> for more help and
73walkthroughs.
d4daee7b 74
2bf79155 75=head1 DESCRIPTION
76
7e38d850 77Warning: This class is marked BETA. This has been running a production
ccb3b897 78website using MySQL native replication as its backend and we have some decent
7e38d850 79test coverage but the code hasn't yet been stressed by a variety of databases.
48580715 80Individual DBs may have quirks we are not aware of. Please use this in first
7e38d850 81development and pass along your experiences/bug fixes.
2bf79155 82
83This class implements replicated data store for DBI. Currently you can define
84one master and numerous slave database connections. All write-type queries
85(INSERT, UPDATE, DELETE and even LAST_INSERT_ID) are routed to master
86database, all read-type queries (SELECTs) go to the slave database.
87
88Basically, any method request that L<DBIx::Class::Storage::DBI> would normally
bca099a3 89handle gets delegated to one of the two attributes: L</read_handler> or to
90L</write_handler>. Additionally, some methods need to be distributed
2bf79155 91to all existing storages. This way our storage class is a drop in replacement
92for L<DBIx::Class::Storage::DBI>.
93
48580715 94Read traffic is spread across the replicants (slaves) occurring to a user
2bf79155 95selected algorithm. The default algorithm is random weighted.
96
bca099a3 97=head1 NOTES
98
48580715 99The consistency between master and replicants is database specific. The Pool
faaba25f 100gives you a method to validate its replicants, removing and replacing them
7e38d850 101when they fail/pass predefined criteria. Please make careful use of the ways
ecb65397 102to force a query to run against Master when needed.
103
104=head1 REQUIREMENTS
105
a34b0c89 106Replicated Storage has additional requirements not currently part of
aa8b2277 107L<DBIx::Class>. See L<DBIx::Class::Optional::Dependencies> for more details.
2bf79155 108
109=head1 ATTRIBUTES
110
111This class defines the following attributes.
112
2ce6e9a6 113=head2 schema
114
115The underlying L<DBIx::Class::Schema> object this storage is attaching
116
117=cut
118
119has 'schema' => (
120 is=>'rw',
6a151f58 121 isa=>DBICSchema,
2ce6e9a6 122 weak_ref=>1,
123 required=>1,
124);
125
26ab719a 126=head2 pool_type
2bf79155 127
fd323bf1 128Contains the classname which will instantiate the L</pool> object. Defaults
26ab719a 129to: L<DBIx::Class::Storage::DBI::Replicated::Pool>.
2bf79155 130
131=cut
132
26ab719a 133has 'pool_type' => (
dcdf7b2c 134 is=>'rw',
41916570 135 isa=>ClassName,
2ce6e9a6 136 default=>'DBIx::Class::Storage::DBI::Replicated::Pool',
64cdad22 137 handles=>{
138 'create_pool' => 'new',
139 },
2bf79155 140);
141
f068a139 142=head2 pool_args
143
144Contains a hashref of initialized information to pass to the Balancer object.
212cc5c2 145See L<DBIx::Class::Storage::DBI::Replicated::Pool> for available arguments.
f068a139 146
147=cut
148
149has 'pool_args' => (
dcdf7b2c 150 is=>'rw',
41916570 151 isa=>HashRef,
64cdad22 152 lazy=>1,
64cdad22 153 default=>sub { {} },
f068a139 154);
155
156
26ab719a 157=head2 balancer_type
2bf79155 158
159The replication pool requires a balance class to provider the methods for
160choose how to spread the query load across each replicant in the pool.
161
162=cut
163
26ab719a 164has 'balancer_type' => (
dcdf7b2c 165 is=>'rw',
9901aad7 166 isa=>BalancerClassNamePart,
2ce6e9a6 167 coerce=>1,
168 required=>1,
169 default=> 'DBIx::Class::Storage::DBI::Replicated::Balancer::First',
64cdad22 170 handles=>{
171 'create_balancer' => 'new',
172 },
2bf79155 173);
174
17b05c13 175=head2 balancer_args
176
177Contains a hashref of initialized information to pass to the Balancer object.
212cc5c2 178See L<DBIx::Class::Storage::DBI::Replicated::Balancer> for available arguments.
17b05c13 179
180=cut
181
182has 'balancer_args' => (
dcdf7b2c 183 is=>'rw',
41916570 184 isa=>HashRef,
64cdad22 185 lazy=>1,
186 required=>1,
187 default=>sub { {} },
17b05c13 188);
189
26ab719a 190=head2 pool
2bf79155 191
370f78d4 192Is a L<DBIx::Class::Storage::DBI::Replicated::Pool> or derived class. This is a
26ab719a 193container class for one or more replicated databases.
2bf79155 194
195=cut
196
26ab719a 197has 'pool' => (
64cdad22 198 is=>'ro',
199 isa=>'DBIx::Class::Storage::DBI::Replicated::Pool',
200 lazy_build=>1,
201 handles=>[qw/
6f7344b8 202 connect_replicants
64cdad22 203 replicants
204 has_replicants
205 /],
2bf79155 206);
207
26ab719a 208=head2 balancer
2bf79155 209
370f78d4 210Is a L<DBIx::Class::Storage::DBI::Replicated::Balancer> or derived class. This
211is a class that takes a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>)
2bf79155 212
26ab719a 213=cut
2bf79155 214
26ab719a 215has 'balancer' => (
dcdf7b2c 216 is=>'rw',
64cdad22 217 isa=>'DBIx::Class::Storage::DBI::Replicated::Balancer',
218 lazy_build=>1,
219 handles=>[qw/auto_validate_every/],
26ab719a 220);
2bf79155 221
cb6ec758 222=head2 master
223
224The master defines the canonical state for a pool of connected databases. All
225the replicants are expected to match this databases state. Thus, in a classic
226Master / Slaves distributed system, all the slaves are expected to replicate
227the Master's state as quick as possible. This is the only database in the
228pool of databases that is allowed to handle write traffic.
229
230=cut
231
232has 'master' => (
64cdad22 233 is=> 'ro',
6a151f58 234 isa=>DBICStorageDBI,
64cdad22 235 lazy_build=>1,
cb6ec758 236);
237
cb6ec758 238=head1 ATTRIBUTES IMPLEMENTING THE DBIx::Storage::DBI INTERFACE
239
fd323bf1 240The following methods are delegated all the methods required for the
cb6ec758 241L<DBIx::Class::Storage::DBI> interface.
242
243=head2 read_handler
244
245Defines an object that implements the read side of L<BIx::Class::Storage::DBI>.
246
247=cut
248
249has 'read_handler' => (
64cdad22 250 is=>'rw',
41916570 251 isa=>Object,
64cdad22 252 lazy_build=>1,
253 handles=>[qw/
254 select
255 select_single
256 columns_info_for
fd323bf1 257 _dbh_columns_info_for
3244fdcc 258 _select
6f7344b8 259 /],
cb6ec758 260);
261
cb6ec758 262=head2 write_handler
263
3244fdcc 264Defines an object that implements the write side of L<BIx::Class::Storage::DBI>,
265as well as methods that don't write or read that can be called on only one
266storage, methods that return a C<$dbh>, and any methods that don't make sense to
267run on a replicant.
cb6ec758 268
269=cut
270
271has 'write_handler' => (
64cdad22 272 is=>'ro',
41916570 273 isa=>Object,
64cdad22 274 lazy_build=>1,
6f7344b8 275 handles=>[qw/
64cdad22 276 on_connect_do
6f7344b8 277 on_disconnect_do
3244fdcc 278 on_connect_call
279 on_disconnect_call
64cdad22 280 connect_info
3244fdcc 281 _connect_info
64cdad22 282 throw_exception
283 sql_maker
284 sqlt_type
285 create_ddl_dir
286 deployment_statements
287 datetime_parser
6f7344b8 288 datetime_parser_type
289 build_datetime_parser
64cdad22 290 last_insert_id
291 insert
292 insert_bulk
293 update
294 delete
295 dbh
2ce6e9a6 296 txn_begin
64cdad22 297 txn_do
298 txn_commit
299 txn_rollback
2ce6e9a6 300 txn_scope_guard
64cdad22 301 sth
302 deploy
0180bef9 303 with_deferred_fk_checks
6f7344b8 304 dbh_do
64cdad22 305 reload_row
6f7344b8 306 with_deferred_fk_checks
2ce6e9a6 307 _prep_for_execute
7fb60fb1 308
6f7344b8 309 backup
310 is_datatype_numeric
311 _count_select
6f7344b8 312 _subq_update_delete
313 svp_rollback
314 svp_begin
315 svp_release
e398f77e 316 relname_to_table_alias
3244fdcc 317 _dbh_last_insert_id
318 _fix_bind_params
319 _default_dbi_connect_attributes
320 _dbi_connect_info
b9ca4ff1 321 _dbic_connect_attributes
3244fdcc 322 auto_savepoint
323 _sqlt_version_ok
324 _query_end
325 bind_attribute_by_data_type
326 transaction_depth
327 _dbh
328 _select_args
329 _dbh_execute_array
3244fdcc 330 _sql_maker
331 _query_start
332 _sqlt_version_error
333 _per_row_update_delete
334 _dbh_begin_work
335 _dbh_execute_inserts_with_no_binds
336 _select_args_to_query
337 _svp_generate_name
338 _multipk_update_delete
339 source_bind_attributes
340 _normalize_connect_info
341 _parse_connect_do
342 _dbh_commit
343 _execute_array
3244fdcc 344 savepoints
345 _sqlt_minimum_version
346 _sql_maker_opts
347 _conn_pid
3244fdcc 348 _conn_tid
349 _dbh_autocommit
350 _native_data_type
351 _get_dbh
352 sql_maker_class
353 _dbh_rollback
354 _adjust_select_args_for_complex_prefetch
355 _resolve_ident_sources
356 _resolve_column_info
357 _prune_unused_joins
358 _strip_cond_qualifiers
7d3139ac 359 _extract_order_columns
3244fdcc 360 _resolve_aliastypes_from_select_args
361 _execute
362 _do_query
363 _dbh_sth
364 _dbh_execute
6ed1cd2e 365 _prefetch_insert_auto_nextvals
64cdad22 366 /],
cb6ec758 367);
368
e471ab87 369my @unimplemented = qw(
370 _arm_global_destructor
371 _preserve_foreign_dbh
572338e0 372 _verify_pid
373 _verify_tid
bbdda281 374
375 get_use_dbms_capability
376 set_use_dbms_capability
377 get_dbms_capability
378 set_dbms_capability
bbdda281 379 _dbh_details
380
7f4433eb 381 sql_limit_dialect
31a8aaaf 382
383 _inner_join_to_node
0a3441ee 384 _group_over_selection
e471ab87 385);
386
7f4433eb 387# the capability framework
388# not sure if CMOP->initialize does evil things to DBIC::S::DBI, fix if a problem
389push @unimplemented, ( grep
390 { $_ =~ /^ _ (?: use | supports | determine_supports ) _ /x }
391 ( Class::MOP::Class->initialize('DBIx::Class::Storage::DBI')->get_all_method_names )
392);
393
e471ab87 394for my $method (@unimplemented) {
395 __PACKAGE__->meta->add_method($method, sub {
396 croak "$method must not be called on ".(blessed shift).' objects';
397 });
398}
6d766626 399
b2e4d522 400has _master_connect_info_opts =>
401 (is => 'rw', isa => HashRef, default => sub { {} });
402
403=head2 around: connect_info
404
48580715 405Preserves master's C<connect_info> options (for merging with replicants.)
406Also sets any Replicated-related options from connect_info, such as
dcdf7b2c 407C<pool_type>, C<pool_args>, C<balancer_type> and C<balancer_args>.
b2e4d522 408
409=cut
410
411around connect_info => sub {
412 my ($next, $self, $info, @extra) = @_;
413
0ce2d0d5 414 my $wantarray = wantarray;
415
282a9a4f 416 my $merge = Hash::Merge->new('LEFT_PRECEDENT');
e666c5fd 417
b2e4d522 418 my %opts;
419 for my $arg (@$info) {
420 next unless (reftype($arg)||'') eq 'HASH';
e666c5fd 421 %opts = %{ $merge->merge($arg, \%opts) };
b2e4d522 422 }
b2e4d522 423 delete $opts{dsn};
424
dcdf7b2c 425 if (@opts{qw/pool_type pool_args/}) {
426 $self->pool_type(delete $opts{pool_type})
427 if $opts{pool_type};
428
b88b85e7 429 $self->pool_args(
e666c5fd 430 $merge->merge((delete $opts{pool_args} || {}), $self->pool_args)
b88b85e7 431 );
dcdf7b2c 432
64ae1667 433 ## Since we possibly changed the pool_args, we need to clear the current
434 ## pool object so that next time it is used it will be rebuilt.
435 $self->clear_pool;
dcdf7b2c 436 }
437
438 if (@opts{qw/balancer_type balancer_args/}) {
439 $self->balancer_type(delete $opts{balancer_type})
440 if $opts{balancer_type};
441
b88b85e7 442 $self->balancer_args(
e666c5fd 443 $merge->merge((delete $opts{balancer_args} || {}), $self->balancer_args)
b88b85e7 444 );
dcdf7b2c 445
67c43863 446 $self->balancer($self->_build_balancer)
6f7344b8 447 if $self->balancer;
dcdf7b2c 448 }
449
b2e4d522 450 $self->_master_connect_info_opts(\%opts);
451
0ce2d0d5 452 my (@res, $res);
453 if ($wantarray) {
454 @res = $self->$next($info, @extra);
455 } else {
456 $res = $self->$next($info, @extra);
457 }
458
fd4eb9c2 459 # Make sure master is blessed into the correct class and apply role to it.
460 my $master = $self->master;
461 $master->_determine_driver;
462 Moose::Meta::Class->initialize(ref $master);
cea43436 463
ec0946db 464 DBIx::Class::Storage::DBI::Replicated::WithDSN->meta->apply($master);
cea43436 465
466 # link pool back to master
467 $self->pool->master($master);
0ce2d0d5 468
469 $wantarray ? @res : $res;
b2e4d522 470};
471
26ab719a 472=head1 METHODS
2bf79155 473
26ab719a 474This class defines the following methods.
2bf79155 475
c354902c 476=head2 BUILDARGS
2bf79155 477
faaba25f 478L<DBIx::Class::Schema> when instantiating its storage passed itself as the
2ce6e9a6 479first argument. So we need to massage the arguments a bit so that all the
480bits get put into the correct places.
2bf79155 481
482=cut
483
c354902c 484sub BUILDARGS {
fd323bf1 485 my ($class, $schema, $storage_type_args, @args) = @_;
d4daee7b 486
c354902c 487 return {
6f7344b8 488 schema=>$schema,
489 %$storage_type_args,
490 @args
c354902c 491 }
492}
2bf79155 493
cb6ec758 494=head2 _build_master
2bf79155 495
cb6ec758 496Lazy builder for the L</master> attribute.
2bf79155 497
498=cut
499
cb6ec758 500sub _build_master {
2ce6e9a6 501 my $self = shift @_;
ee356d00 502 my $master = DBIx::Class::Storage::DBI->new($self->schema);
ee356d00 503 $master
106d5f3b 504}
505
26ab719a 506=head2 _build_pool
2bf79155 507
26ab719a 508Lazy builder for the L</pool> attribute.
2bf79155 509
510=cut
511
26ab719a 512sub _build_pool {
64cdad22 513 my $self = shift @_;
514 $self->create_pool(%{$self->pool_args});
2bf79155 515}
516
26ab719a 517=head2 _build_balancer
2bf79155 518
cb6ec758 519Lazy builder for the L</balancer> attribute. This takes a Pool object so that
520the balancer knows which pool it's balancing.
2bf79155 521
522=cut
523
26ab719a 524sub _build_balancer {
64cdad22 525 my $self = shift @_;
526 $self->create_balancer(
6f7344b8 527 pool=>$self->pool,
64cdad22 528 master=>$self->master,
529 %{$self->balancer_args},
530 );
2bf79155 531}
532
cb6ec758 533=head2 _build_write_handler
2bf79155 534
cb6ec758 535Lazy builder for the L</write_handler> attribute. The default is to set this to
536the L</master>.
50336325 537
538=cut
539
cb6ec758 540sub _build_write_handler {
64cdad22 541 return shift->master;
cb6ec758 542}
50336325 543
cb6ec758 544=head2 _build_read_handler
2bf79155 545
cb6ec758 546Lazy builder for the L</read_handler> attribute. The default is to set this to
547the L</balancer>.
2bf79155 548
549=cut
550
cb6ec758 551sub _build_read_handler {
64cdad22 552 return shift->balancer;
cb6ec758 553}
50336325 554
cb6ec758 555=head2 around: connect_replicants
2bf79155 556
cb6ec758 557All calls to connect_replicants needs to have an existing $schema tacked onto
b2e4d522 558top of the args, since L<DBIx::Storage::DBI> needs it, and any C<connect_info>
559options merged with the master, with replicant opts having higher priority.
955a6df6 560
cb6ec758 561=cut
955a6df6 562
b2e4d522 563around connect_replicants => sub {
564 my ($next, $self, @args) = @_;
565
566 for my $r (@args) {
567 $r = [ $r ] unless reftype $r eq 'ARRAY';
568
1a58752c 569 $self->throw_exception('coderef replicant connect_info not supported')
b2e4d522 570 if ref $r->[0] && reftype $r->[0] eq 'CODE';
571
572# any connect_info options?
573 my $i = 0;
574 $i++ while $i < @$r && (reftype($r->[$i])||'') ne 'HASH';
575
6f7344b8 576# make one if none
b2e4d522 577 $r->[$i] = {} unless $r->[$i];
578
579# merge if two hashes
b88b85e7 580 my @hashes = @$r[$i .. $#{$r}];
581
1a58752c 582 $self->throw_exception('invalid connect_info options')
b88b85e7 583 if (grep { reftype($_) eq 'HASH' } @hashes) != @hashes;
584
1a58752c 585 $self->throw_exception('too many hashrefs in connect_info')
b88b85e7 586 if @hashes > 2;
587
282a9a4f 588 my $merge = Hash::Merge->new('LEFT_PRECEDENT');
e666c5fd 589 my %opts = %{ $merge->merge(reverse @hashes) };
b88b85e7 590
591# delete them
b2e4d522 592 splice @$r, $i+1, ($#{$r} - $i), ();
593
0bd8e058 594# make sure master/replicants opts don't clash
595 my %master_opts = %{ $self->_master_connect_info_opts };
596 if (exists $opts{dbh_maker}) {
597 delete @master_opts{qw/dsn user password/};
598 }
599 delete $master_opts{dbh_maker};
600
b2e4d522 601# merge with master
e666c5fd 602 %opts = %{ $merge->merge(\%opts, \%master_opts) };
b2e4d522 603
604# update
605 $r->[$i] = \%opts;
606 }
607
608 $self->$next($self->schema, @args);
955a6df6 609};
2bf79155 610
2bf79155 611=head2 all_storages
612
613Returns an array of of all the connected storage backends. The first element
614in the returned array is the master, and the remainings are each of the
615replicants.
616
617=cut
618
619sub all_storages {
64cdad22 620 my $self = shift @_;
621 return grep {defined $_ && blessed $_} (
622 $self->master,
6412a592 623 values %{ $self->replicants },
64cdad22 624 );
2bf79155 625}
626
c4d3fae2 627=head2 execute_reliably ($coderef, ?@args)
628
629Given a coderef, saves the current state of the L</read_handler>, forces it to
48580715 630use reliable storage (e.g. sets it to the master), executes a coderef and then
c4d3fae2 631restores the original state.
632
633Example:
634
64cdad22 635 my $reliably = sub {
636 my $name = shift @_;
637 $schema->resultset('User')->create({name=>$name});
fd323bf1 638 my $user_rs = $schema->resultset('User')->find({name=>$name});
64cdad22 639 return $user_rs;
640 };
c4d3fae2 641
64cdad22 642 my $user_rs = $schema->storage->execute_reliably($reliably, 'John');
c4d3fae2 643
644Use this when you must be certain of your database state, such as when you just
645inserted something and need to get a resultset including it, etc.
646
647=cut
648
649sub execute_reliably {
64cdad22 650 my ($self, $coderef, @args) = @_;
d4daee7b 651
64cdad22 652 unless( ref $coderef eq 'CODE') {
653 $self->throw_exception('Second argument must be a coderef');
654 }
d4daee7b 655
64cdad22 656 ##Get copy of master storage
657 my $master = $self->master;
d4daee7b 658
64cdad22 659 ##Get whatever the current read hander is
660 my $current = $self->read_handler;
d4daee7b 661
64cdad22 662 ##Set the read handler to master
663 $self->read_handler($master);
d4daee7b 664
64cdad22 665 ## do whatever the caller needs
666 my @result;
667 my $want_array = wantarray;
d4daee7b 668
ed7ab0f4 669 try {
64cdad22 670 if($want_array) {
671 @result = $coderef->(@args);
672 } elsif(defined $want_array) {
673 ($result[0]) = ($coderef->(@args));
ed213e85 674 } else {
64cdad22 675 $coderef->(@args);
6f7344b8 676 }
ed7ab0f4 677 } catch {
678 $self->throw_exception("coderef returned an error: $_");
679 } finally {
680 ##Reset to the original state
681 $self->read_handler($current);
64cdad22 682 };
d4daee7b 683
ed7ab0f4 684 return $want_array ? @result : $result[0];
c4d3fae2 685}
686
cb6ec758 687=head2 set_reliable_storage
688
689Sets the current $schema to be 'reliable', that is all queries, both read and
690write are sent to the master
d4daee7b 691
cb6ec758 692=cut
693
694sub set_reliable_storage {
64cdad22 695 my $self = shift @_;
696 my $schema = $self->schema;
697 my $write_handler = $self->schema->storage->write_handler;
d4daee7b 698
64cdad22 699 $schema->storage->read_handler($write_handler);
cb6ec758 700}
701
702=head2 set_balanced_storage
703
704Sets the current $schema to be use the </balancer> for all reads, while all
48580715 705writes are sent to the master only
d4daee7b 706
cb6ec758 707=cut
708
709sub set_balanced_storage {
64cdad22 710 my $self = shift @_;
711 my $schema = $self->schema;
bd5da369 712 my $balanced_handler = $self->schema->storage->balancer;
d4daee7b 713
bd5da369 714 $schema->storage->read_handler($balanced_handler);
cb6ec758 715}
2bf79155 716
717=head2 connected
718
719Check that the master and at least one of the replicants is connected.
720
721=cut
722
723sub connected {
64cdad22 724 my $self = shift @_;
725 return
726 $self->master->connected &&
727 $self->pool->connected_replicants;
2bf79155 728}
729
2bf79155 730=head2 ensure_connected
731
732Make sure all the storages are connected.
733
734=cut
735
736sub ensure_connected {
64cdad22 737 my $self = shift @_;
738 foreach my $source ($self->all_storages) {
739 $source->ensure_connected(@_);
740 }
2bf79155 741}
742
2bf79155 743=head2 limit_dialect
744
745Set the limit_dialect for all existing storages
746
747=cut
748
749sub limit_dialect {
64cdad22 750 my $self = shift @_;
751 foreach my $source ($self->all_storages) {
752 $source->limit_dialect(@_);
753 }
f3e9f010 754 return $self->master->limit_dialect;
2bf79155 755}
756
2bf79155 757=head2 quote_char
758
759Set the quote_char for all existing storages
760
761=cut
762
763sub quote_char {
64cdad22 764 my $self = shift @_;
765 foreach my $source ($self->all_storages) {
766 $source->quote_char(@_);
767 }
3fbe08e3 768 return $self->master->quote_char;
2bf79155 769}
770
2bf79155 771=head2 name_sep
772
773Set the name_sep for all existing storages
774
775=cut
776
777sub name_sep {
64cdad22 778 my $self = shift @_;
779 foreach my $source ($self->all_storages) {
780 $source->name_sep(@_);
781 }
3fbe08e3 782 return $self->master->name_sep;
2bf79155 783}
784
2bf79155 785=head2 set_schema
786
787Set the schema object for all existing storages
788
789=cut
790
791sub set_schema {
64cdad22 792 my $self = shift @_;
793 foreach my $source ($self->all_storages) {
794 $source->set_schema(@_);
795 }
2bf79155 796}
797
2bf79155 798=head2 debug
799
800set a debug flag across all storages
801
802=cut
803
804sub debug {
64cdad22 805 my $self = shift @_;
3fbe08e3 806 if(@_) {
807 foreach my $source ($self->all_storages) {
808 $source->debug(@_);
6f7344b8 809 }
64cdad22 810 }
3fbe08e3 811 return $self->master->debug;
2bf79155 812}
813
2bf79155 814=head2 debugobj
815
cea43436 816set a debug object
2bf79155 817
818=cut
819
820sub debugobj {
64cdad22 821 my $self = shift @_;
cea43436 822 return $self->master->debugobj(@_);
2bf79155 823}
824
2bf79155 825=head2 debugfh
826
cea43436 827set a debugfh object
2bf79155 828
829=cut
830
831sub debugfh {
64cdad22 832 my $self = shift @_;
cea43436 833 return $self->master->debugfh(@_);
2bf79155 834}
835
2bf79155 836=head2 debugcb
837
cea43436 838set a debug callback
2bf79155 839
840=cut
841
842sub debugcb {
64cdad22 843 my $self = shift @_;
cea43436 844 return $self->master->debugcb(@_);
2bf79155 845}
846
2bf79155 847=head2 disconnect
848
849disconnect everything
850
851=cut
852
853sub disconnect {
64cdad22 854 my $self = shift @_;
855 foreach my $source ($self->all_storages) {
856 $source->disconnect(@_);
857 }
2bf79155 858}
859
b2e4d522 860=head2 cursor_class
861
862set cursor class on all storages, or return master's
863
864=cut
865
866sub cursor_class {
867 my ($self, $cursor_class) = @_;
868
869 if ($cursor_class) {
870 $_->cursor_class($cursor_class) for $self->all_storages;
871 }
872 $self->master->cursor_class;
873}
d4daee7b 874
3244fdcc 875=head2 cursor
876
877set cursor class on all storages, or return master's, alias for L</cursor_class>
878above.
879
880=cut
881
882sub cursor {
883 my ($self, $cursor_class) = @_;
884
885 if ($cursor_class) {
886 $_->cursor($cursor_class) for $self->all_storages;
887 }
888 $self->master->cursor;
889}
890
891=head2 unsafe
892
893sets the L<DBIx::Class::Storage::DBI/unsafe> option on all storages or returns
894master's current setting
895
896=cut
897
898sub unsafe {
899 my $self = shift;
900
901 if (@_) {
902 $_->unsafe(@_) for $self->all_storages;
903 }
904
905 return $self->master->unsafe;
906}
907
908=head2 disable_sth_caching
909
910sets the L<DBIx::Class::Storage::DBI/disable_sth_caching> option on all storages
911or returns master's current setting
912
913=cut
914
915sub disable_sth_caching {
916 my $self = shift;
917
918 if (@_) {
919 $_->disable_sth_caching(@_) for $self->all_storages;
920 }
921
922 return $self->master->disable_sth_caching;
923}
924
925=head2 lag_behind_master
926
927returns the highest Replicant L<DBIx::Class::Storage::DBI/lag_behind_master>
928setting
929
930=cut
931
932sub lag_behind_master {
933 my $self = shift;
934
935 return max map $_->lag_behind_master, $self->replicants;
fd323bf1 936}
3244fdcc 937
938=head2 is_replicating
939
940returns true if all replicants return true for
941L<DBIx::Class::Storage::DBI/is_replicating>
942
943=cut
944
945sub is_replicating {
946 my $self = shift;
947
948 return (grep $_->is_replicating, $self->replicants) == ($self->replicants);
949}
950
951=head2 connect_call_datetime_setup
952
953calls L<DBIx::Class::Storage::DBI/connect_call_datetime_setup> for all storages
954
955=cut
956
957sub connect_call_datetime_setup {
958 my $self = shift;
959 $_->connect_call_datetime_setup for $self->all_storages;
960}
961
962sub _populate_dbh {
963 my $self = shift;
964 $_->_populate_dbh for $self->all_storages;
965}
966
967sub _connect {
968 my $self = shift;
969 $_->_connect for $self->all_storages;
970}
971
972sub _rebless {
973 my $self = shift;
974 $_->_rebless for $self->all_storages;
975}
976
977sub _determine_driver {
978 my $self = shift;
979 $_->_determine_driver for $self->all_storages;
980}
981
982sub _driver_determined {
983 my $self = shift;
fd323bf1 984
3244fdcc 985 if (@_) {
986 $_->_driver_determined(@_) for $self->all_storages;
987 }
988
989 return $self->master->_driver_determined;
990}
991
992sub _init {
993 my $self = shift;
fd323bf1 994
3244fdcc 995 $_->_init for $self->all_storages;
996}
997
998sub _run_connection_actions {
999 my $self = shift;
fd323bf1 1000
3244fdcc 1001 $_->_run_connection_actions for $self->all_storages;
1002}
1003
1004sub _do_connection_actions {
1005 my $self = shift;
fd323bf1 1006
3244fdcc 1007 if (@_) {
1008 $_->_do_connection_actions(@_) for $self->all_storages;
1009 }
1010}
1011
1012sub connect_call_do_sql {
1013 my $self = shift;
1014 $_->connect_call_do_sql(@_) for $self->all_storages;
1015}
1016
1017sub disconnect_call_do_sql {
1018 my $self = shift;
1019 $_->disconnect_call_do_sql(@_) for $self->all_storages;
1020}
1021
1022sub _seems_connected {
1023 my $self = shift;
1024
1025 return min map $_->_seems_connected, $self->all_storages;
1026}
1027
1028sub _ping {
1029 my $self = shift;
1030
1031 return min map $_->_ping, $self->all_storages;
1032}
1033
bbdda281 1034# not using the normalized_version, because we want to preserve
1035# version numbers much longer than the conventional xxx.yyyzzz
7da56142 1036my $numify_ver = sub {
1037 my $ver = shift;
1038 my @numparts = split /\D+/, $ver;
bbdda281 1039 my $format = '%d.' . (join '', ('%06d') x (@numparts - 1));
7da56142 1040
1041 return sprintf $format, @numparts;
1042};
fecb38cb 1043sub _server_info {
1044 my $self = shift;
1045
bbdda281 1046 if (not $self->_dbh_details->{info}) {
1047 $self->_dbh_details->{info} = (
fd323bf1 1048 reduce { $a->[0] < $b->[0] ? $a : $b }
7da56142 1049 map [ $numify_ver->($_->{dbms_version}), $_ ],
1050 map $_->_server_info, $self->all_storages
1051 )->[1];
fecb38cb 1052 }
1053
bbdda281 1054 return $self->next::method;
fecb38cb 1055}
1056
1057sub _get_server_version {
1058 my $self = shift;
1059
1060 return $self->_server_info->{dbms_version};
1061}
1062
7e38d850 1063=head1 GOTCHAS
1064
1065Due to the fact that replicants can lag behind a master, you must take care to
1066make sure you use one of the methods to force read queries to a master should
1067you need realtime data integrity. For example, if you insert a row, and then
1068immediately re-read it from the database (say, by doing $row->discard_changes)
1069or you insert a row and then immediately build a query that expects that row
1070to be an item, you should force the master to handle reads. Otherwise, due to
1071the lag, there is no certainty your data will be in the expected state.
1072
1073For data integrity, all transactions automatically use the master storage for
1074all read and write queries. Using a transaction is the preferred and recommended
1075method to force the master to handle all read queries.
1076
1077Otherwise, you can force a single query to use the master with the 'force_pool'
1078attribute:
1079
1080 my $row = $resultset->search(undef, {force_pool=>'master'})->find($pk);
1081
1082This attribute will safely be ignore by non replicated storages, so you can use
1083the same code for both types of systems.
1084
1085Lastly, you can use the L</execute_reliably> method, which works very much like
1086a transaction.
1087
1088For debugging, you can turn replication on/off with the methods L</set_reliable_storage>
1089and L</set_balanced_storage>, however this operates at a global level and is not
1090suitable if you have a shared Schema object being used by multiple processes,
1091such as on a web application server. You can get around this limitation by
1092using the Schema clone method.
1093
1094 my $new_schema = $schema->clone;
1095 $new_schema->set_reliable_storage;
d4daee7b 1096
7e38d850 1097 ## $new_schema will use only the Master storage for all reads/writes while
1098 ## the $schema object will use replicated storage.
1099
f5d3a5de 1100=head1 AUTHOR
1101
64cdad22 1102 John Napiorkowski <john.napiorkowski@takkle.com>
f5d3a5de 1103
c4d3fae2 1104Based on code originated by:
f5d3a5de 1105
64cdad22 1106 Norbert Csongrádi <bert@cpan.org>
1107 Peter Siklósi <einon@einon.hu>
2156bbdd 1108
f5d3a5de 1109=head1 LICENSE
1110
1111You may distribute this code under the same terms as Perl itself.
1112
1113=cut
1114
c354902c 1115__PACKAGE__->meta->make_immutable;
1116
f5d3a5de 11171;