view release on metacpan or  search on metacpan

t/mariadb_live.t  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;

# Live MariaDB integration tests for Database::Join.
#
# Tests joins between MariaDB-backed Database::Abstraction subclasses and
# between a MariaDB-backed DA and a static in-memory DA.
#
# Only run when MARIADB_SERVER is set to a reachable MariaDB/MySQL instance:
#   MARIADB_SERVER=mariadb://user:pass@host/test prove -l t/mariadb_live.t
#
# MARIADB_SERVER formats accepted:
#   mariadb://user:pass@host:port/database
#   mariadb://user@host/database
#   mariadb://host/database
#   host
#   host:port
#   host/database
#   dbi:MariaDB:database=db;host=host
#   dbi:mysql:database=db;host=host
#
# Two PID-unique tables are created (primary + secondary) and dropped in END.
# Safe to run against a shared MariaDB instance.
#
# On the server:
#   CREATE DATABASE test;
#   GRANT ALL ON test.* TO 'dbtest'@'client';
#   FLUSH PRIVILEGES;

use Test::Most;
use Test::Returns;

BEGIN {
	plan skip_all => 'MARIADB_SERVER not set (e.g. MARIADB_SERVER=mariadb://root:pass@host/test)'
		unless $ENV{MARIADB_SERVER};
	eval { require DBD::MariaDB } or eval { require DBD::mysql };
	plan skip_all => 'DBD::MariaDB or DBD::mysql required'
		unless defined $INC{'DBD/MariaDB.pm'} || defined $INC{'DBD/mysql.pm'};
	eval { require Database::Abstraction };
	plan skip_all => 'Database::Abstraction required' if $@;
	eval { require Database::Join };
	plan skip_all => 'Database::Join required' if $@;
}

use Readonly;
use Scalar::Util qw(refaddr);

# ---------------------------------------------------------------------------
# Parse MARIADB_SERVER into DSN + credentials
# ---------------------------------------------------------------------------
my ($DSN, $DB_USER, $DB_PASS) = _parse_server($ENV{MARIADB_SERVER});

sub _parse_server {
	my ($raw) = @_;

	return ($raw, undef, undef) if $raw =~ /\Adbi:/i;

	$raw = "mariadb://$raw" unless $raw =~ m{\A[a-z]+://}i;

	my ($user, $pass, $host, $port, $db);
	if ($raw =~ m{\Amariadb://([^:@]+):([^@]*)@([^/:]+)(?::(\d+))?(?:/(\S*))?}i) {
		($user, $pass, $host, $port, $db) = ($1, $2, $3, $4, $5);
	} elsif ($raw =~ m{\Amariadb://([^@]+)@([^/:]+)(?::(\d+))?(?:/(\S*))?}i) {
		($user, $host, $port, $db) = ($1, $2, $3, $4);
	} elsif ($raw =~ m{\Amariadb://([^/:]+)(?::(\d+))?(?:/(\S*))?}i) {
		($host, $port, $db) = ($1, $2, $3);
	}
	$host //= 'localhost';
	$port //= 3306;
	$db   //= 'test';
	$db     =~ s{/}{}g;

	my $driver = defined $INC{'DBD/MariaDB.pm'} ? 'MariaDB' : 'mysql';
	my $dsn = "dbi:${driver}:database=${db};host=${host};port=${port}";
	return ($dsn, $user, $pass);
}

# ---------------------------------------------------------------------------
# Connect to MariaDB — skip all if unreachable
# ---------------------------------------------------------------------------
my $setup_dbh;
eval {
	$setup_dbh = DBI->connect(
		$DSN, $DB_USER, $DB_PASS,
		{ RaiseError => 1, PrintError => 0, AutoCommit => 1 },
	);
};
if ($@) {
	plan skip_all => "Cannot connect to MariaDB ($DSN): $@";
}

eval { $setup_dbh->ping() };
if ($@) {
	plan skip_all => "MariaDB connection not alive: $@";
}

# ---------------------------------------------------------------------------
# PID-unique table names to avoid collisions on shared servers
# ---------------------------------------------------------------------------
Readonly my $TABLE_A => sprintf 'djlive_%d_mA', $$;   # primary: entry/name/score/active
Readonly my $TABLE_B => sprintf 'djlive_%d_mB', $$;   # secondary: entry/tier/region

# ---------------------------------------------------------------------------
# Create test tables and populate fixture rows
# ---------------------------------------------------------------------------
$setup_dbh->do("DROP TABLE IF EXISTS `$TABLE_A`");
$setup_dbh->do(<<"SQL");
CREATE TABLE `$TABLE_A` (
	entry   VARCHAR(64)  NOT NULL PRIMARY KEY,