Files
percona-toolkit/t/lib/Cxn.t
2012-10-17 15:39:06 -03:00

401 lines
9.1 KiB
Perl

#!/usr/bin/perl
BEGIN {
die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
};
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Test::More;
use Sandbox;
use OptionParser;
use DSNParser;
use Quoter;
use PerconaTest;
use Cxn;
use Data::Dumper;
my $q = new Quoter();
my $dp = new DSNParser(opts=>$dsn_opts);
my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp);
my $master_dbh = $sb->get_dbh_for('master');
if ( !$master_dbh ) {
plan skip_all => 'Cannot connect to sandbox master';
}
my $o = new OptionParser(description => 'Cxn');
$o->get_specs("$trunk/bin/pt-table-checksum");
$o->get_opts();
$dp->prop('set-vars', $o->get('set-vars'));
sub make_cxn {
my (%args) = @_;
$o->get_opts();
return new Cxn(
OptionParser => $o,
DSNParser => $dp,
%args,
);
}
sub test_var_val {
my ($dbh, $var, $val, %args) = @_;
my @row;
if ( !$args{user_var} ) {
my $sql = "SHOW " . ($args{global} ? "GLOBAL" : "SESSION " )
. "VARIABLES LIKE '$var'";
@row = $dbh->selectrow_array($sql);
}
else {
my $sql = "SELECT $var, $var";
@row = $dbh->selectrow_array($sql);
}
if ( $args{ne} ) {
ok(
$row[1] ne $val,
$args{test} || "$var != $val"
);
}
else {
is(
$row[1],
$val,
$args{test} || "$var = $val"
);
}
}
# The default wait_timeout should not be 10000. Verify this so when
# Cxn sets it, it's not coincidentally 10000, it was actually set.
test_var_val(
$master_dbh,
'wait_timeout',
'10000',
ne =>1,
test => 'Default wait_timeout',
);
my $set_calls = 0;
my $cxn = make_cxn(
dsn_string => 'h=127.1,P=12345,u=msandbox,p=msandbox',
set => sub {
my ($dbh) = @_;
$set_calls++;
$dbh->do("SET \@a := \@a + 1");
},
);
ok(
!$cxn->dbh(),
"New Cxn, dbh not connected yet"
);
is(
$cxn->name(),
'h=127.1,P=12345',
'name() uses DSN if not connected'
);
$cxn->connect();
ok(
$cxn->dbh()->ping(),
"cxn->connect()"
);
my ($row) = $cxn->dbh()->selectrow_hashref('SHOW MASTER STATUS');
ok(
exists $row->{binlog_ignore_db},
"FetchHashKeyName = NAME_lc",
) or diag(Dumper($row));
test_var_val(
$cxn->dbh(),
'wait_timeout',
'10000',
test => 'Sets --set-vars',
);
is(
$set_calls,
1,
'Calls set callback'
);
$cxn->dbh()->do("SET \@a := 1");
test_var_val(
$cxn->dbh(),
'@a',
'1',
user_var => 1,
);
my $first_dbh = $cxn->dbh();
$cxn->connect();
my $second_dbh = $cxn->dbh();
is(
$first_dbh,
$second_dbh,
"Doesn't reconnect the same dbh"
);
test_var_val(
$cxn->dbh(),
'@a',
'1',
user_var => 1,
test => "Doesn't re-set the vars",
);
# Reconnect.
$cxn->dbh()->disconnect();
$cxn->connect();
($row) = $cxn->dbh()->selectrow_hashref('SHOW MASTER STATUS');
ok(
exists $row->{binlog_ignore_db},
"Reconnect FetchHashKeyName = NAME_lc",
) or diag(Dumper($row));
test_var_val(
$cxn->dbh(),
'wait_timeout',
'10000',
test => 'Reconnect sets --set-vars',
);
is(
$set_calls,
2,
'Reconnect calls set callback'
);
test_var_val(
$cxn->dbh(),
'@a',
undef,
user_var => 1,
test => 'Reconnect is a new connection',
);
is_deeply(
$cxn->dsn(),
{
h => '127.1',
P => '12345',
u => 'msandbox',
p => 'msandbox',
A => undef,
F => undef,
S => undef,
D => undef,
t => undef,
},
"cxn->dsn()"
);
my ($hostname) = $master_dbh->selectrow_array('select @@hostname');
is(
$cxn->name(),
$hostname,
'name() uses @@hostname'
);
# ############################################################################
# Default cxn, should be equivalent to 'h=localhost'.
# ############################################################################
my $default_cxn = make_cxn();
is_deeply(
$default_cxn->dsn(),
{
h => 'localhost',
P => undef,
u => undef,
p => undef,
A => undef,
F => undef,
S => undef,
D => undef,
t => undef,
},
"Defaults to h=localhost"
);
# But now test if it will inherit just a few standard connection options.
@ARGV = qw(--port 12345);
$default_cxn = make_cxn();
is_deeply(
$default_cxn->dsn(),
{
h => 'localhost',
P => '12345',
u => undef,
p => undef,
A => undef,
F => undef,
S => undef,
D => undef,
t => undef,
},
"Default cxn inherits default connection options"
);
@ARGV = ();
$o->get_opts();
diag("Starting master1");
$sb->start_sandbox("master", "master1");
$cxn = make_cxn( dsn_string => $sb->dsn_for("master1") );
$cxn->connect();
ok(
!$cxn->is_cluster_node(),
"is_cluster_node works correctly for non-nodes"
);
use VersionParser;
my $db_flavor = VersionParser->new($master_dbh)->flavor();
SKIP: {
skip "PXC-only test", 1
unless $db_flavor =~ /XtraDB Cluster/;
diag("Starting a 1-node PXC");
my ($node) = $sb->start_cluster(cluster_size => 1);
my $cxn1 = make_cxn( dsn_string => $sb->dsn_for($node) );
$cxn1->connect();
ok(
$cxn1->is_cluster_node(),
"is_cluster_node works correctly for cluster nodes"
);
ok(
!$cxn->is_master_of($cxn1),
"->is_master_of works correctly for a server unrelated to a cluster"
);
diag("Setting node as a slave of master1");
$sb->set_as_slave($node, "master1");
ok(
$cxn->is_master_of($cxn1),
"->is_master_of works correctly for master -> cluster"
);
ok(
!$cxn1->is_master_of($cxn),
"...and the inverse returns the expected result"
);
ok(
!$cxn->same_cluster($cxn1),
"->same_cluster works for master -> cluster"
);
diag("Restarting the cluster");
diag($sb->stop_sandbox($node));
($node) = $sb->start_cluster(cluster_size => 1);
$cxn1 = make_cxn( dsn_string => $sb->dsn_for($node) );
$cxn1->connect();
diag("Setting master1 as a slave of the node");
$sb->set_as_slave("master1", $node);
ok(
$cxn1->is_master_of($cxn),
"->is_master_of works correctly for cluster -> master"
);
ok(
!$cxn->is_master_of($cxn1),
"...and the inverse returns the expected result"
);
ok(
!$cxn1->same_cluster($cxn),
"->same_cluster works for cluster -> master"
);
diag("Starting a 2-node PXC");
my ($node2, $node3) = $sb->start_cluster(cluster_size => 2);
my $cxn2 = make_cxn( dsn_string => $sb->dsn_for($node2) );
$cxn2->connect();
my $cxn3 = make_cxn( dsn_string => $sb->dsn_for($node3) );
$cxn3->connect();
ok(
$cxn2->is_cluster_node(),
"is_cluster_node correctly finds that this node is part of a cluster"
);
ok(
!$cxn1->same_cluster($cxn2),
"and same_cluster correctly finds that they don't belong to the same cluster, even when they have the same cluster name"
);
ok(
$cxn2->same_cluster($cxn3),
"...but does find that they are in the same cluster, even if one is node1"
);
TODO: {
local $::TODO = "Should detected that (cluster1.node1) (cluster2.node2) come from different clusters, but doesn't";
ok(
!$cxn1->same_cluster($cxn3),
"...same_cluster works correctly when they have the same cluster names"
);
}
diag("Making the second cluster a slave of the first");
$sb->set_as_slave($node2, $node);
ok($cxn1->is_master_of($cxn2), "is_master_of works");
ok(
!$cxn1->same_cluster($cxn2),
"...same_cluster works correctly when they are cluster1.node1.master -> cluster2.node1.slave"
);
diag($sb->stop_sandbox($node2, $node3));
diag("Starting a 3-node cluster");
my $node4;
($node2, $node3, $node4) = $sb->start_cluster(
cluster_size => 3,
cluster_name => "pt_cxn_test",
);
$cxn2 = make_cxn( dsn_string => $sb->dsn_for($node2) );
$cxn2->connect();
$cxn3 = make_cxn( dsn_string => $sb->dsn_for($node3) );
$cxn3->connect();
my $cxn4 = make_cxn( dsn_string => $sb->dsn_for($node4) );
$cxn4->connect();
ok(
!$cxn1->same_cluster($cxn2),
"...same_cluster works correctly when they have different cluster names & the are both gcomm"
);
ok(
!$cxn1->same_cluster($cxn3),
"same_cluster detects that (cluster1.node1) (cluster2.node2) come from different clusters if they have different cluster_names"
);
ok(
$cxn2->same_cluster($cxn3),
"sanity check: but still finds that nodes in the same cluster belong together"
);
diag($sb->stop_sandbox($node, $node2, $node3, $node4));
}
diag($sb->stop_sandbox("master1"));
# #############################################################################
# Done.
# #############################################################################
$master_dbh->disconnect() if $master_dbh;
ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
done_testing;
exit;