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