mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-18 17:58:55 +00:00
Partly working and tested pt-agent. Fix Percona/WebAPI/Client.pm. Add Percona/WebAPI/Util.pm, Percona/Test.pm, and /Test/Mock/UserAgent.pm.
This commit is contained in:
62
lib/Percona/Test/Mock/UserAgent.pm
Normal file
62
lib/Percona/Test/Mock/UserAgent.pm
Normal file
@@ -0,0 +1,62 @@
|
||||
# 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] },
|
||||
responses => {
|
||||
get => [],
|
||||
post => [],
|
||||
put => [],
|
||||
},
|
||||
content => {
|
||||
post => undef,
|
||||
put => undef,
|
||||
},
|
||||
};
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
sub request {
|
||||
my ($self, $req) = @_;
|
||||
my $type = lc($req->method);
|
||||
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 $res = HTTP::Response->new(
|
||||
$r->{code} || 200,
|
||||
'',
|
||||
HTTP::Headers->new,
|
||||
$c,
|
||||
);
|
||||
return $res;
|
||||
}
|
||||
|
||||
1;
|
||||
}
|
||||
# ###########################################################################
|
||||
# End Percona::Test::Mock::UserAgent package
|
||||
# ###########################################################################
|
Reference in New Issue
Block a user