package DBIx::Class::Storage::DBI::Replicated;
BEGIN {
- use Carp::Clan qw/^DBIx::Class/;
use DBIx::Class;
- croak('The following modules are required for Replication ' . DBIx::Class::Optional::Dependencies->req_missing_for ('replicated') )
+ 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');
}
The following methods are delegated all the methods required for the
L<DBIx::Class::Storage::DBI> interface.
-=head2 read_handler
-
-Defines an object that implements the read side of L<BIx::Class::Storage::DBI>.
-
=cut
-has 'read_handler' => (
- is=>'rw',
- isa=>Object,
- lazy_build=>1,
- handles=>[qw/
- select
- select_single
- columns_info_for
- _dbh_columns_info_for
- _select
- /],
-);
-
-=head2 write_handler
-
-Defines an object that implements the write side of L<BIx::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.
-
-=cut
-
-has 'write_handler' => (
- is=>'ro',
- isa=>Object,
- lazy_build=>1,
- handles=>[qw/
+my $method_dispatch = {
+ writer => [qw/
on_connect_do
on_disconnect_do
on_connect_call
txn_commit
txn_rollback
txn_scope_guard
- sth
deploy
with_deferred_fk_checks
dbh_do
- reload_row
- with_deferred_fk_checks
_prep_for_execute
-
- backup
is_datatype_numeric
- _supports_insert_returning
_count_select
_subq_update_delete
svp_rollback
svp_begin
svp_release
relname_to_table_alias
- _straight_join_to_node
_dbh_last_insert_id
- _fix_bind_params
_default_dbi_connect_attributes
_dbi_connect_info
_dbic_connect_attributes
auto_savepoint
- _sqlt_version_ok
+ _query_start
_query_end
+ _format_for_trace
+ _dbi_attrs_for_bind
bind_attribute_by_data_type
transaction_depth
_dbh
_select_args
_dbh_execute_array
- _sql_maker_args
_sql_maker
- _query_start
- _sqlt_version_error
_per_row_update_delete
_dbh_begin_work
_dbh_execute_inserts_with_no_binds
_select_args_to_query
_svp_generate_name
_multipk_update_delete
- source_bind_attributes
_normalize_connect_info
_parse_connect_do
_dbh_commit
_execute_array
- _placeholders_supported
savepoints
- _sqlt_minimum_version
_sql_maker_opts
_conn_pid
- _typeless_placeholders_supported
- _conn_tid
_dbh_autocommit
_native_data_type
_get_dbh
_resolve_column_info
_prune_unused_joins
_strip_cond_qualifiers
- _parse_order_by
+ _strip_cond_qualifiers_from_array
_resolve_aliastypes_from_select_args
_execute
_do_query
+ _sth
_dbh_sth
_dbh_execute
- _prefetch_insert_auto_nextvals
- _server_info_hash
/],
-);
+ reader => [qw/
+ select
+ select_single
+ columns_info_for
+ _dbh_columns_info_for
+ _select
+ /],
+ unimplemented => [qw/
+ _arm_global_destructor
+ _verify_pid
-my @unimplemented = qw(
- _arm_global_destructor
- _preserve_foreign_dbh
- _verify_pid
- _verify_tid
-);
+ source_bind_attributes
+
+ get_use_dbms_capability
+ set_use_dbms_capability
+ get_dbms_capability
+ set_dbms_capability
+ _dbh_details
+ _dbh_get_info
+
+ sql_limit_dialect
+ sql_quote_char
+ sql_name_sep
+
+ _inner_join_to_node
+ _group_over_selection
+ _extract_order_criteria
-for my $method (@unimplemented) {
+ _prefetch_autovalues
+
+ _max_column_bytesize
+ _is_lob_type
+ _is_binary_lob_type
+ _is_text_lob_type
+
+ sth
+ /,(
+ # 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 }
+ ( Class::MOP::Class->initialize('DBIx::Class::Storage::DBI')->get_all_method_names )
+ )],
+};
+
+if (DBIx::Class::_ENV_::DBICTEST) {
+
+ my $seen;
+ for my $type (keys %$method_dispatch) {
+ for (@{$method_dispatch->{$type}}) {
+ push @{$seen->{$_}}, $type;
+ }
+ }
+
+ if (my @dupes = grep { @{$seen->{$_}} > 1 } keys %$seen) {
+ die(join "\n", '',
+ 'The following methods show up multiple times in ::Storage::DBI::Replicated handlers:',
+ (map { "$_: " . (join ', ', @{$seen->{$_}}) } sort @dupes),
+ '',
+ );
+ }
+
+ if (my @cant = grep { ! DBIx::Class::Storage::DBI->can($_) } keys %$seen) {
+ die(join "\n", '',
+ '::Storage::DBI::Replicated specifies handling of the following *NON EXISTING* ::Storage::DBI methods:',
+ @cant,
+ '',
+ );
+ }
+}
+
+for my $method (@{$method_dispatch->{unimplemented}}) {
__PACKAGE__->meta->add_method($method, sub {
- croak "$method must not be called on ".(blessed shift).' objects';
+ my $self = shift;
+ $self->throw_exception("$method must not be called on ".(blessed $self).' objects');
});
}
+=head2 read_handler
+
+Defines an object that implements the read side of L<BIx::Class::Storage::DBI>.
+
+=cut
+
+has 'read_handler' => (
+ is=>'rw',
+ isa=>Object,
+ lazy_build=>1,
+ handles=>$method_dispatch->{reader},
+);
+
+=head2 write_handler
+
+Defines an object that implements the write side of L<BIx::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.
+
+=cut
+
+has 'write_handler' => (
+ is=>'ro',
+ isa=>Object,
+ lazy_build=>1,
+ handles=>$method_dispatch->{writer},
+);
+
+
+
has _master_connect_info_opts =>
(is => 'rw', isa => HashRef, default => sub { {} });
around connect_info => sub {
my ($next, $self, $info, @extra) = @_;
- my $wantarray = wantarray;
-
my $merge = Hash::Merge->new('LEFT_PRECEDENT');
my %opts;
$merge->merge((delete $opts{pool_args} || {}), $self->pool_args)
);
- $self->pool($self->_build_pool)
- if $self->pool;
+ ## Since we possibly changed the pool_args, we need to clear the current
+ ## pool object so that next time it is used it will be rebuilt.
+ $self->clear_pool;
}
if (@opts{qw/balancer_type balancer_args/}) {
$self->_master_connect_info_opts(\%opts);
- my (@res, $res);
- if ($wantarray) {
+ my @res;
+ if (wantarray) {
@res = $self->$next($info, @extra);
} else {
- $res = $self->$next($info, @extra);
+ $res[0] = $self->$next($info, @extra);
}
# Make sure master is blessed into the correct class and apply role to it.
# link pool back to master
$self->pool->master($master);
- $wantarray ? @res : $res;
+ wantarray ? @res : $res[0];
};
=head1 METHODS
$self->read_handler($current);
};
- return $want_array ? @result : $result[0];
+ return wantarray ? @result : $result[0];
}
=head2 set_reliable_storage
foreach my $source ($self->all_storages) {
$source->limit_dialect(@_);
}
- return $self->master->quote_char;
+ return $self->master->limit_dialect;
}
=head2 quote_char
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 '', ('%05d') x (@numparts - 1));
+ my $format = '%d.' . (join '', ('%06d') x (@numparts - 1));
return sprintf $format, @numparts;
};
-
sub _server_info {
my $self = shift;
- if (not $self->_server_info_hash) {
- my $min_version_info = (
+ 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];
-
- $self->_server_info_hash($min_version_info); # on master
}
- return $self->_server_info_hash;
+ return $self->next::method;
}
sub _get_server_version {