percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-19 18:34:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

Clean up Pingback.pm, make it encode the client response correctly, and abstract and rewrite the tests.

Browse Source
This commit is contained in:
Daniel Nichter
2012-08-09 12:47:30 -06:00
parent 357fff7153
commit d8bb594059
3 changed files with 204 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

159
t/lib/Pingback.t
View File

@@ -11,85 +11,108 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Test::More;
use PerconaTest;
use Pingback;
my @requests;
{
package FakeUA;
sub new { bless $_[1], $_[0] }
sub request {
my ($self, $type, $url, $content) = @_;
if ( $type ne 'GET' ) {
push @requests, $content;
}
return shift @{ $self };
}
}
my $fake_ua = FakeUA->new([
{ status => 200, content => "Perl;perl_variable;PERL_VERSION\nData::Dumper;perl_variable\n" }, # GET 1
{ status => 200, }, # POST 1
{ status => 200, content => "Perl;perl_variable;PERL_VERSION\nMySQL;mysql_variable;version_comment,version\n", }, # GET 2
{ status => 200, }, # POST 2
]);
@requests = ();
Pingback::pingback('http://www.percona.com/fake_url', undef, $fake_ua);
is(
scalar @requests,
1,
"..and it sends one request"
);
my $v = sprintf('Perl,%vd', $^V);
like(
$requests[0]->{content},
qr/\Q$v/,
"..which has the expected version of Perl"
);
like(
$requests[0]->{content},
qr/\Q$Data::Dumper::VERSION/,
"..and the expected D::D version"
);
#@requests = ();
#my ($out) = full_output( sub { Pingback::pingback('http://www.percona.com/fake_url', undef, $fake_ua) } );
#
use PerconaTest;
use DSNParser;
use Sandbox;
my $dp = DSNParser->new(opts=>$dsn_opts);
my $sb = Sandbox->new(basedir => '/tmp', DSNParser => $dp);
my $dbh = $sb->get_dbh_for('master');
SKIP: {
skip 'Cannot connect to sandbox master', 3 unless $dbh;
my (undef, $mysql_version)
= $dbh->selectrow_array("SHOW VARIABLES LIKE 'version'");
my (undef, $mysql_version_comment)
= $dbh->selectrow_array("SHOW VARIABLES LIKE 'version_comment'");
@requests = ();
Pingback::pingback('http://www.percona.com/fake_url', $dbh, $fake_ua);
# #############################################################################
# Fake User Agent package, so we can simulate server responses
# and fake accepting client responses.
# #############################################################################
like(
$requests[0]->{content},
qr/\Q$v/,
"Second request has the expected version of Perl"
my $get; # server reponses
my $post; # client responses
{
package FakeUA;
sub new { bless {}, $_[0] }
sub request {
my ($self, $type, $url, $content) = @_;
return shift @$get if $type eq 'GET';
$post = $content if $type eq 'POST';
return;
}
}
my $fake_ua = FakeUA->new();
# #############################################################################
# Pingback tests
# #############################################################################
my $url = 'http://upgrade.percona.com';
my $perl_ver = sprintf '%vd', $PERL_VERSION;
my $dd_ver = $Data::Dumper::VERSION;
sub test_pingback {
my (%args) = @_;
$get = $args{get};
$post = ""; # clear previous test
eval {
Pingback::pingback(
url => $url,
dbh => $args{dbh},
ua => $fake_ua,
);
};
is(
$EVAL_ERROR,
"",
"$args{name} no error"
);
like(
$requests[0]->{content},
qr/\Q$mysql_version_comment $mysql_version/,
"..and gets the MySQL version"
is(
$post,
$args{post},
"$args{name} client response"
)
}
test_pingback(
name => "Perl version and Data::Dumper::VERSION",
# Client gets this from the server:
get => [
{ status => 200,
content => "Perl;perl_variable;PERL_VERSION\nData::Dumper;perl_variable\n",
},
],
# And it responds with this:
post => "Data::Dumper;perl_variable;$dd_ver\nPerl;perl_variable;$perl_ver\n",
);
# #############################################################################
# MySQL version
# #############################################################################
SKIP: {
skip 'Cannot connect to sandbox master', 2 unless $dbh;
my (undef, $mysql_ver)
= $dbh->selectrow_array("SHOW VARIABLES LIKE 'version'");
my (undef, $mysql_distro)
= $dbh->selectrow_array("SHOW VARIABLES LIKE 'version_comment'");
test_pingback(
name => "MySQL version",
get => [
{ status => 200,
content => "MySQL;mysql_variable;version,version_comment\n",
},
],
post => "MySQL;mysql_variable;$mysql_ver $mysql_distro\n",
dbh => $dbh,
);
}
# #############################################################################
# Done.
# #############################################################################
ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox")
if $dbh;
done_testing;
exit;