1#!/usr/bin/perl 2 3BEGIN { 4 die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" 5 unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; 6 unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; 7}; 8 9use strict; 10use warnings FATAL => 'all'; 11use English qw(-no_match_vars); 12use Test::More; 13 14use Sandbox; 15use OptionParser; 16use DSNParser; 17use Quoter; 18use PerconaTest; 19use Cxn; 20 21use Data::Dumper; 22 23my $q = new Quoter(); 24my $dp = new DSNParser(opts=>$dsn_opts); 25my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp); 26my $master_dbh = $sb->get_dbh_for('master'); 27my $slave1_dbh = $sb->get_dbh_for('slave1'); 28my $slave1_dsn = $sb->dsn_for('slave1'); 29 30if ( !$master_dbh ) { 31 plan skip_all => 'Cannot connect to sandbox master'; 32} 33 34my $o = new OptionParser( 35 description => 'Cxn', 36 file => "$trunk/bin/pt-table-checksum", 37); 38$o->get_specs("$trunk/bin/pt-table-checksum"); 39$o->get_opts(); 40 41# In 2.1, these tests did not set innodb_lock_wait_timeout because 42# it was not a --set-vars default but rather its own option handled 43# by/in the tool. In 2.2, the var is a --set-vars default, which 44# means it will cause a warning on 5.0 and 5.1, so we remoe the var 45# to remove the warning. 46my $set_vars = $o->set_vars(); 47delete $set_vars->{innodb_lock_wait_timeout}; 48delete $set_vars->{lock_wait_timeout}; 49$dp->prop('set-vars', $set_vars); 50 51sub make_cxn { 52 my (%args) = @_; 53 $o->get_opts(); 54 return new Cxn( 55 OptionParser => $o, 56 DSNParser => $dp, 57 %args, 58 ); 59} 60 61sub test_var_val { 62 my ($dbh, $var, $val, %args) = @_; 63 64 my @row; 65 if ( !$args{user_var} ) { 66 my $sql = "SHOW " . ($args{global} ? "GLOBAL" : "SESSION " ) 67 . "VARIABLES LIKE '$var'"; 68 @row = $dbh->selectrow_array($sql); 69 } 70 else { 71 my $sql = "SELECT $var, $var"; 72 @row = $dbh->selectrow_array($sql); 73 } 74 75 if ( $args{ne} ) { 76 ok( 77 $row[1] ne $val, 78 $args{test} || "$var != $val" 79 ); 80 } 81 else { 82 is( 83 $row[1], 84 $val, 85 $args{test} || "$var = $val" 86 ); 87 } 88} 89 90# The default wait_timeout should not be 10000. Verify this so when 91# Cxn sets it, it's not coincidentally 10000, it was actually set. 92test_var_val( 93 $master_dbh, 94 'wait_timeout', 95 '10000', 96 ne =>1, 97 test => 'Default wait_timeout', 98); 99 100my $set_calls = 0; 101my $cxn = make_cxn( 102 dsn_string => 'h=127.1,P=12345,u=msandbox,p=msandbox', 103 set => sub { 104 my ($dbh) = @_; 105 warn "---------------"; 106 $set_calls++; 107 $dbh->do("SET \@a := \@a + 1"); 108 }, 109); 110 111ok( 112 !$cxn->dbh(), 113 "New Cxn, dbh not connected yet" 114); 115 116is( 117 $cxn->name(), 118 'h=127.1,P=12345', 119 'name() uses DSN if not connected' 120); 121 122$cxn->connect(); 123ok( 124 $cxn->dbh()->ping(), 125 "cxn->connect()" 126); 127 128my ($row) = $cxn->dbh()->selectrow_hashref('SHOW MASTER STATUS'); 129ok( 130 exists $row->{binlog_ignore_db}, 131 "FetchHashKeyName = NAME_lc", 132) or diag(Dumper($row)); 133 134test_var_val( 135 $cxn->dbh(), 136 'wait_timeout', 137 '10000', 138 test => 'Sets --set-vars', 139); 140 141is( 142 $set_calls, 143 1, 144 'Calls set callback' 145); 146 147$cxn->dbh()->do("SET \@a := 1"); 148test_var_val( 149 $cxn->dbh(), 150 '@a', 151 '1', 152 user_var => 1, 153); 154 155my $first_dbh = $cxn->dbh(); 156$cxn->connect(); 157my $second_dbh = $cxn->dbh(); 158 159is( 160 $first_dbh, 161 $second_dbh, 162 "Doesn't reconnect the same dbh" 163); 164 165test_var_val( 166 $cxn->dbh(), 167 '@a', 168 '1', 169 user_var => 1, 170 test => "Doesn't re-set the vars", 171); 172 173# Reconnect. 174$cxn->dbh()->disconnect(); 175$cxn->connect(); 176 177($row) = $cxn->dbh()->selectrow_hashref('SHOW MASTER STATUS'); 178ok( 179 exists $row->{binlog_ignore_db}, 180 "Reconnect FetchHashKeyName = NAME_lc", 181) or diag(Dumper($row)); 182 183test_var_val( 184 $cxn->dbh(), 185 'wait_timeout', 186 '10000', 187 test => 'Reconnect sets --set-vars', 188); 189 190is( 191 $set_calls, 192 2, 193 'Reconnect calls set callback' 194); 195 196test_var_val( 197 $cxn->dbh(), 198 '@a', 199 undef, 200 user_var => 1, 201 test => 'Reconnect is a new connection', 202); 203 204is_deeply( 205 $cxn->dsn(), 206 { 207 h => '127.1', 208 P => '12345', 209 u => 'msandbox', 210 p => 'msandbox', 211 A => undef, 212 F => undef, 213 S => undef, 214 D => undef, 215 t => undef, 216 }, 217 "cxn->dsn()" 218); 219 220my ($hostname) = $master_dbh->selectrow_array('select @@hostname'); 221is( 222 $cxn->name(), 223 $hostname, 224 'name() uses @@hostname' 225); 226 227# ############################################################################ 228# Default cxn, should be equivalent to 'h=localhost'. 229# ############################################################################ 230my $default_cxn = make_cxn(); 231is_deeply( 232 $default_cxn->dsn(), 233 { 234 h => 'localhost', 235 P => undef, 236 u => undef, 237 p => undef, 238 A => undef, 239 F => undef, 240 S => undef, 241 D => undef, 242 t => undef, 243 }, 244 "Defaults to h=localhost" 245); 246 247# But now test if it will inherit just a few standard connection options. 248@ARGV = qw(--port 12345); 249$default_cxn = make_cxn(); 250is_deeply( 251 $default_cxn->dsn(), 252 { 253 h => 'localhost', 254 P => '12345', 255 u => undef, 256 p => undef, 257 A => undef, 258 F => undef, 259 S => undef, 260 D => undef, 261 t => undef, 262 }, 263 "Default cxn inherits default connection options" 264); 265 266@ARGV = (); 267$o->get_opts(); 268 269# ############################################################################# 270# The parent of a forked Cxn should not disconnect the dbh in DESTORY 271# because the child still has access to it. 272# ############################################################################# 273 274my $sync_file = "/tmp/pt-cxn-sync.$PID"; 275my $outfile = "/tmp/pt-cxn-outfile.$PID"; 276 277my $pid; 278{ 279 my $parent_cxn = make_cxn( 280 dsn_string => 'h=127.1,P=12345,u=msandbox,p=msandbox', 281 parent => 1, 282 ); 283 $parent_cxn->connect(); 284 285 $pid = fork(); 286 if ( defined($pid) && $pid == 0 ) { 287 # I am the child. 288 # Wait for the parent to leave this code block which will cause 289 # the $parent_cxn to be destroyed. 290 PerconaTest::wait_for_files($sync_file); 291 $parent_cxn->{parent} = 0; 292 eval { 293 $parent_cxn->dbh->do("SELECT 123 INTO OUTFILE '$outfile'"); 294 $parent_cxn->dbh->disconnect(); 295 }; 296 warn $EVAL_ERROR if $EVAL_ERROR; 297 exit; 298 } 299} 300 301# Let the child know that we (the parent) have left that ^ code block, 302# so our copy of $parent_cxn has been destroyed, but hopefully the child's 303# copy is still alive, i.e. has an active/not-disconnected dbh. 304diag(`touch $sync_file`); 305 306# Wait for the child. 307waitpid($pid, 0); 308 309ok( 310 -f $outfile, 311 "Child created outfile" 312); 313 314my $output = `cat $outfile 2>/dev/null`; 315 316is( 317 $output, 318 "123\n", 319 "Child executed query" 320); 321 322unlink $sync_file if -f $sync_file; 323unlink $outfile if -f $outfile; 324 325# ############################################################################# 326# Re-connect with new DSN. 327# ############################################################################# 328 329SKIP: { 330 skip "Cannot connect to slave1", 4 unless $slave1_dbh; 331 332 $cxn = make_cxn( 333 dsn_string => 'h=127.1,P=12345,u=msandbox,p=msandbox', 334 ); 335 336 $cxn->connect(); 337 ok( 338 $cxn->dbh()->ping(), 339 "First connect()" 340 ); 341 342 ($row) = $cxn->dbh()->selectrow_hashref('SHOW SLAVE STATUS'); 343 ok( 344 !defined $row, 345 "First connect() to master" 346 ) or diag(Dumper($row)); 347 348 $cxn->dbh->disconnect(); 349 $cxn->connect(dsn => $dp->parse($slave1_dsn)); 350 351 ok( 352 $cxn->dbh()->ping(), 353 "Re-connect connect()" 354 ); 355 356 ($row) = $cxn->dbh()->selectrow_hashref('SHOW SLAVE STATUS'); 357 ok( 358 $row, 359 "Re-connect connect(slave_dsn) to slave" 360 ) or diag(Dumper($row)); 361 362 $cxn->dbh->disconnect(); 363 $cxn->connect(); 364 365 ok( 366 $cxn->dbh()->ping(), 367 "Re-re-connect connect()" 368 ); 369 370 ($row) = $cxn->dbh()->selectrow_hashref('SHOW SLAVE STATUS'); 371 ok( 372 $row, 373 "Re-re-connect connect() to slave" 374 ) or diag(Dumper($row)); 375} 376 377# ############################################################################# 378# Done. 379# ############################################################################# 380$master_dbh->disconnect() if $master_dbh; 381ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox"); 382done_testing; 383