mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-10 05:00:45 +00:00
Remove pt-agent.
This commit is contained in:
Daniel Nichter
@@ -1,341 +0,0 @@
|
||||
# This program is copyright 2013 Percona Ireland Ltd.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::Agent::Logger package
|
||||
# ###########################################################################
|
||||
package Percona::Agent::Logger;
|
||||
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
||||
|
||||
use POSIX qw(SIGALRM);
|
||||
|
||||
use Lmo;
|
||||
use Transformers;
|
||||
use Percona::WebAPI::Resource::LogEntry;
|
||||
|
||||
Transformers->import(qw(ts));
|
||||
|
||||
has 'exit_status' => (
|
||||
is => 'rw',
|
||||
isa => 'ScalarRef',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'pid' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'service' => (
|
||||
is => 'rw',
|
||||
isa => 'Maybe[Str]',
|
||||
required => 0,
|
||||
default => sub { return; },
|
||||
);
|
||||
|
||||
has 'data_ts' => (
|
||||
is => 'rw',
|
||||
isa => 'Maybe[Int]',
|
||||
required => 0,
|
||||
default => sub { return; },
|
||||
);
|
||||
|
||||
has 'online_logging' => (
|
||||
is => 'ro',
|
||||
isa => 'Bool',
|
||||
required => 0,
|
||||
default => sub { return 1 },
|
||||
);
|
||||
|
||||
has 'online_logging_enabled' => (
|
||||
is => 'rw',
|
||||
isa => 'Bool',
|
||||
required => 0,
|
||||
default => sub { return 0 },
|
||||
);
|
||||
|
||||
has 'quiet' => (
|
||||
is => 'rw',
|
||||
isa => 'Int',
|
||||
required => 0,
|
||||
default => sub { return 0 },
|
||||
);
|
||||
|
||||
has '_buffer' => (
|
||||
is => 'rw',
|
||||
isa => 'ArrayRef',
|
||||
required => 0,
|
||||
default => sub { return []; },
|
||||
);
|
||||
|
||||
has '_pipe_write' => (
|
||||
is => 'rw',
|
||||
isa => 'Maybe[FileHandle]',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
sub read_stdin {
|
||||
my ( $t ) = @_;
|
||||
|
||||
# Set the SIGALRM handler.
|
||||
POSIX::sigaction(
|
||||
SIGALRM,
|
||||
POSIX::SigAction->new(sub { die 'read timeout'; }),
|
||||
) or die "Error setting SIGALRM handler: $OS_ERROR";
|
||||
|
||||
my $timeout = 0;
|
||||
my @lines;
|
||||
eval {
|
||||
alarm $t;
|
||||
while(defined(my $line = <STDIN>)) {
|
||||
push @lines, $line;
|
||||
}
|
||||
alarm 0;
|
||||
};
|
||||
if ( $EVAL_ERROR ) {
|
||||
PTDEBUG && _d('Read error:', $EVAL_ERROR);
|
||||
die $EVAL_ERROR unless $EVAL_ERROR =~ m/read timeout/;
|
||||
$timeout = 1;
|
||||
}
|
||||
return unless scalar @lines || $timeout;
|
||||
return \@lines;
|
||||
}
|
||||
|
||||
sub start_online_logging {
|
||||
my ($self, %args) = @_;
|
||||
my $client = $args{client};
|
||||
my $log_link = $args{log_link};
|
||||
my $read_timeout = $args{read_timeout} || 3;
|
||||
|
||||
return unless $self->online_logging;
|
||||
|
||||
my $pid = open(my $pipe_write, "|-");
|
||||
|
||||
if ($pid) {
|
||||
# parent
|
||||
select $pipe_write;
|
||||
$OUTPUT_AUTOFLUSH = 1;
|
||||
$self->_pipe_write($pipe_write);
|
||||
$self->online_logging_enabled(1);
|
||||
}
|
||||
else {
|
||||
# child
|
||||
my @log_entries;
|
||||
my $n_errors = 0;
|
||||
my $oktorun = 1;
|
||||
QUEUE:
|
||||
while ($oktorun) {
|
||||
my $lines = read_stdin($read_timeout);
|
||||
last QUEUE unless $lines;
|
||||
LINE:
|
||||
while ( defined(my $line = shift @$lines) ) {
|
||||
# $line = ts,level,n_lines,message
|
||||
my ($ts, $level, $n_lines, $msg) = $line =~ m/^([^,]+),([^,]+),([^,]+),(.+)/s;
|
||||
if ( !$ts || !$level || !$n_lines || !$msg ) {
|
||||
warn "$line\n";
|
||||
next LINE;
|
||||
}
|
||||
if ( $n_lines > 1 ) {
|
||||
$n_lines--; # first line
|
||||
for ( 1..$n_lines ) {
|
||||
$msg .= shift @$lines;
|
||||
}
|
||||
}
|
||||
|
||||
push @log_entries, Percona::WebAPI::Resource::LogEntry->new(
|
||||
pid => $self->pid,
|
||||
entry_ts => $ts,
|
||||
log_level => $level,
|
||||
message => $msg,
|
||||
($self->service ? (service => $self->service) : ()),
|
||||
($self->data_ts ? (data_ts => $self->data_ts) : ()),
|
||||
);
|
||||
} # LINE
|
||||
|
||||
if ( scalar @log_entries ) {
|
||||
eval {
|
||||
$client->post(
|
||||
link => $log_link,
|
||||
resources => \@log_entries,
|
||||
);
|
||||
};
|
||||
if ( my $e = $EVAL_ERROR ) {
|
||||
# Safegaurd: don't spam the agent log file with errors.
|
||||
if ( ++$n_errors <= 10 ) {
|
||||
warn "Error sending log entry to API: $e";
|
||||
if ( $n_errors == 10 ) {
|
||||
my $ts = ts(time, 1); # 1=UTC
|
||||
warn "$ts WARNING $n_errors consecutive errors, no more "
|
||||
. "error messages will be printed until log entries "
|
||||
. "are sent successfully again.\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
@log_entries = ();
|
||||
$n_errors = 0;
|
||||
}
|
||||
} # have log entries
|
||||
|
||||
# Safeguard: don't use too much memory if we lose connection
|
||||
# to the API for a long time.
|
||||
my $n_log_entries = scalar @log_entries;
|
||||
if ( $n_log_entries > 1_000 ) {
|
||||
warn "$n_log_entries log entries in send buffer, "
|
||||
. "removing first 100 to avoid excessive usage.\n";
|
||||
@log_entries = @log_entries[100..($n_log_entries-1)];
|
||||
}
|
||||
} # QUEUE
|
||||
|
||||
if ( scalar @log_entries ) {
|
||||
my $ts = ts(time, 1); # 1=UTC
|
||||
warn "$ts WARNING Failed to send these log entries "
|
||||
. "(timestamps are UTC):\n";
|
||||
foreach my $log ( @log_entries ) {
|
||||
warn sprintf("%s %s %s\n",
|
||||
$log->entry_ts,
|
||||
level_name($log->log_level),
|
||||
$log->message,
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
exit 0;
|
||||
} # child
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub level_number {
|
||||
my $name = shift;
|
||||
die "No log level name given" unless $name;
|
||||
my $number = $name eq 'DEBUG' ? 1
|
||||
: $name eq 'INFO' ? 2
|
||||
: $name eq 'WARNING' ? 3
|
||||
: $name eq 'ERROR' ? 4
|
||||
: $name eq 'FATAL' ? 5
|
||||
: die "Invalid log level name: $name";
|
||||
}
|
||||
|
||||
sub level_name {
|
||||
my $number = shift;
|
||||
die "No log level name given" unless $number;
|
||||
my $name = $number == 1 ? 'DEBUG'
|
||||
: $number == 2 ? 'INFO'
|
||||
: $number == 3 ? 'WARNING'
|
||||
: $number == 4 ? 'ERROR'
|
||||
: $number == 5 ? 'FATAL'
|
||||
: die "Invalid log level number: $number";
|
||||
}
|
||||
|
||||
sub debug {
|
||||
my $self = shift;
|
||||
return if $self->online_logging;
|
||||
return $self->_log(0, 'DEBUG', @_);
|
||||
}
|
||||
|
||||
sub info {
|
||||
my $self = shift;
|
||||
return $self->_log(1, 'INFO', @_);
|
||||
}
|
||||
|
||||
sub warning {
|
||||
my $self = shift;
|
||||
$self->_set_exit_status();
|
||||
return $self->_log(1, 'WARNING', @_);
|
||||
}
|
||||
|
||||
sub error {
|
||||
my $self = shift;
|
||||
$self->_set_exit_status();
|
||||
return $self->_log(1, 'ERROR', @_);
|
||||
}
|
||||
|
||||
sub fatal {
|
||||
my $self = shift;
|
||||
$self->_set_exit_status();
|
||||
$self->_log(1, 'FATAL', @_);
|
||||
exit $self->exit_status;
|
||||
}
|
||||
|
||||
sub _set_exit_status {
|
||||
my $self = shift;
|
||||
# exit_status is a scalar ref
|
||||
my $exit_status = $self->exit_status; # get ref
|
||||
$$exit_status |= 1; # deref to set
|
||||
$self->exit_status($exit_status); # save back ref
|
||||
return;
|
||||
}
|
||||
|
||||
sub _log {
|
||||
my ($self, $online, $level, $msg) = @_;
|
||||
|
||||
my $ts = ts(time, 1); # 1=UTC
|
||||
my $level_number = level_number($level);
|
||||
|
||||
return if $self->quiet && $level_number < $self->quiet;
|
||||
|
||||
chomp($msg);
|
||||
my $n_lines = 1;
|
||||
$n_lines++ while $msg =~ m/\n/g;
|
||||
|
||||
if ( $online && $self->online_logging_enabled ) {
|
||||
while ( defined(my $log_entry = shift @{$self->_buffer}) ) {
|
||||
$self->_queue_log_entry(@$log_entry);
|
||||
}
|
||||
$self->_queue_log_entry($ts, $level_number, $n_lines, $msg);
|
||||
}
|
||||
else {
|
||||
if ( $online && $self->online_logging ) {
|
||||
push @{$self->_buffer}, [$ts, $level_number, $n_lines, $msg];
|
||||
}
|
||||
|
||||
if ( $level_number >= 3 ) { # warning
|
||||
print STDERR "$ts $level $msg\n";
|
||||
}
|
||||
else {
|
||||
print STDOUT "$ts $level $msg\n";
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _queue_log_entry {
|
||||
my ($self, $ts, $log_level, $n_lines, $msg) = @_;
|
||||
print "$ts,$log_level,$n_lines,$msg\n";
|
||||
return;
|
||||
}
|
||||
|
||||
sub _d {
|
||||
my ($package, undef, $line) = caller 0;
|
||||
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
|
||||
map { defined $_ ? $_ : 'undef' }
|
||||
@_;
|
||||
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
|
||||
}
|
||||
|
||||
no Lmo;
|
||||
1;
|
||||
# ###########################################################################
|
||||
# End Percona::Agent::Logger package
|
||||
# ###########################################################################
|
||||
@@ -1,129 +0,0 @@
|
||||
# This program is copyright 2013 Percona Ireland Ltd.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::Agent::Logger package
|
||||
# ###########################################################################
|
||||
package Percona::Test::Mock::AgentLogger;
|
||||
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
||||
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
my $self = {
|
||||
log => $args{log},
|
||||
|
||||
exit_status => $args{exit_status},
|
||||
pid => $args{pid},
|
||||
online_logging => $args{online_logging},
|
||||
|
||||
service => undef,
|
||||
data_ts => undef,
|
||||
quiet => 0,
|
||||
|
||||
};
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
sub service {
|
||||
my $self = shift;
|
||||
my $_service = shift;
|
||||
$self->{service} = $_service if $_service;
|
||||
return $self->{service};
|
||||
}
|
||||
|
||||
sub data_ts {
|
||||
my $self = shift;
|
||||
my $_data_ts = shift;
|
||||
$self->{data_ts} = $_data_ts if $_data_ts;
|
||||
return $self->{data_ts};
|
||||
}
|
||||
|
||||
sub quiet {
|
||||
my $self = shift;
|
||||
my $_quiet = shift;
|
||||
$self->{quiet} = $_quiet if $_quiet;
|
||||
return $self->{quiet};
|
||||
}
|
||||
|
||||
sub start_online_logging {
|
||||
my ($self, %args) = @_;
|
||||
$self->_log('-', 'Called start_online_logging()');
|
||||
return;
|
||||
}
|
||||
|
||||
sub level_number {
|
||||
my $name = shift;
|
||||
die "No log level name given" unless $name;
|
||||
my $number = $name eq 'DEBUG' ? 1
|
||||
: $name eq 'INFO' ? 2
|
||||
: $name eq 'WARNING' ? 3
|
||||
: $name eq 'ERROR' ? 4
|
||||
: $name eq 'FATAL' ? 5
|
||||
: die "Invalid log level name: $name";
|
||||
}
|
||||
|
||||
sub level_name {
|
||||
my $number = shift;
|
||||
die "No log level name given" unless $number;
|
||||
my $name = $number == 1 ? 'DEBUG'
|
||||
: $number == 2 ? 'INFO'
|
||||
: $number == 3 ? 'WARNING'
|
||||
: $number == 4 ? 'ERROR'
|
||||
: $number == 5 ? 'FATAL'
|
||||
: die "Invalid log level number: $number";
|
||||
}
|
||||
|
||||
sub debug {
|
||||
my $self = shift;
|
||||
return $self->_log('DEBUG', @_);
|
||||
}
|
||||
|
||||
sub info {
|
||||
my $self = shift;
|
||||
return $self->_log('INFO', @_);
|
||||
}
|
||||
|
||||
sub warning {
|
||||
my $self = shift;
|
||||
return $self->_log('WARNING', @_);
|
||||
}
|
||||
|
||||
sub error {
|
||||
my $self = shift;
|
||||
return $self->_log('ERROR', @_);
|
||||
}
|
||||
|
||||
sub fatal {
|
||||
my $self = shift;
|
||||
$self->_log('FATAL', @_);
|
||||
return 255;
|
||||
}
|
||||
|
||||
sub _log {
|
||||
my ($self, $level, $msg) = @_;
|
||||
push @{$self->{log}}, "$level $msg";
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
# ###########################################################################
|
||||
# End Percona::Test::Mock::AgentLogger package
|
||||
# ###########################################################################
|
||||
@@ -1,71 +0,0 @@
|
||||
# This program is copyright 2012-2013 Percona Inc.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::Test::Mock::UserAgent package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::Test::Mock::UserAgent;
|
||||
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
my $self = {
|
||||
encode => $args{encode} || sub { return $_[0] },
|
||||
decode => $args{decode} || sub { return $_[0] },
|
||||
requests => [],
|
||||
request_objs => [],
|
||||
responses => {
|
||||
get => [],
|
||||
post => [],
|
||||
put => [],
|
||||
},
|
||||
content => {
|
||||
post => [],
|
||||
put => [],
|
||||
},
|
||||
};
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
sub request {
|
||||
my ($self, $req) = @_;
|
||||
if ( scalar @{$self->{request_objs}} > 10 ) {
|
||||
$self->{request_objs} = [];
|
||||
}
|
||||
push @{$self->{request_objs}}, $req;
|
||||
my $type = lc($req->method);
|
||||
push @{$self->{requests}}, uc($type) . ' ' . $req->uri;
|
||||
if ( $type eq 'post' || $type eq 'put' ) {
|
||||
push @{$self->{content}->{$type}}, $req->content;
|
||||
}
|
||||
my $r = shift @{$self->{responses}->{$type}};
|
||||
my $c = $r->{content} ? $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,
|
||||
'',
|
||||
$h,
|
||||
$c,
|
||||
);
|
||||
return $res;
|
||||
}
|
||||
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::Test::Mock::UserAgent package
|
||||
# ###########################################################################
|
||||
@@ -1,321 +0,0 @@
|
||||
# This program is copyright 2012 codenode LLC, 2012-2013 Percona Ireland Ltd.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::WebAPI::Client package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::WebAPI::Client;
|
||||
|
||||
our $VERSION = '0.01';
|
||||
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
||||
|
||||
eval {
|
||||
require LWP;
|
||||
require JSON;
|
||||
};
|
||||
|
||||
use Scalar::Util qw(blessed);
|
||||
|
||||
use Lmo;
|
||||
use Percona::Toolkit;
|
||||
use Percona::WebAPI::Representation;
|
||||
use Percona::WebAPI::Exception::Request;
|
||||
use Percona::WebAPI::Exception::Resource;
|
||||
|
||||
Percona::WebAPI::Representation->import(qw(as_json));
|
||||
Percona::Toolkit->import(qw(_d Dumper have_required_args));
|
||||
|
||||
has 'api_key' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'entry_link' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
required => 0,
|
||||
default => sub { return 'https://cloud-api.percona.com' },
|
||||
);
|
||||
|
||||
has 'ua' => (
|
||||
is => 'rw',
|
||||
isa => 'Object',
|
||||
lazy => 1,
|
||||
required => 0,
|
||||
builder => '_build_ua',
|
||||
);
|
||||
|
||||
has 'response' => (
|
||||
is => 'rw',
|
||||
isa => 'Object',
|
||||
required => 0,
|
||||
default => undef,
|
||||
);
|
||||
|
||||
sub _build_ua {
|
||||
my $self = shift;
|
||||
my $ua = LWP::UserAgent->new;
|
||||
$ua->agent("Percona::WebAPI::Client/$Percona::WebAPI::Client::VERSION");
|
||||
$ua->default_header('Content-Type', 'application/json');
|
||||
$ua->default_header('X-Percona-API-Key', $self->api_key);
|
||||
return $ua;
|
||||
}
|
||||
|
||||
sub get {
|
||||
my ($self, %args) = @_;
|
||||
|
||||
have_required_args(\%args, qw(
|
||||
link
|
||||
)) or die;
|
||||
my ($link) = $args{link};
|
||||
|
||||
# Get the resources at the link.
|
||||
eval {
|
||||
$self->_request(
|
||||
method => 'GET',
|
||||
link => $link,
|
||||
);
|
||||
};
|
||||
if ( my $e = $EVAL_ERROR ) {
|
||||
if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
|
||||
die $e;
|
||||
}
|
||||
else {
|
||||
die "Unknown error: $e";
|
||||
}
|
||||
}
|
||||
|
||||
# The resource should be represented as JSON, decode it.
|
||||
my $resource = eval {
|
||||
JSON::decode_json($self->response->content);
|
||||
};
|
||||
if ( $EVAL_ERROR ) {
|
||||
warn sprintf "Error decoding resource: %s: %s",
|
||||
$self->response->content,
|
||||
$EVAL_ERROR;
|
||||
return;
|
||||
}
|
||||
|
||||
# If the server tells us the resource's type, create a new object
|
||||
# of that type. Else, if there's no type, there's no resource, so
|
||||
# we should have received links. This usually only happens for the
|
||||
# entry link. The returned resource objects ref may be scalar or
|
||||
# an arrayref; the caller should know.
|
||||
my $resource_objects;
|
||||
if ( my $type = $self->response->headers->{'x-percona-resource-type'} ) {
|
||||
eval {
|
||||
$type = "Percona::WebAPI::Resource::$type";
|
||||
if ( ref $resource eq 'ARRAY' ) {
|
||||
PTDEBUG && _d('Got a list of', $type, 'resources');
|
||||
$resource_objects = [];
|
||||
foreach my $attribs ( @$resource ) {
|
||||
my $obj = $type->new(%$attribs);
|
||||
push @$resource_objects, $obj;
|
||||
}
|
||||
}
|
||||
else {
|
||||
PTDEBUG && _d('Got a', $type, 'resource', Dumper($resource));
|
||||
$resource_objects = $type->new(%$resource);
|
||||
}
|
||||
};
|
||||
if ( my $e = $EVAL_ERROR ) {
|
||||
die Percona::WebAPI::Exception::Resource->new(
|
||||
type => $type,
|
||||
link => $link,
|
||||
data => (ref $resource eq 'ARRAY' ? $resource : [ $resource ]),
|
||||
error => $e,
|
||||
);
|
||||
}
|
||||
}
|
||||
elsif ( exists $resource->{links} ) {
|
||||
# Lie to the caller: this isn't an object, but the caller can
|
||||
# treat it like one, e.g. my $links = $api->get(<entry links>);
|
||||
# then access $links->{self}. A Links object couldn't have
|
||||
# dynamic attribs anyway, so no use having a real Links obj.
|
||||
$resource_objects = $resource->{links};
|
||||
}
|
||||
elsif ( exists $resource->{pong} ) {
|
||||
PTDEBUG && _d("Ping pong!");
|
||||
}
|
||||
else {
|
||||
warn "Did not get X-Percona-Resource-Type or links from $link\n";
|
||||
}
|
||||
|
||||
return $resource_objects;
|
||||
}
|
||||
|
||||
# For a successful POST, the server sets the Location header with
|
||||
# the URI of the newly created resource.
|
||||
sub post {
|
||||
my $self = shift;
|
||||
$self->_set(
|
||||
@_,
|
||||
method => 'POST',
|
||||
);
|
||||
return $self->response->header('Location');
|
||||
}
|
||||
|
||||
sub put {
|
||||
my $self = shift;
|
||||
$self->_set(
|
||||
@_,
|
||||
method => 'PUT',
|
||||
);
|
||||
return $self->response->header('Location');
|
||||
}
|
||||
|
||||
sub delete {
|
||||
my ($self, %args) = @_;
|
||||
have_required_args(\%args, qw(
|
||||
link
|
||||
)) or die;
|
||||
my ($link) = $args{link};
|
||||
|
||||
eval {
|
||||
$self->_request(
|
||||
method => 'DELETE',
|
||||
link => $link,
|
||||
headers => { 'Content-Length' => 0 },
|
||||
);
|
||||
};
|
||||
if ( my $e = $EVAL_ERROR ) {
|
||||
if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
|
||||
die $e;
|
||||
}
|
||||
else {
|
||||
die "Unknown error: $e";
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# Low-level POST and PUT handler.
|
||||
sub _set {
|
||||
my ($self, %args) = @_;
|
||||
have_required_args(\%args, qw(
|
||||
method
|
||||
resources
|
||||
link
|
||||
)) or die;
|
||||
my $method = $args{method};
|
||||
my $res = $args{resources};
|
||||
my $link = $args{link};
|
||||
|
||||
# Optional args
|
||||
my $headers = $args{headers};
|
||||
|
||||
my $content = '';
|
||||
if ( ref($res) eq 'ARRAY' ) {
|
||||
PTDEBUG && _d('List of resources');
|
||||
$content = '[' . join(",\n", map { as_json($_) } @$res) . ']';
|
||||
}
|
||||
elsif ( ref($res) ) {
|
||||
PTDEBUG && _d('Resource object');
|
||||
$content = as_json($res);
|
||||
}
|
||||
elsif ( $res !~ m/\n/ && -f $res ) {
|
||||
PTDEBUG && _d('List of resources in file', $res);
|
||||
$content = '[';
|
||||
my $data = do {
|
||||
local $INPUT_RECORD_SEPARATOR = undef;
|
||||
open my $fh, '<', $res
|
||||
or die "Error opening $res: $OS_ERROR";
|
||||
<$fh>;
|
||||
};
|
||||
$data =~ s/,?\s*$/]/;
|
||||
$content .= $data;
|
||||
}
|
||||
else {
|
||||
PTDEBUG && _d('Resource text');
|
||||
$content = $res;
|
||||
}
|
||||
|
||||
eval {
|
||||
$self->_request(
|
||||
method => $method,
|
||||
link => $link,
|
||||
content => $content,
|
||||
headers => $headers,
|
||||
);
|
||||
};
|
||||
if ( my $e = $EVAL_ERROR ) {
|
||||
if (blessed($e) && $e->isa('Percona::WebAPI::Exception::Request')) {
|
||||
die $e;
|
||||
}
|
||||
else {
|
||||
die "Unknown error: $e";
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# Low-level HTTP request handler for all methods. Sets $self->response
|
||||
# from the request. Returns nothing on success (HTTP status 2xx-3xx),
|
||||
# else throws an Percona::WebAPI::Exception::Request.
|
||||
sub _request {
|
||||
my ($self, %args) = @_;
|
||||
|
||||
have_required_args(\%args, qw(
|
||||
method
|
||||
link
|
||||
)) or die;
|
||||
my $method = $args{method};
|
||||
my $link = $args{link};
|
||||
|
||||
# Optional args
|
||||
my $content = $args{content};
|
||||
my $headers = $args{headers};
|
||||
|
||||
my $req = HTTP::Request->new($method => $link);
|
||||
if ( $content ) {
|
||||
$req->content($content);
|
||||
}
|
||||
if ( $headers ) {
|
||||
map { $req->header($_ => $headers->{$_}) } keys %$headers;
|
||||
}
|
||||
PTDEBUG && _d('Request', $method, $link, Dumper($req));
|
||||
|
||||
my $response = $self->ua->request($req);
|
||||
PTDEBUG && _d('Response', Dumper($response));
|
||||
|
||||
$self->response($response);
|
||||
|
||||
if ( !($response->code >= 200 && $response->code < 400) ) {
|
||||
die Percona::WebAPI::Exception::Request->new(
|
||||
method => $method,
|
||||
url => $link,
|
||||
content => $content,
|
||||
status => $response->code,
|
||||
error => "Failed to $method $link",
|
||||
);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
no Lmo;
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::WebAPI::Client package
|
||||
# ###########################################################################
|
||||
@@ -1,69 +0,0 @@
|
||||
# This program is copyright 2012-2013 Percona Inc.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::WebAPI::Exception::Request package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::WebAPI::Exception::Request;
|
||||
|
||||
use Lmo;
|
||||
use overload '""' => \&as_string;
|
||||
|
||||
has 'method' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'url' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'content' => (
|
||||
is => 'ro',
|
||||
isa => 'Maybe[Str]',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'status' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'error' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
sub as_string {
|
||||
my $self = shift;
|
||||
chomp(my $error = $self->error);
|
||||
$error =~ s/\n/ /g;
|
||||
return sprintf "%s\nRequest: %s %s %s\nStatus: %d\n",
|
||||
$error, $self->method, $self->url, $self->content || '', $self->status;
|
||||
}
|
||||
|
||||
no Lmo;
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::WebAPI::Exception::Request package
|
||||
# ###########################################################################
|
||||
@@ -1,66 +0,0 @@
|
||||
# This program is copyright 2012-2013 Percona Inc.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::WebAPI::Exception::Resource package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::WebAPI::Exception::Resource;
|
||||
|
||||
use Lmo;
|
||||
use overload '""' => \&as_string;
|
||||
use Data::Dumper;
|
||||
|
||||
has 'type' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'link' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'data' => (
|
||||
is => 'ro',
|
||||
isa => 'ArrayRef',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'error' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
sub as_string {
|
||||
my $self = shift;
|
||||
chomp(my $error = $self->error);
|
||||
local $Data::Dumper::Indent = 1;
|
||||
local $Data::Dumper::Sortkeys = 1;
|
||||
local $Data::Dumper::Quotekeys = 0;
|
||||
return sprintf "Invalid %s resource from %s:\n\n%s\nError: %s\n\n",
|
||||
$self->type, $self->link, Dumper($self->data), $error;
|
||||
}
|
||||
|
||||
no Lmo;
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::WebAPI::Exception::Resource package
|
||||
# ###########################################################################
|
||||
@@ -1,86 +0,0 @@
|
||||
# This program is copyright 2012-2013 Percona Inc.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::WebAPI::Representation package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::WebAPI::Representation;
|
||||
|
||||
eval {
|
||||
require JSON;
|
||||
};
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
as_hashref
|
||||
as_json
|
||||
as_config
|
||||
);
|
||||
|
||||
sub as_hashref {
|
||||
my ($resource, %args) = @_;
|
||||
|
||||
# Copy the object into a new hashref.
|
||||
my $as_hashref = { %$resource };
|
||||
|
||||
# Delete the links because they're just for client-side use
|
||||
# and the caller should be sending this object, not getting it.
|
||||
# But sometimes for testing we want to keep the links.
|
||||
if ( !defined $args{with_links} || !$args{with_links} ) {
|
||||
delete $as_hashref->{links};
|
||||
}
|
||||
|
||||
return $as_hashref;
|
||||
}
|
||||
|
||||
sub as_json {
|
||||
my ($resource, %args) = @_;
|
||||
|
||||
my $json = $args{json} || JSON->new;
|
||||
$json->allow_blessed([]);
|
||||
$json->convert_blessed([]);
|
||||
|
||||
my $text = $json->encode(
|
||||
ref $resource eq 'ARRAY' ? $resource : as_hashref($resource, %args)
|
||||
);
|
||||
if ( $args{json} && $text ) { # for testing
|
||||
chomp($text);
|
||||
$text .= "\n";
|
||||
}
|
||||
return $text;
|
||||
}
|
||||
|
||||
sub as_config {
|
||||
my $resource = shift;
|
||||
if ( !$resource->isa('Percona::WebAPI::Resource::Config') ) {
|
||||
die "Only Config resources can be represented as config.\n";
|
||||
}
|
||||
my $as_hashref = as_hashref($resource);
|
||||
my $options = $as_hashref->{options};
|
||||
my $config = join("\n",
|
||||
map { defined $options->{$_} ? "$_=$options->{$_}" : "$_" }
|
||||
sort keys %$options
|
||||
) . "\n";
|
||||
return $config;
|
||||
}
|
||||
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::WebAPI::Representation package
|
||||
# ###########################################################################
|
||||
@@ -1,77 +0,0 @@
|
||||
# This program is copyright 2012-2013 Percona Inc.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::WebAPI::Resource::Agent package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::WebAPI::Resource::Agent;
|
||||
|
||||
use Lmo;
|
||||
|
||||
has 'uuid' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'username' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
required => 0,
|
||||
default => sub { return $ENV{USER} || $ENV{LOGNAME} },
|
||||
);
|
||||
|
||||
has 'hostname' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
required => 0,
|
||||
default => sub {
|
||||
chomp(my $hostname = `hostname`);
|
||||
return $hostname;
|
||||
},
|
||||
);
|
||||
|
||||
has 'alias' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'versions' => (
|
||||
is => 'rw',
|
||||
isa => 'Maybe[HashRef]',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'links' => (
|
||||
is => 'rw',
|
||||
isa => 'Maybe[HashRef]',
|
||||
required => 0,
|
||||
default => sub { return {} },
|
||||
);
|
||||
|
||||
sub name {
|
||||
my ($self) = @_;
|
||||
return $self->alias || $self->hostname || $self->uuid || 'Unknown';
|
||||
}
|
||||
|
||||
no Lmo;
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::WebAPI::Resource::Agent package
|
||||
# ###########################################################################
|
||||
@@ -1,55 +0,0 @@
|
||||
# This program is copyright 2012-2013 Percona Inc.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::WebAPI::Resource::Config package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::WebAPI::Resource::Config;
|
||||
|
||||
use Lmo;
|
||||
|
||||
has 'ts' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'name' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'options' => (
|
||||
is => 'ro',
|
||||
isa => 'HashRef',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'links' => (
|
||||
is => 'rw',
|
||||
isa => 'Maybe[HashRef]',
|
||||
required => 0,
|
||||
default => sub { return {} },
|
||||
);
|
||||
|
||||
no Lmo;
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::WebAPI::Resource::Config package
|
||||
# ###########################################################################
|
||||
@@ -1,66 +0,0 @@
|
||||
# This program is copyright 2013 Percona Inc.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::WebAPI::Resource::LogEntry package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::WebAPI::Resource::LogEntry;
|
||||
|
||||
use Lmo;
|
||||
|
||||
has 'pid' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'service' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'data_ts' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'entry_ts' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'log_level' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'message' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
no Lmo;
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::WebAPI::Resource::LogEntry package
|
||||
# ###########################################################################
|
||||
@@ -1,94 +0,0 @@
|
||||
# This program is copyright 2012-2013 Percona Inc.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::WebAPI::Resource::Service package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::WebAPI::Resource::Service;
|
||||
|
||||
use Lmo;
|
||||
|
||||
has 'ts' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'name' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'tasks' => (
|
||||
is => 'ro',
|
||||
isa => 'ArrayRef[Percona::WebAPI::Resource::Task]',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'run_schedule' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'spool_schedule' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'meta' => (
|
||||
is => 'ro',
|
||||
isa => 'Bool',
|
||||
required => 0,
|
||||
default => sub { return 0 },
|
||||
);
|
||||
|
||||
has 'run_once' => (
|
||||
is => 'ro',
|
||||
isa => 'Bool',
|
||||
required => 0,
|
||||
default => sub { return 0 },
|
||||
);
|
||||
|
||||
has 'links' => (
|
||||
is => 'rw',
|
||||
isa => 'Maybe[HashRef]',
|
||||
required => 0,
|
||||
default => sub { return {} },
|
||||
);
|
||||
|
||||
sub BUILDARGS {
|
||||
my ($class, %args) = @_;
|
||||
if ( ref $args{tasks} eq 'ARRAY' ) {
|
||||
my @tasks;
|
||||
foreach my $run_hashref ( @{$args{tasks}} ) {
|
||||
my $task = Percona::WebAPI::Resource::Task->new(%$run_hashref);
|
||||
push @tasks, $task;
|
||||
}
|
||||
$args{tasks} = \@tasks;
|
||||
}
|
||||
return $class->SUPER::BUILDARGS(%args);
|
||||
}
|
||||
|
||||
no Lmo;
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::WebAPI::Resource::Service package
|
||||
# ###########################################################################
|
||||
@@ -1,62 +0,0 @@
|
||||
# This program is copyright 2012-2013 Percona Inc.
|
||||
# Feedback and improvements are welcome.
|
||||
#
|
||||
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free Software
|
||||
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
|
||||
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
|
||||
# licenses.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along with
|
||||
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
# Place, Suite 330, Boston, MA 02111-1307 USA.
|
||||
# ###########################################################################
|
||||
# Percona::WebAPI::Resource::Task package
|
||||
# ###########################################################################
|
||||
{
|
||||
package Percona::WebAPI::Resource::Task;
|
||||
|
||||
use Lmo;
|
||||
|
||||
has 'name' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'number' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'program' => (
|
||||
is => 'ro',
|
||||
isa => 'Maybe[Str]',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'query' => (
|
||||
is => 'ro',
|
||||
isa => 'Maybe[Str]',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
has 'output' => (
|
||||
is => 'ro',
|
||||
isa => 'Maybe[Str]',
|
||||
required => 0,
|
||||
);
|
||||
|
||||
sub TO_JSON { return { %{ shift() } }; }
|
||||
|
||||
no Lmo;
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::WebAPI::Resource::Task package
|
||||
# ###########################################################################
|
||||
Reference in New Issue
Block a user