#
# Copyright (C) 1998 Ken MacLeod
# Frontier::Client is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# $Id: Client.pm,v 1.8 2001/10/03 01:30:54 kmacleod Exp $
#

# NOTE: see Net::pRPC for a Perl RPC implementation

use strict;

package Frontier::Client;
use Frontier::RPC2;
use LWP::UserAgent;
use HTTP::Request;
use MIME::Base64;

use vars qw{$AUTOLOAD};

sub new {
    my $class = shift;
    my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };

    bless $self, $class;

    die "Frontier::RPC::new: no url defined\n"
	if !defined $self->{'url'};

    $self->{'ua'} = LWP::UserAgent->new;
    my @schemes = grep { $self->{'ua'}->is_protocol_supported($_) }
	qw/http https/;
    $self->{'ua'}->proxy([@schemes], $self->{'proxy'})
	if(defined $self->{'proxy'} && @schemes);
    $self->{'rq'} = HTTP::Request->new (POST => $self->{'url'});
    $self->{'rq'}->header('Content-Type' => 'text/xml');
    # Patch to enable basic authentication:
    $self->{'rq'}->header('Authorization' => 'Basic '.
	    	encode_base64($self->{'username'}.':'.$self->{'password'}))
	if(defined $self->{'username'} and defined $self->{'password'});

    my @options;

    if(defined $self->{'encoding'}) {
	push @options, 'encoding' => $self->{'encoding'};
    }

    if (defined $self->{'use_objects'} && $self->{'use_objects'}) {
	push @options, 'use_objects' => $self->{'use_objects'};
    }

    $self->{'enc'} = Frontier::RPC2->new(@options);

    return $self;
}

sub call {
    my $self = shift;

    my $content = $self->raw_call(@_);

    if ($self->{'debug'}) {
	print "---- response ----\n";
	print $content;
    }

    my $result = $self->{'enc'}->decode($content);

    if ($result->{'type'} eq 'fault') {
	die "Fault returned from XML RPC Server, fault code " . $result->{'value'}[0]{'faultCode'} . ": "
	    . $result->{'value'}[0]{'faultString'} . "\n";
    }

    return $result->{'value'}[0];
}

sub raw_call {
    my $self = shift;

    my $text = $self->{'enc'}->encode_call(@_);

    if ($self->{'debug'}) {
	print "---- request ----\n";
	print $text;
    }

    $self->{'rq'}->content($text);

    my $response = $self->{'ua'}->request($self->{'rq'});

    if (!$response->is_success) {
	die $response->status_line . "\n";
    }

    my $content = $response->content;

    return $content;
}

# shortcuts
sub base64 {
    my $self = shift;

    return Frontier::RPC2::Base64->new(@_);
}

sub boolean {
    my $self = shift;

    return Frontier::RPC2::Boolean->new(@_);
}

sub double {
    my $self = shift;

    return Frontier::RPC2::Double->new(@_);
}

sub int {
    my $self = shift;

    return Frontier::RPC2::Integer->new(@_);
}

sub string {
    my $self = shift;

    return Frontier::RPC2::String->new(@_);
}

sub date_time {
    my $self = shift;

    return Frontier::RPC2::DateTime::ISO8601->new(@_);
}

# something like this could be used to get an effect of
#
#     $server->examples_getStateName(41)
#
# instead of
#
#     $server->call('examples.getStateName', 41)
#
# for Frontier's
#
#     [server].examples.getStateName 41
#
# sub AUTOLOAD {
#     my ($pkg, $method) = ($AUTOLOAD =~ m/^(.*::)(.*)$/);
#     return if $method eq 'DESTROY';
# 
#     $method =~ s/__/=/g;
#     $method =~ tr/_=/._/;
# 
#     splice(@_, 1, 0, $method);
# 
#     goto &call;
# }

=head1 NAME

Frontier::Client - issue Frontier XML RPC requests to a server

=head1 SYNOPSIS

 use Frontier::Client;

 $server = Frontier::Client->new( I<OPTIONS> );

 $result = $server->call($method, @args);

 $boolean = $server->boolean($value);
 $date_time = $server->date_time($value);
 $base64 = $server->base64($value);

 $value = $boolean->value;
 $value = $date_time->value;
 $value = $base64->value;

=head1 DESCRIPTION

I<Frontier::Client> is an XML-RPC client over HTTP.
I<Frontier::Client> instances are used to make calls to XML-RPC
servers and as shortcuts for creating XML-RPC special data types.

=head1 METHODS

=over 4

=item new( I<OPTIONS> )

Returns a new instance of I<Frontier::Client> and associates it with
an XML-RPC server at a URL.  I<OPTIONS> may be a list of key, value
pairs or a hash containing the following parameters:

=over 4

=item url

The URL of the server.  This parameter is required.  For example:

 $server = Frontier::Client->new( 'url' => 'http://betty.userland.com/RPC2' );

=item proxy

A URL of a proxy to forward XML-RPC calls through.

=item encoding

The XML encoding to be specified in the XML declaration of outgoing
RPC requests.  Incoming results may have a different encoding
specified; XML::Parser will convert incoming data to UTF-8.  The
default outgoing encoding is none, which uses XML 1.0's default of
UTF-8.  For example:

 $server = Frontier::Client->new( 'url' => 'http://betty.userland.com/RPC2',
                                  'encoding' => 'ISO-8859-1' );

=item use_objects

If set to a non-zero value will convert incoming E<lt>i4E<gt>,
E<lt>floatE<gt>, and E<lt>stringE<gt> values to objects instead of
scalars.  See int(), float(), and string() below for more details.

=item username

Sets the username for basic authentication. If this is not set, basic
authentication will be disabled.

=item password

Sets the password for basic authentication.

=item debug

If set to a non-zero value will print the encoded XML request and the
XML response received.

=back

=item call($method, @args)

Forward a procedure call to the server, either returning the value
returned by the procedure or failing with exception.  `C<$method>' is
the name of the server method, and `C<@args>' is a list of arguments
to pass.  Arguments may be Perl hashes, arrays, scalar values, or the
XML-RPC special data types below.

=item boolean( $value )

=item date_time( $value )

=item base64( $base64 )

The methods `C<boolean()>', `C<date_time()>', and `C<base64()>' create
and return XML-RPC-specific datatypes that can be passed to
`C<call()>'.  Results from servers may also contain these datatypes.
The corresponding package names (for use with `C<ref()>', for example)
are `C<Frontier::RPC2::Boolean>',
`C<Frontier::RPC2::DateTime::ISO8601>', and
`C<Frontier::RPC2::Base64>'.

The value of boolean, date/time, and base64 data can be set or
returned using the `C<value()>' method.  For example:

  # To set a value:
  $a_boolean->value(1);

  # To retrieve a value
  $base64 = $base64_xml_rpc_data->value();

Note: `C<base64()>' does I<not> encode or decode base64 data for you,
you must use MIME::Base64 or similar module for that.

=item int( 42 );

=item float( 3.14159 );

=item string( "Foo" );

By default, you may pass ordinary Perl values (scalars) to be encoded.
RPC2 automatically converts them to XML-RPC types if they look like an
integer, float, or as a string.  This assumption causes problems when
you want to pass a string that looks like "0096", RPC2 will convert
that to an E<lt>i4E<gt> because it looks like an integer.  With these
methods, you could now create a string object like this:

  $part_num = $server->string("0096");

and be confident that it will be passed as an XML-RPC string.  You can
change and retrieve values from objects using value() as described
above.

=back

=head1 SEE ALSO

perl(1), Frontier::RPC2(3)

<http://www.scripting.com/frontier5/xml/code/rpc.html>

=head1 AUTHOR

Ken MacLeod <ken@bitsko.slc.ut.us>
Basic authentication patch by Jeff <jeff@freemedsoftware.org>

=cut

1;