Fix Client to expect X-Percona-Resource-Type else links. Add headers to Mock/UserAgent. Start testing run_agent(). As TO_JSON() magic to Run so encode can encode Service contain blessed Run objs. Use BUILDARGS to convert Run as hashref to real objs.

This commit is contained in:
Daniel Nichter
2012-12-26 13:00:46 -07:00
parent 87080d44b2
commit 66fb54e793
9 changed files with 427 additions and 66 deletions

View File

@@ -842,9 +842,8 @@ sub get {
}
}
my $res;
eval {
$res = decode_json($self->response->content);
my $res = eval {
decode_json($self->response->content);
};
if ( $EVAL_ERROR ) {
warn sprintf "Error decoding resource: %s: %s",
@@ -854,30 +853,33 @@ sub get {
}
my $objs;
my $res_type = $self->response->headers->{'x-percona-webapi-content-type'};
if ( $res_type ) {
if ( my $type = $self->response->headers->{'x-percona-resource-type'} ) {
eval {
my $type = "Percona::WebAPI::Resource::$res_type";
my $type = "Percona::WebAPI::Resource::$type";
if ( ref $res->{content} eq 'ARRAY' ) {
PTDEBUG && _d('Got a list of', $res_type, 'resources');
foreach my $attribs ( @{$res->{content}} ) {
if ( ref $res eq 'ARRAY' ) {
PTDEBUG && _d('Got a list of', $type, 'resources');
foreach my $attribs ( @$res ) {
my $obj = $type->new(%$attribs);
push @$objs, $obj;
}
}
else {
PTDEBUG && _d('Got a', $res_type, 'resource');
$objs = $type->new(%{$res->{content}});
PTDEBUG && _d('Got a', $type, 'resource');
$objs = $type->new(%$res);
}
};
if ( $EVAL_ERROR ) {
warn "Error creating $res_type resource objects: $EVAL_ERROR";
warn "Error creating $type resource objects: $EVAL_ERROR";
return;
}
}
$self->update_links($res->{links});
elsif ( $res ) {
$self->update_links($res);
}
else {
warn "Did not get X-Percona-Resource-Type or content from $url\n";
}
return $objs;
}
@@ -983,7 +985,7 @@ sub _set {
return;
}
$self->update_links($response->{links});
$self->update_links($response);
return;
}
@@ -1024,7 +1026,7 @@ sub _request {
url => $url,
content => $content,
status => $response->code,
error => $response->content,
error => "Failed to $method $url"
);
}
@@ -1098,8 +1100,8 @@ sub as_string {
my $self = shift;
chomp(my $error = $self->error);
$error =~ s/\n/ /g;
return sprintf "Error: %s\nStatus: %d\nRequest: %s %s %s\n",
$error, $self->status, $self->method, $self->url, $self->content || '';
return sprintf "%s\nRequest: %s %s %s\nStatus: %d\n",
$error, $self->method, $self->url, $self->content || '', $self->status;
}
no Lmo;
@@ -1199,12 +1201,25 @@ has 'schedule' => (
required => 1,
);
has 'run' => (
has 'runs' => (
is => 'ro',
isa => 'ArrayRef[Percona::WebAPI::Resource::Run]',
required => 1,
);
sub BUILDARGS {
my ($class, %args) = @_;
if ( ref $args{runs} eq 'ARRAY' ) {
my @runs;
foreach my $run_hashref ( @{$args{runs}} ) {
my $run = Percona::WebAPI::Resource::Run->new(%$run_hashref);
push @runs, $run;
}
$args{runs} = \@runs;
}
return $class->SUPER::BUILDARGS(%args);
}
no Lmo;
1;
}
@@ -1249,6 +1264,8 @@ has 'output' => (
required => 1,
);
sub TO_JSON { return { %{ shift() } }; }
no Lmo;
1;
}
@@ -1277,6 +1294,8 @@ our @EXPORT_OK = (qw(resource_diff));
sub resource_diff {
my ($x, $y) = @_;
return 0 if !$x && !$y;
return 1 if ($x && !$y) || (!$x && $y);
return md5_hex(Percona::WebAPI::Representation::as_json($x))
cmp md5_hex(Percona::WebAPI::Representation::as_json($y));
}
@@ -4332,9 +4351,10 @@ use Percona::WebAPI::Resource::Config;
use Percona::WebAPI::Resource::Service;
use Percona::WebAPI::Resource::Run;
use Percona::WebAPI::Representation;
use Percona::WebAPI::Util qw(resource_diff);
use Percona::WebAPI::Util;
Percona::Toolkit->import(qw(_d Dumper have_required_args));
Percona::WebAPI::Util->import(qw(resource_diff));
use sigtrap 'handler', \&sig_int, 'normal-signals';
@@ -4377,19 +4397,17 @@ sub main {
# ########################################################################
# Check the config file.
# ########################################################################
my $home_dir = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
my $config_file = "$home_dir/.pt-agent.conf";
my $config_file = get_config_file();
if ( -f $config_file ) {
die "$config_file is not writable.\n" unless -w $config_file;
die "$config_file is not writable.\n"
unless -w $config_file;
}
else {
eval {
open my $fh, '>', $config_file
or die "Error opening $config_file: $OS_ERROR";
print { $fh } "api-key=$api_key\n"
or die "Error writing to $config_file: $OS_ERROR";
close $fh
or die "Error closing $config_file: $OS_ERROR";
init_config_file(
file => $config_file,
api_key => $api_key,
);
};
if ( $EVAL_ERROR ) {
chomp $EVAL_ERROR;
@@ -4572,7 +4590,7 @@ sub init_agent {
while ( $oktorun ) {
_info($action eq 'put' ? "Updating agent $agent_id"
: "Creating new agent $agent_id");
: "Creating new agent $agent_id");
eval {
$client->$action(
url => $client->links->{agents},
@@ -4597,13 +4615,13 @@ sub init_agent {
sub run_agent {
my (%args) = @_;
have_required_args(\%args,qw(
have_required_args(\%args, qw(
agent
client
interval
config_file
)) or die;
my $agent = $args{agent_id};
my $agent = $args{agent};
my $client = $args{client};
my $interval = $args{interval};
my $config_file = $args{config_file};
@@ -4621,7 +4639,7 @@ sub run_agent {
if ( resource_diff($config, $new_config) ) {
_info('Got new config');
write_config(
config => $config,
config => $new_config,
file => $config_file,
);
$config = $new_config;
@@ -4664,7 +4682,7 @@ sub run_agent {
sub write_config {
my (%args) = @_;
have_required_args(\%args,qw(
have_required_args(\%args, qw(
config
file
)) or die;
@@ -4683,6 +4701,14 @@ sub write_config {
return;
}
sub write_services {
return;
}
sub schedule_services {
return;
}
# #################### #
# Service process subs #
# #################### #
@@ -4704,6 +4730,31 @@ sub send_data {
# Misc and util subs #
# ################## #
sub get_config_file {
my $home_dir = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
my $config_file = "$home_dir/.pt-agent.conf";
PTDEBUG && _d('Config file:', $config_file);
return $config_file;
}
sub init_config_file {
my (%args) = @_;
have_required_args(\%args, qw(
file
api_key
)) or die;
my $file = $args{file};
my $api_key = $args{api_key};
open my $fh, '>', $file
or die "Error opening $file: $OS_ERROR";
print { $fh } "api-key=$api_key\n"
or die "Error writing to $file: $OS_ERROR";
close $fh
or die "Error closing $file: $OS_ERROR";
return;
}
sub _log {
my ($level, $msg) = @_;
my ($s, $m, $h, $d, $M) = localtime;

View File

@@ -44,12 +44,14 @@ sub request {
if ( $type eq 'post' || $type eq 'put' ) {
$self->{content}->{$type} = $req->content;
}
my $r = shift @{$self->{responses}->{$type}};
my $c = $self->{encode}->($r->{content});
my $r = shift @{$self->{responses}->{$type}};
my $c = $self->{encode}->($r->{content});
my $h = HTTP::Headers->new;
$h->header(%{$r->{headers}}) if exists $r->{headers};
my $res = HTTP::Response->new(
$r->{code} || 200,
'',
HTTP::Headers->new,
$h,
$c,
);
return $res;

View File

@@ -135,9 +135,8 @@ sub get {
# Transform the resource representations into an arrayref of hashrefs.
# Each hashref contains (hopefully) all the attribs necessary to create
# a corresponding resource object.
my $res;
eval {
$res = decode_json($self->response->content);
my $res = eval {
decode_json($self->response->content);
};
if ( $EVAL_ERROR ) {
warn sprintf "Error decoding resource: %s: %s",
@@ -147,31 +146,34 @@ sub get {
}
my $objs;
my $res_type = $self->response->headers->{'x-percona-webapi-content-type'};
if ( $res_type ) {
if ( my $type = $self->response->headers->{'x-percona-resource-type'} ) {
eval {
my $type = "Percona::WebAPI::Resource::$res_type";
my $type = "Percona::WebAPI::Resource::$type";
# Create resource objects using the server-provided attribs.
if ( ref $res->{content} eq 'ARRAY' ) {
PTDEBUG && _d('Got a list of', $res_type, 'resources');
foreach my $attribs ( @{$res->{content}} ) {
if ( ref $res eq 'ARRAY' ) {
PTDEBUG && _d('Got a list of', $type, 'resources');
foreach my $attribs ( @$res ) {
my $obj = $type->new(%$attribs);
push @$objs, $obj;
}
}
else {
PTDEBUG && _d('Got a', $res_type, 'resource');
$objs = $type->new(%{$res->{content}});
PTDEBUG && _d('Got a', $type, 'resource');
$objs = $type->new(%$res);
}
};
if ( $EVAL_ERROR ) {
warn "Error creating $res_type resource objects: $EVAL_ERROR";
warn "Error creating $type resource objects: $EVAL_ERROR";
return;
}
}
$self->update_links($res->{links});
elsif ( $res ) {
$self->update_links($res);
}
else {
warn "Did not get X-Percona-Resource-Type or content from $url\n";
}
return $objs;
}
@@ -277,7 +279,7 @@ sub _set {
return;
}
$self->update_links($response->{links});
$self->update_links($response);
return;
}
@@ -318,7 +320,7 @@ sub _request {
url => $url,
content => $content,
status => $response->code,
error => $response->content,
error => "Failed to $method $url"
);
}

View File

@@ -57,8 +57,8 @@ sub as_string {
my $self = shift;
chomp(my $error = $self->error);
$error =~ s/\n/ /g;
return sprintf "Error: %s\nStatus: %d\nRequest: %s %s %s\n",
$error, $self->status, $self->method, $self->url, $self->content || '';
return sprintf "%s\nRequest: %s %s %s\nStatus: %d\n",
$error, $self->method, $self->url, $self->content || '', $self->status;
}
no Lmo;

View File

@@ -46,6 +46,8 @@ has 'output' => (
required => 1,
);
sub TO_JSON { return { %{ shift() } }; }
no Lmo;
1;
}

View File

@@ -34,12 +34,25 @@ has 'schedule' => (
required => 1,
);
has 'run' => (
has 'runs' => (
is => 'ro',
isa => 'ArrayRef[Percona::WebAPI::Resource::Run]',
required => 1,
);
sub BUILDARGS {
my ($class, %args) = @_;
if ( ref $args{runs} eq 'ARRAY' ) {
my @runs;
foreach my $run_hashref ( @{$args{runs}} ) {
my $run = Percona::WebAPI::Resource::Run->new(%$run_hashref);
push @runs, $run;
}
$args{runs} = \@runs;
}
return $class->SUPER::BUILDARGS(%args);
}
no Lmo;
1;
}

View File

@@ -30,6 +30,8 @@ our @EXPORT_OK = (qw(resource_diff));
sub resource_diff {
my ($x, $y) = @_;
return 0 if !$x && !$y;
return 1 if ($x && !$y) || (!$x && $y);
return md5_hex(Percona::WebAPI::Representation::as_json($x))
cmp md5_hex(Percona::WebAPI::Representation::as_json($y));
}

View File

@@ -20,7 +20,7 @@ Percona::Toolkit->import(qw(Dumper));
Percona::WebAPI::Representation->import(qw(as_hashref));
my $ua = Percona::Test::Mock::UserAgent->new(
encode => sub { return encode_json(shift) },
encode => sub { my $c = shift; return encode_json($c || {}) },
);
# When Percona::WebAPI::Client is created, it gets its base_url,
@@ -28,9 +28,7 @@ my $ua = Percona::Test::Mock::UserAgent->new(
$ua->{responses}->{get} = [
{
content => {
links => {
agents => '/agents',
},
agents => '/agents',
},
},
];
@@ -58,11 +56,9 @@ is(
$ua->{responses}->{post} = [
{
content => {
links => {
agents => '/agents',
config => '/agents/123/config',
services => '/agents/123/services',
},
agents => '/agents',
config => '/agents/123/config',
services => '/agents/123/services',
},
},
];
@@ -103,7 +99,7 @@ is_deeply(
is(
scalar @wait,
0,
"Client did not wait"
"Client did not wait (new Agent)"
);
is_deeply(
@@ -116,6 +112,111 @@ is_deeply(
"Client got new links"
) or diag(Dumper($client->links));
# Repeat this test but this time fake an error, so the tool isn't
# able to create the Agent first time, so it should wait (call
# interval), and try again.
$ua->{responses}->{post} = [
{ # 1, the fake error
code => 500,
},
# 2, code should call interval
{ # 3, code should try again, then receive this
content => {
agents => '/agents',
config => '/agents/456/config',
services => '/agents/456/services',
},
},
];
@wait = ();
$output = output(
sub {
$agent = pt_agent::init_agent(
client => $client,
interval => $interval,
);
},
stderr => 1,
);
is_deeply(
as_hashref($agent),
{
id => '123',
hostname => `hostname`,
versions => {
'Percona::WebAPI::Client' => "$Percona::WebAPI::Client::VERSION",
'Perl' => sprintf '%vd', $PERL_VERSION,
}
},
'Create new Agent after error'
) or diag(Dumper(as_hashref($agent)));
is(
scalar @wait,
1,
"Client waited"
);
like(
$output,
qr{WARNING Failed to POST /agents},
"POST /agents failure logged"
);
# #############################################################################
# Init an existing agent, i.e. update it.
# #############################################################################
# When agent_id is passed to init_agent(), the tool does PUT Agent
# to tell Percona that the Agent has come online again, and to update
# the agent's versions.
$ua->{responses}->{put} = [
{
content => {
agents => '/agents',
config => '/agents/999/config',
services => '/agents/999/services',
},
},
];
@wait = ();
$output = output(
sub {
$agent = pt_agent::init_agent(
client => $client,
interval => $interval,
agent_id => '999',
);
},
stderr => 1,
);
is_deeply(
as_hashref($agent),
{
id => '999',
hostname => `hostname`,
versions => {
'Percona::WebAPI::Client' => "$Percona::WebAPI::Client::VERSION",
'Perl' => sprintf '%vd', $PERL_VERSION,
}
},
'Update old Agent'
) or diag(Dumper(as_hashref($agent)));
is(
scalar @wait,
0,
"Client did not wait (old Agent)"
);
# #############################################################################
# Done.
# #############################################################################

188
t/pt-agent/run_agent.t Normal file
View File

@@ -0,0 +1,188 @@
#!/usr/bin/env 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 JSON;
use Percona::Test;
use Percona::Test::Mock::UserAgent;
require "$trunk/bin/pt-agent";
Percona::Toolkit->import(qw(Dumper));
Percona::WebAPI::Representation->import(qw(as_hashref));
# #############################################################################
# Create mock client and Agent
# #############################################################################
# These aren't the real tests yet: to run_agent(), first we need
# a client and Agent, so create mock ones.
my $json = JSON->new;
$json->allow_blessed([]);
$json->convert_blessed([]);
my $ua = Percona::Test::Mock::UserAgent->new(
encode => sub { my $c = shift; return $json->encode($c || {}) },
);
# Create cilent, get entry links
$ua->{responses}->{get} = [
{
content => {
agents => '/agents',
},
},
];
my $links = {
agents => '/agents',
config => '/agents/1/config',
services => '/agents/1/services',
};
# Init agent, put Agent resource, return more links
$ua->{responses}->{put} = [
{
content => $links,
},
];
my $client = eval {
Percona::WebAPI::Client->new(
api_key => '123',
ua => $ua,
);
};
is(
$EVAL_ERROR,
'',
'Create mock client'
) or die;
my @wait;
my $interval = sub {
my $t = shift;
push @wait, $t;
};
my $agent;
my $output = output(
sub {
$agent = pt_agent::init_agent(
client => $client,
interval => $interval,
agent_id => 1,
);
},
stderr => 1,
);
my $have_agent = 1;
is_deeply(
as_hashref($agent),
{
id => '1',
hostname => `hostname`,
versions => {
'Percona::WebAPI::Client' => "$Percona::WebAPI::Client::VERSION",
'Perl' => sprintf '%vd', $PERL_VERSION,
}
},
'Create mock Agent'
) or $have_agent = 0;
# Can't run_agent() without and agent.
if ( !$have_agent ) {
diag(Dumper(as_hashref($agent)));
die;
}
# #############################################################################
# Test run_agent()
# #############################################################################
# The agent does just basically 2 things: check for new config, and
# check for new services. It doesn't do the latter until it has a
# config, because services require info from a config. Config are
# written to $HOME/.pt-agent.conf; this can't be changed because the
# other processes (service runner and spool checker) must share the
# same config.
my $config = Percona::WebAPI::Resource::Config->new(
options => {
'check-interval' => 60,
},
);
my $run0 = Percona::WebAPI::Resource::Run->new(
number => 0,
program => 'pt-query-digest',
options => '--output json',
output => 'spool',
);
my $svc0 = Percona::WebAPI::Resource::Service->new(
name => 'Query Monitor',
schedule => '...',
runs => [ $run0 ],
);
$ua->{responses}->{get} = [
{
headers => { 'X-Percona-Resource-Type' => 'Config' },
content => as_hashref($config),
},
{
headers => { 'X-Percona-Resource-Type' => 'Service' },
content => [ as_hashref($svc0) ],
},
];
# The only thing pt-agent must have is the API key in the config file,
# everything else relies on defaults until the first Config is gotten
# from Percona. -- The tool calls init_config_file() if the file doesn't
# exist, so we do the same. Might as well test it while we're here.
my $config_file = pt_agent::get_config_file();
unlink $config_file if -f $config_file;
pt_agent::init_config_file(file => $config_file, api_key => '123');
is(
`cat $config_file`,
"api-key=123\n",
"init_config_file()"
);
@wait = ();
$interval = sub {
my $t = shift;
push @wait, $t;
pt_agent::_err('interval');
};
#$output = output(
# sub {
pt_agent::run_agent(
agent => $agent,
client => $client,
interval => $interval,
config_file => $config_file,
);
# },
# stderr => 1,
#);
#print $output;
# #############################################################################
# Done.
# #############################################################################
done_testing;