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