view release on metacpan or  search on metacpan

lib/Mojar/Mysql/Connector.pm  view on Meta::CPAN

has mysql_enable_utf8 => 1;

my @ConFields = qw(label cnfdir cnf cnfgroup);

has 'label';
has cnfdir => '.';
has 'cnf';
has 'cnfgroup';

my @DbiFields = qw(driver host port schema user password);

has driver => 'mysql';
has 'host';  # eg 'localhost'
has 'port';  # eg 3306
has 'schema';  # eg 'test';
has 'user';
has 'password';

# Public methods

sub new {
  my ($proto, %param) = @_;
  # $proto may contain defaults to be cloned
  # %param may contain defaults for overriding
  my %defaults = ref $proto ? ( %{ ref($proto)->Defaults }, %$proto )
                            : %{$proto->Defaults};
  delete $defaults{$_} for grep { ref $proto and /^dbh\./ } keys %defaults;
  return Mojo::Base::new($proto, %defaults, %param);
}

sub connect {
  my ($proto, @args) = @_;
  my $class = ref $proto || $proto;
  @args = $proto->dsn(@args) unless @args and $args[0] =~ /^DBI:/i;
  my $dbh;
  eval { $dbh = $class->SUPER::connect(@args) }
  or do {
    my $e = $@;
    croak sprintf "Connection error\n%s\n%s", $proto->dsn_to_dump(@args), $e;
  };
  return $dbh;
}

sub connection {
  my ($self, $tag) = @_; $tag //= 'connection';
  return $self->{"dbh.$tag"} if ($self->{"dbh.$tag"} //= $self->connect)->ping;
  return $self->{"dbh.$tag"} = $self->connect;
}

sub dsn {
  my ($proto, %param) = @_;
  my $param = $proto->new(%param);

  my $cnf_txt = '';
  if (my $cnf = $param->cnf) {
    # MySQL .cnf file
    $cnf .= '.cnf' unless $cnf =~ /\.cnf$/;
    $cnf = catfile $param->cnfdir, $cnf if ! -r $cnf and defined $param->cnfdir;
    croak "Failed to find/read .cnf file ($cnf)" unless -f $cnf and -r $cnf;

    $cnf_txt = ';mysql_read_default_file='. $cnf;
    $cnf_txt .= ';mysql_read_default_group='. $param->cnfgroup
      if defined $param->cnfgroup;
  }

  # DBD params
  # Only set private_config if it would have useful values
  my %custom;
  defined($param->$_) and $custom{$_} = $param->$_ for qw(label cnf cnfgroup);
  my $dbd_param = %custom ? { private_config => {%custom} } : {};
  $dbd_param->{$_} = $param->{$_} for grep /^mysql_/, keys %$param;
  @$dbd_param{@DbdFields} = map $param->$_, @DbdFields;

  return (
    'DBI:'. $param->driver .q{:}
          . ($param->schema // $param->{db} // '')
          . (defined $param->host ? q{;host=}. $param->host : '')
          . (defined $param->port ? q{;port=}. $param->port : '')
          . $cnf_txt,
    $param->user,
    $param->password,
    $dbd_param
  );
}

sub dsn_to_dump {
  my ($proto, @args) = @_;
  @args = $proto->dsn unless @args;
  # Occlude password
  if ($args[2] and $_ = length $args[2] and $_ > 1) {
    --$_;
    my $blanks = '*' x $_;
    $args[2] = substr($args[2], 0, 1). $blanks;
  }
  require Mojar::Util;
  return Mojar::Util::dumper(@args);
}

# ============
package Mojar::Mysql::Connector::db;
@Mojar::Mysql::Connector::db::ISA = 'DBI::db';

use Carp 'croak';
use Mojar::Util 'lc_keys';
use Scalar::Util 'looks_like_number';

our $_as_hash = { Slice => {} };
sub as_hash { $_as_hash }

# Public methods

sub dsn { shift->get_info(2) }
# 2 : SQL_DATA_SOURCE_NAME

sub mysqld_version { shift->get_info(18) }
# 18 : SQL_DBMS_VER

sub identifier_quote { shift->get_info(29) }
# 29 : SQL_IDENTIFIER_QUOTE_CHAR

sub identifier_separator { shift->get_info(41) }