package XMLRPC::Simple::Client;

use strict;
use warnings;
use Try::Tiny;
use Encode qw(encode decode);
use Sub::Override;

use Protocol::XMLRPC::MethodCall;
use Protocol::XMLRPC::MethodResponse;
use LWP::UserAgent;
use URI;

use vars qw($AUTOLOAD $force_encoding);

# Errors
# 700 = internal
# 701 = HTTP Errors
# 702 = XML Errors


sub new {
	my $class = shift;
	my %options = @_;
	
	my $self = bless({}, $class);
	
	$self->{'compress_requests'} = 0;
	$self->{'compress_requests_threshold'} = 0;
	$self->{'url'} = '';
	$self->{'username'} = '';
	$self->{'password'} = '';
	$self->{'realm'} = '';
	$self->{'use_autoload'} = 1;
	$self->{'autoload_namespace_divider'} = '__';
	$self->{'query_methods'} = 0;
	$self->{'log_handler'} = sub {};
	$self->{'ua_options'} = [];

	$self->{'force_encoding'} = 'utf-8';

	for my $option ( keys %options ) {
		if(exists $self->{ $option } ) {
			$self->{ $option } = $options{ $option };
		}
		else {
			warn "unrecognized option: " . $option;
		}
	}
	
	$force_encoding = $self->{'force_encoding'};

	if($self->{'force_encoding'}) {
		$self->{'_override'} = Sub::Override->new( 'Protocol::XMLRPC::Value::String::to_string' => sub { 
			my $self = shift;
			my $value = encode( $force_encoding , $self->value );
			$value = '' unless($value);
			$value =~ s/&/&/g;
			$value =~ s/</&lt;/g;
			$value =~ s/>/&gt;/g;
			return "<string>$value</string>";
		} );
	}

	$self->{'ua'} = LWP::UserAgent->new(@{ $self->{'ua_options'} } );
	$self->{'functions'} = {};
	$self->set_http_auth();
	return $self;
}

sub _call {
	my $self = shift;
	my $method = shift;

	$self->{'log_handler'}->( 'debug', '_call: $method' );
	my $method_call = Protocol::XMLRPC::MethodCall->new(
		'name' => $method
	);
	foreach my $arg (@_) {
		$method_call->add_param($arg);
	}
	
	$self->{'log_handler'}->( 'debug', 'request xml: ' . $method_call->to_string() );
	
	my $req = HTTP::Request->new('POST', $self->_url() );
	$req->content_type('text/xml');
	$req->content( $method_call->to_string() );
	$req->content_length( length($req->content()) );
	$self->{'log_handler'}->( 'debug', 'request: ' . $req->as_string() );
	my $response = $self->_ua->request($req);
	if($response->is_success()) {
		my $rcontent = $response->decoded_content( );

		$self->{'log_handler'}->( 'debug', 'response: ' . $rcontent );
		my $method_response;
		try {
			$method_response = Protocol::XMLRPC::MethodResponse->parse( $rcontent );
		}
		finally {
			if(@_) {
				$method_response = $self->_fail('702', 'Server did not send a valid xmlrpc response: ' . join("", @_) );
			}
		};
		return $method_response;
		
	}
	else {
		return $self->_fail('701', 'Server did not send a HTTP OK response: ' . $response->status_line . "\n" . $response->decoded_content() );
	}
}

sub _log {
	my $self = shift;
	my $level = shift;
	my $message = shift;
	$self->{'log_handler'}->( $level, $message );
	return 1;
}

sub _fail {
	my $self = shift;
	my $errorcode = shift;
	my $errorstring = shift;
	$self->{'log_handler'}->( 'debug', 'RPC-Error: ' . $errorcode . ' ' . $errorstring );
	return Protocol::XMLRPC::MethodResponse->new_fault($errorcode => $errorstring);
}

sub DESTROY {
}

sub _force_encoding {
	my $self = shift;
	if(@_) {
		my $oldval = $self->{'force_encoding'} = shift;
		$force_encoding = $self->{'force_encoding'};
		return $oldval;
	}
	return $self->{'force_encoding'};
}

sub set_http_auth {
	my $self = shift;
	if($self->_username() && $self->_password()) {
		my $uri = URI->new($self->_url);
		$self->_ua->credentials($uri->host() . ":" . $uri->port(), $self->_realm(), $self->_username(), $self->_password());
	}
}

sub AUTOLOAD {
	my $self = shift;
	my $method = $AUTOLOAD;
	
	$method =~ s/.*://;
	
	if(substr($method, 0, 1) eq '_') {
		if(exists $self->{ substr($method, 1) } ) {
			if($_[0]) {
				my $oldval = $self->{ substr($method, 1) } = $_[0];
				if(
					substr($method, 1) eq 'username' ||
					substr($method, 1) eq 'password' ||
					substr($method, 1) eq 'realm' ||
					substr($method, 1) eq 'url'
				) {
					$self->set_http_auth();
				}
				return $oldval;
			}
			return  $self->{ substr($method, 1) };
		}
	}
	elsif($self->{'use_autoload'}) {
		if($self->{'autoload_namespace_divider'}) {
			$method =~ s/$self->{'autoload_namespace_divider'}/./g;
		}
		if($self->{'query_methods'} && !exists $self->{'functions'}->{ $method }) {
			$self->_log('error', 'function "' . $method . '" is not in the function list and query_methods is true');
			return $self->_fail('700', 'internal: function "' . $method . '" is not in the function list and query_methods is true');
		}
		return $self->_call($method, @_);
	}
	die "method " . $method . " does not exist";
}

1;