view release on metacpan or  search on metacpan

t/bucardo.testfile  view on Meta::CPAN

	if ($type ne 'master') {
		$dbh->do("SET client_min_messages = 'warning'");
		$dbh->do("CREATE SCHEMA $TEST_SCHEMA") unless $ENV{BUCARDO_TEST_NOCREATEDB};
		$dbh->do("SET search_path = $TEST_SCHEMA");
		$dbh->do("ALTER USER $testuser SET search_path = $TEST_SCHEMA");
	}

	$dbh->commit();

	return $dbh;

} ## end of setup_database


sub shutdown_bucardo {

	my $STOPFILE = "$PIDDIR/fullstopbucardo";
	open my $stop, '>', $STOPFILE or die qq{Could not create "$STOPFILE": $!\n};
	print {$stop} "Stopped by $0 on " . (scalar localtime) . "\n";
	close $stop or warn qq{Could not close "$STOPFILE": $!\n};

	pass(" Existing Bucardo asked to shut down");

    ## Find a grep we can use.

    my $grep_path = $ENV{GREP_PATH}     ||
                    qx!which grep!      ||
                    qx!whereis -b grep!;
    if (defined $grep_path) {
        $grep_path =~ s!\Agrep: /!!;
        $grep_path =~ s!\n\z!!;
    }
    else {
        for my $path (grep { -x } qw!/bin/grep /usr/bin/grep /usr/local/bin/grep!) {
            $grep_path = $path;
            last;
        }
    }

    BAIL_OUT q!Cannot find a usable "grep"; set GREP_PATH!
        unless -x $grep_path;

	my $loop = 1;
	{
		my $res = qx{/bin/ps -Afwww | $grep_path Bucardo | $grep_path $xname | $grep_path -v grep}; ## no critic
		last if $res !~ /Bucardo/m;
		if ($loop++ > 10) {
			BAIL_OUT "Could not persuade existing Bucardo to shut down\n";
		}
		sleep 1;
		redo;
	}

	return;

} ## end of shutdown_bucardo


sub wait_until_true {

	my $xline = (caller)[2];
	my $dbh = shift or die "Need a database handle (from line $xline)\n";
	my $sql = shift or die "Need a SQL statement (from line $xline)\n";
	my $timeout = shift || $TIMEOUT_SYNCWAIT;
	my $sleep = shift || $TIMEOUT_SLEEP;
	my $type = shift || 'true';
	my $line = shift || $xline;

	alarm $timeout;
	$sth = $dbh->prepare($sql);
	eval {
	  W: {
			$count = $sth->execute();
			$sth->finish();
			$dbh->commit();
			last if ($type eq 'true' and $count >= 1) or ($type eq 'false' and $count < 1);
			sleep $sleep;
			redo;
		}
	};
	$count = alarm 0;
	return $count unless $@;
	my $db = $dbmap{$dbh} || '?';
	BAIL_OUT (qq{Gave up waiting for "$sql" on db "$db" to be $type: timed out at $timeout from line $line ($@)});
	return;

} ## end of wait_until_true


sub wait_until_false {

	my $xline = (caller)[2];
	my $dbh = shift or die "Need a database handle (from line $xline)\n";
	my $sql = shift or die "Need a SQL statement (from line $xline)\n";
	my $timeout = shift || $TIMEOUT_SYNCWAIT;
	my $sleep = shift || $TIMEOUT_SLEEP;
	return wait_until_true($dbh,$sql,$timeout,$sleep,'false',$xline);

} ## end of wait_until_false

sub clean_all_tables {

	## Reset out test databases to their original state
	## Empty out all data from the tables
	## Remove any triggers added
	## Drop the helper bucardo schema

	$masterdbh->rollback();
	$masterdbh->do("DELETE FROM sync"); ## Needs to go first due to trigger tek

	for my $dbh ($dbh1,$dbh2,$dbh3) {
		$dbh->rollback();
		for my $table (sort keys %tabletype) {
			$dbh->do("TRUNCATE TABLE $table");
			$SQL = "SELECT tgname FROM pg_trigger WHERE tgrelid = (SELECT oid FROM pg_class WHERE relname = '$table')";
			for (@{$dbh->selectall_arrayref($SQL)}) {
				next if $_->[0] =~ /^bctrig_/o;
				$dbh->do("DROP TRIGGER $_->[0] ON $table");
			}
		}
		## Nuke the entire bucardo schema if it exists
		if (object_count($dbh,'bucardo','schema','')) {
			$dbh->do("DROP SCHEMA bucardo CASCADE");
		}
		$dbh->do("TRUNCATE TABLE droptest");
		$dbh->commit();
	}
	$masterdbh->do("DELETE FROM q");
	$masterdbh->do("DELETE FROM audit_pid");
	$masterdbh->commit();
	pass(" Finished clean_all_tables");
	return;

} ## end of clean_all_tables

sub clean_swap_table {

	## Empty out swap table and associated tables on one or more databases
	my ($table,$dbs) = @_;
	for my $dbh (@{$dbs}) {
		$dbh->rollback;
	}
	for my $dbh (@{$dbs}) {
		my $oid = $table{$dbh}{$table};
		$dbh->do("DELETE FROM $table");
		$dbh->do("DELETE FROM bucardo.bucardo_track WHERE tablename = $oid");
		$dbh->do("DELETE FROM bucardo.bucardo_delta WHERE tablename = $oid");
		$dbh->do("DELETE FROM bucardo.bucardo_track");
		$dbh->do("DELETE FROM bucardo.bucardo_delta");
		$dbh->commit;
	}
	return;

t/bucardo.testfile  view on Meta::CPAN

	if (!$@) {
		## diag "End bucardo_ctl with $command\n";
		return $count;
	}

	if ($@ =~ /Timed out/) {
		system("touch $PIDDIR/fullstopbucardo");
		BAIL_OUT("bucardo_ctl was not invoked: is the bucardo.test.helper file running? (command=$command)");
	}
	BAIL_OUT("bucardo_ctl gave an error: $@");

	return;

} ## end of bucardo_ctl


sub wait4kid {

	my $notice = shift;
	my $timeout = shift || $ALARM_WAIT4KID;

	$SQL = "SELECT 1 FROM pg_catalog.pg_listener WHERE relname = ?";
	my $listen = $masterdbh->prepare($SQL);
	alarm $timeout;
	eval {
	  S: {
			$count = $listen->execute($notice);
			$listen->finish();
			last if $count == 1;
			sleep 0.1;
			redo;
		}
	};
	$count = alarm 0;
	return $count unless $@;
	BAIL_OUT("Waited too long ($timeout) for kid to LISTEN to $notice");
	return;

} ## end of wait4kid

sub wait_for_notice {

	my $dbh = shift;
	my $text = shift;
	my $timeout = shift || $TIMEOUT_NOTICE;
	my $sleep = shift || $TIMEOUT_SLEEP;

	my $n;
	alarm $timeout;
	eval {
	  N: {
			while ($n = $dbh->func('pg_notifies')) {
				last N if $n->[0] eq $text;
			}
			sleep $sleep;
			redo;
		}
	};
	$count = alarm 0;
	return $count unless $@;
	my $line = (caller)[2];
	BAIL_OUT (qq{Gave up waiting for notice "$text": timed out at $timeout from line $line ($@)});
	return;

} ## end of wait_for_notice


## no critic
{
	no warnings; ## Yes, we know they are being redefined!
	sub is_deeply {
		t($_[2],$_[3] || (caller)[2]);
		return if Test::More::is_deeply($_[0],$_[1],$testmsg);
		if ($bail_on_error > $total_errors++) {
			my $line = (caller)[2];
			my $time = time;
			diag("GOT: ".Dumper $_[0]);
			diag("EXPECTED: ". Dumper $_[1]);
			BAIL_OUT "Stopping on a failed 'is_deeply' test from line $line. Time: $time";
		}
	} ## end of is_deeply
	sub like {
		t($_[2],(caller)[2]);
		return if Test::More::like($_[0],$_[1],$testmsg);
		if ($bail_on_error > $total_errors++) {
			my $line = (caller)[2];
			my $time = time;
			BAIL_OUT "Stopping on a failed 'like' test from line $line. Time: $time";
		}
	} ## end of like
	sub pass {
		t($_[0],$_[1]||(caller)[2]);
		Test::More::pass($testmsg);
	} ## end of pass
	sub is {
		t($_[2],(caller)[2]);
		return if Test::More::is($_[0],$_[1],$testmsg);
		if ($bail_on_error > $total_errors++) {
			my $line = (caller)[2];
			my $time = time;
			BAIL_OUT "Stopping on a failed 'is' test from line $line. Time: $time";
		}
	} ## end of is
	sub isa_ok {
		t("Object isa $_[1]",(caller)[2]);
		my ($name, $type, $msg) = ($_[0],$_[1]);
		if (ref $name and ref $name eq $type) {
			Test::More::pass($testmsg);
			return;
		}
		$bail_on_error > $total_errors++ and BAIL_OUT "Stopping on a failed test";
	} ## end of isa_ok
	sub ok {
		t($_[1]||$testmsg);
		return if Test::More::ok($_[0],$testmsg);
		if ($bail_on_error > $total_errors++) {
			my $line = (caller)[2];
			my $time = time;
			BAIL_OUT "Stopping on a failed 'ok' test from line $line. Time: $time";
		}
	} ## end of ok
}
## use critic


sub now_time {
	my $dbh = shift;
	return $dbh->selectall_arrayref("SELECT now()")->[0][0];
} ## end of now_time


sub bc_deeply {

	my ($exp,$dbh,$sql,$msg) = @_;
	my $line = (caller)[2];

	local $Data::Dumper::Terse = 1;
	local $Data::Dumper::Indent = 0;

	die "Very invalid statement from line $line: $sql\n" if $sql !~ /^\s*select/i;

	my $got;
	eval {
		$got = $dbh->selectall_arrayref($sql);
	};
	if ($@) {
		die "bc_deeply failed from line $line. SQL=$sql\n";
	}

	return is_deeply($got,$exp,$msg,(caller)[2]);

} ## end of bc_deeply


sub compare_tables {

	my ($table,$sdbh,$rdbh) = @_;

	my ($line) = (caller)[2];

	local $Data::Dumper::Terse = 1;
	local $Data::Dumper::Indent = 0;

	my $msg = "Table $table is the same on both databases";
	$SQL = "SELECT * FROM $table ORDER BY inty, id";
	$SQL =~ s/inty, // if $table =~ /0/;
	my $uno = $sdbh->selectall_arrayref($SQL);
	my $dos = $rdbh->selectall_arrayref($SQL);
	if ((Dumper $uno) eq (Dumper $dos)) {
		pass($msg,$line);
		return 1;
	}

	return is_deeply($uno,$dos,$msg,$line);

} ## end of compare_tables


sub tt {
	## Simple timing routine. Call twice with the same arg, before and after
	my $name = shift or die qq{Need a name!\n};
	if (exists $timing{$name}) {
		my $newtime = tv_interval($timing{$name});
		warn "Timing for $name: $newtime\n";
		delete $timing{$name};
	}
	else {
		$timing{$name} = [gettimeofday];
	}
	return;
} ## end of tt

sub t {
	$testmsg = shift;
	$testline = shift || (caller)[2];
	$testmsg =~ s/^\s+//;
	if ($location) {
		$testmsg = "($location) $testmsg";
	}
	if ($showline) {
		$testmsg .= " [line: $testline]";
	}
	if ($showtime) {
		my $time = time;
		$testmsg .= " [time: $time]";
	}
} ## end of t


sub exitnow {
	$need_shutdown = 0;
	exit;
} ## end of exitnow



sub test_customcode_methods {

	## Test methods related to custom code: customcode, remove_customcode

	$location = 'customcode_methods';

	my ($code, $codeid);

	$t=q{ Method customcode fails if no arguments are given };
	eval { $bc->customcode(); };
	like($@, qr{must be a hashref}, $t);

	$t=q{ Method customcode fails if no 'src_code' argument given };
	eval { $bc->customcode({name => 'test'}); };
	like($@, qr{\QAttribute (src_code) is required}, $t);

	$t=q{ Method customcode fails if no 'name' argument given };
	eval { $bc->customcode({src_code => 'foo'}); };
	like($@, qr{\QAttribute (name) is required}, $t);

	$t=q{ Method customcode fails if no 'whenrun' argument given };
	eval { $bc->customcode({name => 'test', src_code => 'foo'}); };
	like($@, qr{\QAttribute (whenrun) is required}, $t);

	$t=q{ Method customcode fails if 'whenrun' is invalid };
	eval { $bc->customcode({name => 'test', src_code => 'foo', whenrun => 'invalid'}); };
	like($@, qr{violates check constraint "customcode_whenrun"}, $t);

	$t=q{ Method customcode works if given valid arguments };
	eval { $code = $bc->customcode({name => 'test', src_code => 'foo', whenrun => 'before_txn'}); };
	is($@, q{}, $t);

	$t=q{ Method customcode returns a hashref };
	is(ref $code, 'HASH', $t);

	$t=q{ Method customcode returns a hashref containing a numeric 'id' key };
	$codeid = $code->{id} || 0;
	like($codeid, qr{^\d$}, $t);