Fixed: RS example code was broken
[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 _dbh_autocommit
349 _native_data_type
350 _get_dbh
351 sql_maker_class
352 _dbh_rollback
353 _adjust_select_args_for_complex_prefetch
354 _resolve_ident_sources
355 _resolve_column_info
356 _prune_unused_joins
357 _strip_cond_qualifiers
3244fdcc 358 _resolve_aliastypes_from_select_args
359 _execute
360 _do_query
361 _dbh_sth
362 _dbh_execute
64cdad22 363 /],
cb6ec758 364);
365
e471ab87 366my @unimplemented = qw(
367 _arm_global_destructor
572338e0 368 _verify_pid
bbdda281 369
370 get_use_dbms_capability
371 set_use_dbms_capability
372 get_dbms_capability
373 set_dbms_capability
bbdda281 374 _dbh_details
584ea6e4 375 _dbh_get_info
bbdda281 376
7f4433eb 377 sql_limit_dialect
e989099b 378 sql_quote_char
379 sql_name_sep
31a8aaaf 380
381 _inner_join_to_node
0a3441ee 382 _group_over_selection
bac358c9 383 _extract_order_criteria
584ea6e4 384
385 _prefetch_autovalues
386
bf51641f 387 _max_column_bytesize
153a0398 388 _is_lob_type
8138f96a 389 _is_binary_lob_type
390 _is_text_lob_type
e471ab87 391);
392
7f4433eb 393# the capability framework
394# not sure if CMOP->initialize does evil things to DBIC::S::DBI, fix if a problem
395push @unimplemented, ( grep
396 { $_ =~ /^ _ (?: use | supports | determine_supports ) _ /x }
397 ( Class::MOP::Class->initialize('DBIx::Class::Storage::DBI')->get_all_method_names )
398);
399
e471ab87 400for my $method (@unimplemented) {
401 __PACKAGE__->meta->add_method($method, sub {
402 croak "$method must not be called on ".(blessed shift).' objects';
403 });
404}
6d766626 405
b2e4d522 406has _master_connect_info_opts =>
407 (is => 'rw', isa => HashRef, default => sub { {} });
408
409=head2 around: connect_info
410
48580715 411Preserves master's C<connect_info> options (for merging with replicants.)
412Also sets any Replicated-related options from connect_info, such as
dcdf7b2c 413C<pool_type>, C<pool_args>, C<balancer_type> and C<balancer_args>.
b2e4d522 414
415=cut
416
417around connect_info => sub {
418 my ($next, $self, $info, @extra) = @_;
419
282a9a4f 420 my $merge = Hash::Merge->new('LEFT_PRECEDENT');
e666c5fd 421
b2e4d522 422 my %opts;
423 for my $arg (@$info) {
424 next unless (reftype($arg)||'') eq 'HASH';
e666c5fd 425 %opts = %{ $merge->merge($arg, \%opts) };
b2e4d522 426 }
b2e4d522 427 delete $opts{dsn};
428
dcdf7b2c 429 if (@opts{qw/pool_type pool_args/}) {
430 $self->pool_type(delete $opts{pool_type})
431 if $opts{pool_type};
432
b88b85e7 433 $self->pool_args(
e666c5fd 434 $merge->merge((delete $opts{pool_args} || {}), $self->pool_args)
b88b85e7 435 );
dcdf7b2c 436
64ae1667 437 ## Since we possibly changed the pool_args, we need to clear the current
438 ## pool object so that next time it is used it will be rebuilt.
439 $self->clear_pool;
dcdf7b2c 440 }
441
442 if (@opts{qw/balancer_type balancer_args/}) {
443 $self->balancer_type(delete $opts{balancer_type})
444 if $opts{balancer_type};
445
b88b85e7 446 $self->balancer_args(
e666c5fd 447 $merge->merge((delete $opts{balancer_args} || {}), $self->balancer_args)
b88b85e7 448 );
dcdf7b2c 449
67c43863 450 $self->balancer($self->_build_balancer)
6f7344b8 451 if $self->balancer;
dcdf7b2c 452 }
453
b2e4d522 454 $self->_master_connect_info_opts(\%opts);
455
cca282b6 456 my @res;
457 if (wantarray) {
0ce2d0d5 458 @res = $self->$next($info, @extra);
459 } else {
cca282b6 460 $res[0] = $self->$next($info, @extra);
0ce2d0d5 461 }
462
fd4eb9c2 463 # Make sure master is blessed into the correct class and apply role to it.
464 my $master = $self->master;
465 $master->_determine_driver;
466 Moose::Meta::Class->initialize(ref $master);
cea43436 467
ec0946db 468 DBIx::Class::Storage::DBI::Replicated::WithDSN->meta->apply($master);
cea43436 469
470 # link pool back to master
471 $self->pool->master($master);
0ce2d0d5 472
cca282b6 473 wantarray ? @res : $res[0];
b2e4d522 474};
475
26ab719a 476=head1 METHODS
2bf79155 477
26ab719a 478This class defines the following methods.
2bf79155 479
c354902c 480=head2 BUILDARGS
2bf79155 481
faaba25f 482L<DBIx::Class::Schema> when instantiating its storage passed itself as the
2ce6e9a6 483first argument. So we need to massage the arguments a bit so that all the
484bits get put into the correct places.
2bf79155 485
486=cut
487
c354902c 488sub BUILDARGS {
fd323bf1 489 my ($class, $schema, $storage_type_args, @args) = @_;
d4daee7b 490
c354902c 491 return {
6f7344b8 492 schema=>$schema,
493 %$storage_type_args,
494 @args
c354902c 495 }
496}
2bf79155 497
cb6ec758 498=head2 _build_master
2bf79155 499
cb6ec758 500Lazy builder for the L</master> attribute.
2bf79155 501
502=cut
503
cb6ec758 504sub _build_master {
2ce6e9a6 505 my $self = shift @_;
ee356d00 506 my $master = DBIx::Class::Storage::DBI->new($self->schema);
ee356d00 507 $master
106d5f3b 508}
509
26ab719a 510=head2 _build_pool
2bf79155 511
26ab719a 512Lazy builder for the L</pool> attribute.
2bf79155 513
514=cut
515
26ab719a 516sub _build_pool {
64cdad22 517 my $self = shift @_;
518 $self->create_pool(%{$self->pool_args});
2bf79155 519}
520
26ab719a 521=head2 _build_balancer
2bf79155 522
cb6ec758 523Lazy builder for the L</balancer> attribute. This takes a Pool object so that
524the balancer knows which pool it's balancing.
2bf79155 525
526=cut
527
26ab719a 528sub _build_balancer {
64cdad22 529 my $self = shift @_;
530 $self->create_balancer(
6f7344b8 531 pool=>$self->pool,
64cdad22 532 master=>$self->master,
533 %{$self->balancer_args},
534 );
2bf79155 535}
536
cb6ec758 537=head2 _build_write_handler
2bf79155 538
cb6ec758 539Lazy builder for the L</write_handler> attribute. The default is to set this to
540the L</master>.
50336325 541
542=cut
543
cb6ec758 544sub _build_write_handler {
64cdad22 545 return shift->master;
cb6ec758 546}
50336325 547
cb6ec758 548=head2 _build_read_handler
2bf79155 549
cb6ec758 550Lazy builder for the L</read_handler> attribute. The default is to set this to
551the L</balancer>.
2bf79155 552
553=cut
554
cb6ec758 555sub _build_read_handler {
64cdad22 556 return shift->balancer;
cb6ec758 557}
50336325 558
cb6ec758 559=head2 around: connect_replicants
2bf79155 560
cb6ec758 561All calls to connect_replicants needs to have an existing $schema tacked onto
b2e4d522 562top of the args, since L<DBIx::Storage::DBI> needs it, and any C<connect_info>
563options merged with the master, with replicant opts having higher priority.
955a6df6 564
cb6ec758 565=cut
955a6df6 566
b2e4d522 567around connect_replicants => sub {
568 my ($next, $self, @args) = @_;
569
570 for my $r (@args) {
571 $r = [ $r ] unless reftype $r eq 'ARRAY';
572
1a58752c 573 $self->throw_exception('coderef replicant connect_info not supported')
b2e4d522 574 if ref $r->[0] && reftype $r->[0] eq 'CODE';
575
576# any connect_info options?
577 my $i = 0;
578 $i++ while $i < @$r && (reftype($r->[$i])||'') ne 'HASH';
579
6f7344b8 580# make one if none
b2e4d522 581 $r->[$i] = {} unless $r->[$i];
582
583# merge if two hashes
b88b85e7 584 my @hashes = @$r[$i .. $#{$r}];
585
1a58752c 586 $self->throw_exception('invalid connect_info options')
b88b85e7 587 if (grep { reftype($_) eq 'HASH' } @hashes) != @hashes;
588
1a58752c 589 $self->throw_exception('too many hashrefs in connect_info')
b88b85e7 590 if @hashes > 2;
591
282a9a4f 592 my $merge = Hash::Merge->new('LEFT_PRECEDENT');
e666c5fd 593 my %opts = %{ $merge->merge(reverse @hashes) };
b88b85e7 594
595# delete them
b2e4d522 596 splice @$r, $i+1, ($#{$r} - $i), ();
597
0bd8e058 598# make sure master/replicants opts don't clash
599 my %master_opts = %{ $self->_master_connect_info_opts };
600 if (exists $opts{dbh_maker}) {
601 delete @master_opts{qw/dsn user password/};
602 }
603 delete $master_opts{dbh_maker};
604
b2e4d522 605# merge with master
e666c5fd 606 %opts = %{ $merge->merge(\%opts, \%master_opts) };
b2e4d522 607
608# update
609 $r->[$i] = \%opts;
610 }
611
612 $self->$next($self->schema, @args);
955a6df6 613};
2bf79155 614
2bf79155 615=head2 all_storages
616
617Returns an array of of all the connected storage backends. The first element
618in the returned array is the master, and the remainings are each of the
619replicants.
620
621=cut
622
623sub all_storages {
64cdad22 624 my $self = shift @_;
625 return grep {defined $_ && blessed $_} (
626 $self->master,
6412a592 627 values %{ $self->replicants },
64cdad22 628 );
2bf79155 629}
630
c4d3fae2 631=head2 execute_reliably ($coderef, ?@args)
632
633Given a coderef, saves the current state of the L</read_handler>, forces it to
48580715 634use reliable storage (e.g. sets it to the master), executes a coderef and then
c4d3fae2 635restores the original state.
636
637Example:
638
64cdad22 639 my $reliably = sub {
640 my $name = shift @_;
641 $schema->resultset('User')->create({name=>$name});
fd323bf1 642 my $user_rs = $schema->resultset('User')->find({name=>$name});
64cdad22 643 return $user_rs;
644 };
c4d3fae2 645
64cdad22 646 my $user_rs = $schema->storage->execute_reliably($reliably, 'John');
c4d3fae2 647
648Use this when you must be certain of your database state, such as when you just
649inserted something and need to get a resultset including it, etc.
650
651=cut
652
653sub execute_reliably {
64cdad22 654 my ($self, $coderef, @args) = @_;
d4daee7b 655
64cdad22 656 unless( ref $coderef eq 'CODE') {
657 $self->throw_exception('Second argument must be a coderef');
658 }
d4daee7b 659
64cdad22 660 ##Get copy of master storage
661 my $master = $self->master;
d4daee7b 662
64cdad22 663 ##Get whatever the current read hander is
664 my $current = $self->read_handler;
d4daee7b 665
64cdad22 666 ##Set the read handler to master
667 $self->read_handler($master);
d4daee7b 668
64cdad22 669 ## do whatever the caller needs
670 my @result;
671 my $want_array = wantarray;
d4daee7b 672
ed7ab0f4 673 try {
64cdad22 674 if($want_array) {
675 @result = $coderef->(@args);
676 } elsif(defined $want_array) {
677 ($result[0]) = ($coderef->(@args));
ed213e85 678 } else {
64cdad22 679 $coderef->(@args);
6f7344b8 680 }
ed7ab0f4 681 } catch {
682 $self->throw_exception("coderef returned an error: $_");
683 } finally {
684 ##Reset to the original state
685 $self->read_handler($current);
64cdad22 686 };
d4daee7b 687
cca282b6 688 return wantarray ? @result : $result[0];
c4d3fae2 689}
690
cb6ec758 691=head2 set_reliable_storage
692
693Sets the current $schema to be 'reliable', that is all queries, both read and
694write are sent to the master
d4daee7b 695
cb6ec758 696=cut
697
698sub set_reliable_storage {
64cdad22 699 my $self = shift @_;
700 my $schema = $self->schema;
701 my $write_handler = $self->schema->storage->write_handler;
d4daee7b 702
64cdad22 703 $schema->storage->read_handler($write_handler);
cb6ec758 704}
705
706=head2 set_balanced_storage
707
708Sets the current $schema to be use the </balancer> for all reads, while all
48580715 709writes are sent to the master only
d4daee7b 710
cb6ec758 711=cut
712
713sub set_balanced_storage {
64cdad22 714 my $self = shift @_;
715 my $schema = $self->schema;
bd5da369 716 my $balanced_handler = $self->schema->storage->balancer;
d4daee7b 717
bd5da369 718 $schema->storage->read_handler($balanced_handler);
cb6ec758 719}
2bf79155 720
721=head2 connected
722
723Check that the master and at least one of the replicants is connected.
724
725=cut
726
727sub connected {
64cdad22 728 my $self = shift @_;
729 return
730 $self->master->connected &&
731 $self->pool->connected_replicants;
2bf79155 732}
733
2bf79155 734=head2 ensure_connected
735
736Make sure all the storages are connected.
737
738=cut
739
740sub ensure_connected {
64cdad22 741 my $self = shift @_;
742 foreach my $source ($self->all_storages) {
743 $source->ensure_connected(@_);
744 }
2bf79155 745}
746
2bf79155 747=head2 limit_dialect
748
749Set the limit_dialect for all existing storages
750
751=cut
752
753sub limit_dialect {
64cdad22 754 my $self = shift @_;
755 foreach my $source ($self->all_storages) {
756 $source->limit_dialect(@_);
757 }
f3e9f010 758 return $self->master->limit_dialect;
2bf79155 759}
760
2bf79155 761=head2 quote_char
762
763Set the quote_char for all existing storages
764
765=cut
766
767sub quote_char {
64cdad22 768 my $self = shift @_;
769 foreach my $source ($self->all_storages) {
770 $source->quote_char(@_);
771 }
3fbe08e3 772 return $self->master->quote_char;
2bf79155 773}
774
2bf79155 775=head2 name_sep
776
777Set the name_sep for all existing storages
778
779=cut
780
781sub name_sep {
64cdad22 782 my $self = shift @_;
783 foreach my $source ($self->all_storages) {
784 $source->name_sep(@_);
785 }
3fbe08e3 786 return $self->master->name_sep;
2bf79155 787}
788
2bf79155 789=head2 set_schema
790
791Set the schema object for all existing storages
792
793=cut
794
795sub set_schema {
64cdad22 796 my $self = shift @_;
797 foreach my $source ($self->all_storages) {
798 $source->set_schema(@_);
799 }
2bf79155 800}
801
2bf79155 802=head2 debug
803
804set a debug flag across all storages
805
806=cut
807
808sub debug {
64cdad22 809 my $self = shift @_;
3fbe08e3 810 if(@_) {
811 foreach my $source ($self->all_storages) {
812 $source->debug(@_);
6f7344b8 813 }
64cdad22 814 }
3fbe08e3 815 return $self->master->debug;
2bf79155 816}
817
2bf79155 818=head2 debugobj
819
cea43436 820set a debug object
2bf79155 821
822=cut
823
824sub debugobj {
64cdad22 825 my $self = shift @_;
cea43436 826 return $self->master->debugobj(@_);
2bf79155 827}
828
2bf79155 829=head2 debugfh
830
cea43436 831set a debugfh object
2bf79155 832
833=cut
834
835sub debugfh {
64cdad22 836 my $self = shift @_;
cea43436 837 return $self->master->debugfh(@_);
2bf79155 838}
839
2bf79155 840=head2 debugcb
841
cea43436 842set a debug callback
2bf79155 843
844=cut
845
846sub debugcb {
64cdad22 847 my $self = shift @_;
cea43436 848 return $self->master->debugcb(@_);
2bf79155 849}
850
2bf79155 851=head2 disconnect
852
853disconnect everything
854
855=cut
856
857sub disconnect {
64cdad22 858 my $self = shift @_;
859 foreach my $source ($self->all_storages) {
860 $source->disconnect(@_);
861 }
2bf79155 862}
863
b2e4d522 864=head2 cursor_class
865
866set cursor class on all storages, or return master's
867
868=cut
869
870sub cursor_class {
871 my ($self, $cursor_class) = @_;
872
873 if ($cursor_class) {
874 $_->cursor_class($cursor_class) for $self->all_storages;
875 }
876 $self->master->cursor_class;
877}
d4daee7b 878
3244fdcc 879=head2 cursor
880
881set cursor class on all storages, or return master's, alias for L</cursor_class>
882above.
883
884=cut
885
886sub cursor {
887 my ($self, $cursor_class) = @_;
888
889 if ($cursor_class) {
890 $_->cursor($cursor_class) for $self->all_storages;
891 }
892 $self->master->cursor;
893}
894
895=head2 unsafe
896
897sets the L<DBIx::Class::Storage::DBI/unsafe> option on all storages or returns
898master's current setting
899
900=cut
901
902sub unsafe {
903 my $self = shift;
904
905 if (@_) {
906 $_->unsafe(@_) for $self->all_storages;
907 }
908
909 return $self->master->unsafe;
910}
911
912=head2 disable_sth_caching
913
914sets the L<DBIx::Class::Storage::DBI/disable_sth_caching> option on all storages
915or returns master's current setting
916
917=cut
918
919sub disable_sth_caching {
920 my $self = shift;
921
922 if (@_) {
923 $_->disable_sth_caching(@_) for $self->all_storages;
924 }
925
926 return $self->master->disable_sth_caching;
927}
928
929=head2 lag_behind_master
930
931returns the highest Replicant L<DBIx::Class::Storage::DBI/lag_behind_master>
932setting
933
934=cut
935
936sub lag_behind_master {
937 my $self = shift;
938
939 return max map $_->lag_behind_master, $self->replicants;
fd323bf1 940}
3244fdcc 941
942=head2 is_replicating
943
944returns true if all replicants return true for
945L<DBIx::Class::Storage::DBI/is_replicating>
946
947=cut
948
949sub is_replicating {
950 my $self = shift;
951
952 return (grep $_->is_replicating, $self->replicants) == ($self->replicants);
953}
954
955=head2 connect_call_datetime_setup
956
957calls L<DBIx::Class::Storage::DBI/connect_call_datetime_setup> for all storages
958
959=cut
960
961sub connect_call_datetime_setup {
962 my $self = shift;
963 $_->connect_call_datetime_setup for $self->all_storages;
964}
965
966sub _populate_dbh {
967 my $self = shift;
968 $_->_populate_dbh for $self->all_storages;
969}
970
971sub _connect {
972 my $self = shift;
973 $_->_connect for $self->all_storages;
974}
975
976sub _rebless {
977 my $self = shift;
978 $_->_rebless for $self->all_storages;
979}
980
981sub _determine_driver {
982 my $self = shift;
983 $_->_determine_driver for $self->all_storages;
984}
985
986sub _driver_determined {
987 my $self = shift;
fd323bf1 988
3244fdcc 989 if (@_) {
990 $_->_driver_determined(@_) for $self->all_storages;
991 }
992
993 return $self->master->_driver_determined;
994}
995
996sub _init {
997 my $self = shift;
fd323bf1 998
3244fdcc 999 $_->_init for $self->all_storages;
1000}
1001
1002sub _run_connection_actions {
1003 my $self = shift;
fd323bf1 1004
3244fdcc 1005 $_->_run_connection_actions for $self->all_storages;
1006}
1007
1008sub _do_connection_actions {
1009 my $self = shift;
fd323bf1 1010
3244fdcc 1011 if (@_) {
1012 $_->_do_connection_actions(@_) for $self->all_storages;
1013 }
1014}
1015
1016sub connect_call_do_sql {
1017 my $self = shift;
1018 $_->connect_call_do_sql(@_) for $self->all_storages;
1019}
1020
1021sub disconnect_call_do_sql {
1022 my $self = shift;
1023 $_->disconnect_call_do_sql(@_) for $self->all_storages;
1024}
1025
1026sub _seems_connected {
1027 my $self = shift;
1028
1029 return min map $_->_seems_connected, $self->all_storages;
1030}
1031
1032sub _ping {
1033 my $self = shift;
1034
1035 return min map $_->_ping, $self->all_storages;
1036}
1037
bbdda281 1038# not using the normalized_version, because we want to preserve
1039# version numbers much longer than the conventional xxx.yyyzzz
7da56142 1040my $numify_ver = sub {
1041 my $ver = shift;
1042 my @numparts = split /\D+/, $ver;
bbdda281 1043 my $format = '%d.' . (join '', ('%06d') x (@numparts - 1));
7da56142 1044
1045 return sprintf $format, @numparts;
1046};
fecb38cb 1047sub _server_info {
1048 my $self = shift;
1049
bbdda281 1050 if (not $self->_dbh_details->{info}) {
1051 $self->_dbh_details->{info} = (
fd323bf1 1052 reduce { $a->[0] < $b->[0] ? $a : $b }
7da56142 1053 map [ $numify_ver->($_->{dbms_version}), $_ ],
1054 map $_->_server_info, $self->all_storages
1055 )->[1];
fecb38cb 1056 }
1057
bbdda281 1058 return $self->next::method;
fecb38cb 1059}
1060
1061sub _get_server_version {
1062 my $self = shift;
1063
1064 return $self->_server_info->{dbms_version};
1065}
1066
7e38d850 1067=head1 GOTCHAS
1068
1069Due to the fact that replicants can lag behind a master, you must take care to
1070make sure you use one of the methods to force read queries to a master should
1071you need realtime data integrity. For example, if you insert a row, and then
1072immediately re-read it from the database (say, by doing $row->discard_changes)
1073or you insert a row and then immediately build a query that expects that row
1074to be an item, you should force the master to handle reads. Otherwise, due to
1075the lag, there is no certainty your data will be in the expected state.
1076
1077For data integrity, all transactions automatically use the master storage for
1078all read and write queries. Using a transaction is the preferred and recommended
1079method to force the master to handle all read queries.
1080
1081Otherwise, you can force a single query to use the master with the 'force_pool'
1082attribute:
1083
1084 my $row = $resultset->search(undef, {force_pool=>'master'})->find($pk);
1085
1086This attribute will safely be ignore by non replicated storages, so you can use
1087the same code for both types of systems.
1088
1089Lastly, you can use the L</execute_reliably> method, which works very much like
1090a transaction.
1091
1092For debugging, you can turn replication on/off with the methods L</set_reliable_storage>
1093and L</set_balanced_storage>, however this operates at a global level and is not
1094suitable if you have a shared Schema object being used by multiple processes,
1095such as on a web application server. You can get around this limitation by
1096using the Schema clone method.
1097
1098 my $new_schema = $schema->clone;
1099 $new_schema->set_reliable_storage;
d4daee7b 1100
7e38d850 1101 ## $new_schema will use only the Master storage for all reads/writes while
1102 ## the $schema object will use replicated storage.
1103
f5d3a5de 1104=head1 AUTHOR
1105
64cdad22 1106 John Napiorkowski <john.napiorkowski@takkle.com>
f5d3a5de 1107
c4d3fae2 1108Based on code originated by:
f5d3a5de 1109
64cdad22 1110 Norbert Csongrádi <bert@cpan.org>
1111 Peter Siklósi <einon@einon.hu>
2156bbdd 1112
f5d3a5de 1113=head1 LICENSE
1114
1115You may distribute this code under the same terms as Perl itself.
1116
1117=cut
1118
c354902c 1119__PACKAGE__->meta->make_immutable;
1120
f5d3a5de 11211;