view release on metacpan or  search on metacpan

lib/DBIx/TempDB/Util.pm  view on Meta::CPAN

use strict;
use warnings;
use Exporter 'import';

use Carp qw(confess croak);
use IO::Select;
use POSIX;
use Scalar::Util 'blessed';
use URI::db;
use URI::QueryParam;

use constant DEBUG               => $ENV{DBIX_TEMP_DB_DEBUG}               || 0;
use constant KILL_SLEEP_INTERVAL => $ENV{DBIX_TEMP_DB_KILL_SLEEP_INTERVAL} || 2;

our @EXPORT_OK = qw(dsn_for on_process_end parse_sql);

sub dsn_for {
  my ($url, $database_name) = @_;
  $url = URI::db->new($url) unless blessed $url;
  croak "Unknown engine for $url" unless $url->has_recognized_engine;

  my $engine = $url->canonical_engine;
  $database_name //= $url->dbname;
  return _dsn_for_mysql($url, $database_name)  if $engine eq 'mysql';
  return _dsn_for_pg($url, $database_name)     if $engine eq 'pg';
  return _dsn_for_sqlite($url, $database_name) if $engine eq 'sqlite';
  croak "Can't create DSN for engine $engine.";
}

sub on_process_end {
  my $code = pop;
  my $mode = shift // 'fork';

  return _on_process_end_fork($code)        if $mode eq 'fork';
  return _on_process_end_double_fork($code) if $mode eq 'double_fork';
  return DBIx::TempDB::Guard->new($code, $$);
}

sub parse_sql {
  my ($type, $sql) = @_;
  $type = $type->canonical_engine if blessed $type;
  return _parse_mysql($sql) if $type eq 'mysql';
  return $sql;
}

sub _dsn_for_mysql {
  my ($url, $database_name) = @_;
  my %opt = %{$url->query_form_hash};
  my ($dsn, @userinfo);

  $url = URI::db->new($url);
  $url->dbname($database_name);
  $url->query(undef);
  $dsn      = $url->dbi_dsn;
  @userinfo = ($url->user, $url->password);

  $opt{AutoCommit}          //= 1;
  $opt{AutoInactiveDestroy} //= 1;
  $opt{PrintError}          //= 0;
  $opt{RaiseError}          //= 1;
  $opt{mysql_enable_utf8}   //= 1;

  return $dsn, @userinfo[0, 1], \%opt;
}

sub _dsn_for_pg {
  my ($url, $database_name) = @_;
  my %opt = %{$url->query_form_hash};
  my ($dsn, @userinfo);

  $url = URI::db->new($url);
  $url->dbname($database_name);
  $url->query(undef);
  if (my $service = delete $opt{service}) { $url->query_param(service => $service) }
  $dsn      = $url->dbi_dsn;
  @userinfo = ($url->user, $url->password);

  $opt{AutoCommit}          //= 1;
  $opt{AutoInactiveDestroy} //= 1;
  $opt{PrintError}          //= 0;
  $opt{RaiseError}          //= 1;

  return $dsn, @userinfo[0, 1], \%opt;
}

sub _dsn_for_sqlite {
  my ($url, $database_name) = @_;
  my %opt = %{$url->query_form_hash};

  $url = URI::db->new($url);
  $url->dbname($database_name);
  $url->query(undef);
  my $dsn = $url->dbi_dsn;

  $opt{AutoCommit}          //= 1;
  $opt{AutoInactiveDestroy} //= 1;
  $opt{PrintError}          //= 0;
  $opt{RaiseError}          //= 1;
  $opt{sqlite_unicode}      //= 1;

  return $dsn, "", "", \%opt;
}

sub _on_process_end_double_fork {
  my $code = shift;
  my $ppid = $$;

  warn "[TempDB:$$] Watching process using double fork.\n" if DEBUG;
  local $SIG{CHLD} = 'DEFAULT';
  pipe(my ($READER), my ($WRITER)) or confess "Couldn't create pipe: $!";

  # Parent
  if (my $pid_1 = fork // confess "Couldn't fork: $!") {
    my $pid_2;

    # Wait around until the second fork is done so that when we return from
    # here there are no new child processes that could mess things up if the
    # calling process does any process handling.
    close $WRITER;
    $pid_2 = <$READER>;
    $pid_2 = $pid_2 =~ m!(\d+)! ? $1 : undef;