view release on metacpan or  search on metacpan

lib/DBIO/Replicated/Storage.pm  view on Meta::CPAN

package DBIO::Replicated::Storage;
# ABSTRACT: Replicated DBI storage coordinator

use strict;
use warnings;

use base 'DBIO::Storage::DBI';

use Scalar::Util qw/blessed reftype weaken/;
use List::Util ();
use Sub::Util 'set_subname';
use DBIO::Util ();
use namespace::clean;

__PACKAGE__->mk_group_accessors(simple => qw/
  pool_type
  pool_args
  balancer_type
  balancer_args
  backend_storage_class
  _master_connect_info_opts
/);

my @writer_methods = qw(
  sql_maker sqlt_type datetime_parser datetime_parser_type
  build_datetime_parser last_insert_id insert update delete dbh
  txn_begin txn_do txn_commit txn_rollback txn_scope_guard
  deploy with_deferred_fk_checks dbh_do _prep_for_execute
  is_datatype_numeric svp_rollback svp_begin svp_release
  relname_to_table_alias _dbh_last_insert_id _dbi_connect_info
  _dbio_connect_attributes auto_savepoint bind_attribute_by_data_type
  transaction_depth deferred_rollback _throw_deferred_rollback
  savepoints _sql_maker _sql_maker_opts _dbh_autocommit _get_dbh
  sql_maker_class insert_bulk _insert_bulk _execute _do_query
  _dbh_execute _server_info _get_server_version
);

my @reader_methods = qw(
  select select_single columns_info_for _dbh_columns_info_for _select
);


sub new {
  my ($class, $schema, $args) = @_;
  $args ||= {};

  my $self = bless {
    transaction_depth => 0,
    savepoints        => [],
  }, $class;

  $self->schema($schema);
  weaken $self->{schema} if ref $self->{schema};
  $self->{debug} = 1
    if $ENV{DBIO_TRACE};

  $self->pool_type($args->{pool_type} || 'DBIO::Replicated::Pool');
  $self->pool_args($args->{pool_args} || {});
  $self->balancer_type($class->_normalize_balancer_type($args->{balancer_type} || 'DBIO::Replicated::Balancer::First'));
  $self->balancer_args($args->{balancer_args} || {});
  $self->backend_storage_class($args->{backend_storage_class} || 'DBIO::Storage::DBI');
  $self->_master_connect_info_opts({});

  return $self;
}

sub _normalize_balancer_type {
  my ($class, $type) = @_;
  $type =~ s/\A::/DBIO::Replicated::Balancer::/;
  return $type;
}

sub master {
  my $self = shift;
  if (@_) {
    $self->{master} = $_[0];
  }
  elsif (!$self->{master}) {
    $self->{master} = $self->_build_master;
  }
  return $self->{master};
}

sub pool {
  my $self = shift;
  if (@_) {
    $self->{pool} = $_[0];
  }
  elsif (!$self->{pool}) {
    $self->{pool} = $self->_build_pool;
  }
  return $self->{pool};
}

sub balancer {
  my $self = shift;
  if (@_) {
    $self->{balancer} = $_[0];
  }
  elsif (!$self->{balancer}) {
    $self->{balancer} = $self->_build_balancer;
  }
  return $self->{balancer};
}

sub read_handler {
  my $self = shift;
  if (@_) {
    $self->{read_handler} = $_[0];
  }
  elsif (!$self->{read_handler}) {
    $self->{read_handler} = $self->_build_read_handler;
  }