package DBIx::Class::Storage::DBI::Replicated;
+use warnings;
+use strict;
+
BEGIN {
- use DBIx::Class;
- die('The following modules are required for Replication ' . DBIx::Class::Optional::Dependencies->req_missing_for ('replicated') . "\n" )
- unless DBIx::Class::Optional::Dependencies->req_ok_for ('replicated');
+ require DBIx::Class::Optional::Dependencies;
+ if ( my $missing = DBIx::Class::Optional::Dependencies->req_missing_for('replicated') ) {
+ die "The following modules are required for Replicated storage support: $missing\n";
+ }
}
use Moose;
use MooseX::Types::Moose qw/ClassName HashRef Object/;
use Scalar::Util 'reftype';
use Hash::Merge;
-use List::Util qw/min max reduce/;
+use List::Util qw( min max );
use Context::Preserve 'preserve_context';
use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
use namespace::clean -except => 'meta';
-=encoding utf8
-
=head1 NAME
DBIx::Class::Storage::DBI::Replicated - BETA Replicated database support
_parse_connect_do
savepoints
_sql_maker_opts
+ _use_multicolumn_in
_conn_pid
_dbh_autocommit
_native_data_type
unimplemented => [qw/
_arm_global_destructor
_verify_pid
+ __delicate_rollback
get_use_dbms_capability
set_use_dbms_capability
set_dbms_capability
_dbh_details
_dbh_get_info
+ _get_rdbms_name
+ _get_server_version
+ _server_info
_determine_connector_driver
_extract_driver_from_connect_info
# the capability framework
# not sure if CMOP->initialize does evil things to DBIC::S::DBI, fix if a problem
grep
- { $_ =~ /^ _ (?: use | supports | determine_supports ) _ /x }
+ { $_ =~ /^ _ (?: use | supports | determine_supports ) _ /x and $_ ne '_use_multicolumn_in' }
( Class::MOP::Class->initialize('DBIx::Class::Storage::DBI')->get_all_method_names )
)],
};
-if (DBIx::Class::_ENV_::DBICTEST) {
+# this only happens during DBIC-internal testing
+if ( $INC{"t/lib/ANFANG.pm"} ) {
my $seen;
for my $type (keys %$method_dispatch) {
for my $method (@{$method_dispatch->{unimplemented}}) {
__PACKAGE__->meta->add_method($method, sub {
my $self = shift;
- $self->throw_exception("$method() must not be called on ".(blessed $self).' objects');
+ $self->throw_exception(
+ "$method() may not be called on '@{[ blessed $self ]}' objects, "
+ . 'call it on a specific pool instance instead'
+ );
});
}
=head2 read_handler
-Defines an object that implements the read side of L<BIx::Class::Storage::DBI>.
+Defines an object that implements the read side of L<DBIx::Class::Storage::DBI>.
=cut
=head2 write_handler
-Defines an object that implements the write side of L<BIx::Class::Storage::DBI>,
+Defines an object that implements the write side of L<DBIx::Class::Storage::DBI>,
as well as methods that don't write or read that can be called on only one
storage, methods that return a C<$dbh>, and any methods that don't make sense to
run on a replicant.
=head2 around: connect_replicants
All calls to connect_replicants needs to have an existing $schema tacked onto
-top of the args, since L<DBIx::Storage::DBI> needs it, and any C<connect_info>
+top of the args, since L<DBIx::Class::Storage::DBI> needs it, and any
+L<connect_info|DBIx::Class::Storage::DBI/connect_info>
options merged with the master, with replicant opts having higher priority.
=cut
my $self = shift;
my $coderef = shift;
- unless( ref $coderef eq 'CODE') {
- $self->throw_exception('Second argument must be a coderef');
- }
+ $self->throw_exception('Second argument must be a coderef')
+ unless( ref $coderef eq 'CODE');
## replace the current read handler for the remainder of the scope
local $self->{read_handler} = $self->master;
- my $args = \@_;
- return try {
- $coderef->(@$args);
- } catch {
- $self->throw_exception("coderef returned an error: $_");
- };
+ &$coderef;
}
=head2 set_reliable_storage
return min map $_->_ping, $self->all_storages;
}
-# not using the normalized_version, because we want to preserve
-# version numbers much longer than the conventional xxx.yyyzzz
-my $numify_ver = sub {
- my $ver = shift;
- my @numparts = split /\D+/, $ver;
- my $format = '%d.' . (join '', ('%06d') x (@numparts - 1));
-
- return sprintf $format, @numparts;
-};
-sub _server_info {
- my $self = shift;
-
- if (not $self->_dbh_details->{info}) {
- $self->_dbh_details->{info} = (
- reduce { $a->[0] < $b->[0] ? $a : $b }
- map [ $numify_ver->($_->{dbms_version}), $_ ],
- map $_->_server_info, $self->all_storages
- )->[1];
- }
-
- return $self->next::method;
-}
-
-sub _get_server_version {
- my $self = shift;
-
- return $self->_server_info->{dbms_version};
-}
-
=head1 GOTCHAS
Due to the fact that replicants can lag behind a master, you must take care to
## $new_schema will use only the Master storage for all reads/writes while
## the $schema object will use replicated storage.
-=head1 AUTHOR
-
- John Napiorkowski <john.napiorkowski@takkle.com>
-
-Based on code originated by:
+=head1 FURTHER QUESTIONS?
- Norbert Csongrádi <bert@cpan.org>
- Peter Siklósi <einon@einon.hu>
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
=cut