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