The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Net::SAJAX::UserAgent;

use strict;
use warnings 'all';


use HTTP::Response;
use Test::MockObject;
use URI;
use URI::Escape (); # No imports
use URI::QueryParam;

sub new {
	my ($class) = @_;

	# Create a fake UA using a mock object
	my $fake_ua = Test::MockObject->new;

	# Set the fake methods
	$fake_ua->mock(get     => \&get);
	$fake_ua->mock(post    => \&post);
	$fake_ua->mock(request => \&request);

	# Set the fake inheritance for the UA
	$fake_ua->set_isa('LWP::UserAgent');

	return $fake_ua;
}

sub get {
	my ($self, $url) = @_;

	# Get the called function name
	my $function  = $url->query_param('rs');
	my @arguments = $url->query_param('rsargs[]');
	my $target_id = $url->query_param('rst');
	my $rand_key  = $url->query_param('rsrnd');

	# Change URL into a URI object
	$url = URI->new($url);

	return _process_request(
		function  => $function,
		arguments => \@arguments,
		target_id => $target_id,
		rand_key  => $rand_key,
		url       => $url,
		method    => 'GET',
	);
}

sub post {
	my ($self, $url, $post_data) = @_;

	# Get the called function name
	my $function  = $post_data->{rs};
	my $arguments = $post_data->{'rsargs[]'};

	return _process_request(
		function  => $function,
		arguments => $arguments,
		url       => $url,
		method    => 'POST',
	);
}

sub request {
	my ($self, $request) = @_;

	# The function to redirect to
	my $handle_request = sub {
		die sprintf 'Cannot handle %s request', $request->method;
	};

	if ($request->method eq 'GET') {
		# Forward to GET mocker
		$handle_request = sub { return $self->get($request->uri); };
	}
	elsif ($request->method eq 'POST') {
		# Forward to POST mocket
		$handle_request = sub {
			# Get the key pairs from the content
			my %content = map {
				URI::Escape::uri_unescape($_)
			} map {
				split m{=}msx
			} split m{&}msx, $request->decoded_content;

			return $self->post($request->uri, \%content);
		};
	}

	# Forward the request
	return $handle_request->();
}

sub _process_request {
	my %args = @_;

	my ($function, $method) = @args{qw(function method)};

	my $call = __PACKAGE__->can("_any_$function");

	if (!defined $call) {
		if ($method eq 'POST') {
			$call = __PACKAGE__->can("_post_$function");
		}
		else {
			$call = __PACKAGE__->can("_get_$function");
		}
	}

	if (!defined $call) {
		return HTTP::Response->new(200, 'OK', undef, "-:$function not callable");
	}

	my $data = eval { $call->(%args) };

	if ($@) {
		return HTTP::Response->new(200, 'OK', undef, "-:Perl error occurred: $@");
	}

	if (ref $data ne 'HASH') {
		return HTTP::Response->new(200, 'OK', undef, sprintf '+:%s', $data);
	}
	elsif (!exists $data->{response}) {
		return HTTP::Response->new(200, 'OK', undef, sprintf '+:%s', $data->{data});
	}

	return $data->{response};
}


sub _any_Echo {
	my %args = @_;

	my @arguments = @{$args{arguments}};

	if (!@arguments) {
		die 'Nothing supplied to Echo';
	}

	return {
		response => HTTP::Response->new(200, 'OK', undef, $arguments[0]),
	};
}
sub _any_EchoRandKey {
	my %args = @_;

	# Get the target id of the request
	my $rand_key = $args{rand_key};

	return {
		response => HTTP::Response->new(200, 'OK', undef, "+:var res = '$rand_key'; res;"),
	};
}
sub _any_EchoStatus {
	my %args = @_;

	my @arguments = @{$args{arguments}};

	my $status = 200;

	if (@arguments) {
		$status = $arguments[0];
	}

	return {
		response => HTTP::Response->new($status, '?????', undef, "+:var res = $status; res;"),
	};
}
sub _any_EchoTargetId {
	my %args = @_;

	# Get the target id of the request
	my $target_id = $args{target_id};

	return {
		response => HTTP::Response->new(200, 'OK', undef, "+:var res = '$target_id'; res;"),
	};
}
sub _any_EchoUrl {
	my %args = @_;

	my $url = $args{url};

	return {
		response => HTTP::Response->new(200, 'OK', undef, "+:var url = '$url'; url;"),
	};
}
sub _any_GetNumber {
	my %args = @_;

	my @arguments = @{$args{arguments}};

	my $number = int(rand(100));

	if (@arguments) {
		$number = $arguments[0];
	}

	return $number;
}

1;