ZipTie::Client - Webservice client for the ZipTie server

package ZipTie::Client;

use strict;
use warnings;
use vars qw($AUTOLOAD $VERSION);

$VERSION = "1.3";

sub new
{
    my ( $proto, %params ) = @_;
    my $package = ref($proto) || $proto;

    my $self = {
        username => undef,
        password => undef,
        host => 'localhost:8080',
        scheme => 'https',
        on_fault => undef,
    };

    foreach my $key ( keys %params )
    {
        $self->{$key} = $params{$key};
    }

    bless($self, $package);
}

sub port
{
    my $self = shift;
    my $portname = shift or die('No port specified');

    my $portkey = "port_$portname";
    my $port = $self->{$portkey};
    if ($port)
    {
        return $port;
    }

    my $primary_url = '';
    if ($self->{username})
    {
        $primary_url = $self->{scheme}. '://' . $self->{host} . '/server/';
    }
    else
    {
        # Token should be of the form '<scheme>://<user>:<auth-pass>@<host>[:<port>]'
        my $token = $ENV{'ZIPTIE_AUTHENTICATION'};
        if ($token)
        {
            $primary_url = $token;
        }
        else
        {
            confess("Must specify a username and password.");
        }
    }

    my $proxy_url = $primary_url . $portname;

    my $ns_url = 'http://www.ziptie.org/server/' . $portname;

    $port = ZipTie::Client::Port->new($self, $proxy_url, $ns_url, $self->{on_fault});

    $self->{$portkey} = $port;

    return $port;
}

sub logout
{
    my $self = shift;

    $self->port("security")->logoutCurrentUser();
}

sub AUTOLOAD
{
    my $self = shift;
    my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
    return if $method eq 'DESTROY';

    $self->port($method, @_);
}

1;

package ZipTie::Client::Port;

use strict;
use warnings;
use vars qw($AUTOLOAD $VERSION);

use Carp;
use HTTP::Cookies;
use HTTP::Response;
use SOAP::Lite 0.69;
use LWP::UserAgent;

use constant DEBUG => 0;

$VERSION = "1.3";

sub new
{
    my ($pkg, $client, $proxy_url, $ns_url, $on_fault) = @_;

    my $cookie_jar = HTTP::Cookies->new(ignore_discard => 1);

    my $auth = $client->{scheme} . '://' . $client->{host} . '/server';
    if ($client->{username})
    {
        $auth .= '?j_username=' . $client->{username} . '&j_password=' . $client->{password};

        my $ua = LWP::UserAgent->new(cookie_jar => $cookie_jar);
        my $response = $ua->head($auth);
        if (!$response->is_success)
        {
            die $response->status_line;
        }
    }

    my $proxy = SOAP::Lite
        -> proxy($proxy_url, cookie_jar => $cookie_jar)
        -> uri($ns_url);

    $proxy->on_fault($on_fault || \&_on_fault);
    $proxy->ns($ns_url, 'ns1');

    my $self = {
        "proxy" => $proxy,
    };

    bless($self, $pkg);
}

sub _convert_args
{
    my $self = shift;

    my %args = ();
    if (@_ eq 1 and ref($_[0]) eq 'HASH')
    {
        %args = %{$_[0]};
    } 
    elsif (@_ % 2)
    {
        confess("Arguments to must be name=>value pairs");
    }
    else
    {
        %args = @_;
    }

    my @params;

    foreach my $key (keys(%args))
    {
        my $name = $key;
        my $value = $args{$key};

        my $ref = ref($value);
        if ($ref eq 'HASH')
        {
            print("A Hash\n") if (DEBUG);
            my @converted = $self->_convert_args($value);
            push(@params, SOAP::Data->name($name)->value(\@converted));
        }
        elsif ($ref eq 'ARRAY')
        {
            print("An Array\n") if (DEBUG);

            foreach my $entry (@$value)
            {
                $ref = ref($entry);
                if ($ref eq 'HASH')
                {
                    my @converted = $self->_convert_args(%$entry);
                    push(@params, SOAP::Data->name($name)->value(\@converted));
                }
                else
                {
                    push(@params, SOAP::Data->name($name)->value($entry));
                }
            }
        }
        else
        {
            print("Name: $name\nValue: $value\n") if (DEBUG);
            push(@params, SOAP::Data->name($name)->value($value));
        }
    }

    @params;
}

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

    my @args = $self->_convert_args(@_);

    my $proxy = $self->{"proxy"};
    my $result = $proxy->$method(@args);

    wantarray ? $result->paramsall() : $result->result();
}

sub _on_fault
{
    my($soap, $res) = @_;
    die ref $res ? $res->faultdetail : $soap->transport->status, "\n";
}

sub AUTOLOAD
{
    my $self = shift;
    my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
    return if $method eq 'DESTROY';

    # Generate the requested method.  This AUTOLOAD will only be called the first time the method is called. 
    # All subsequent calls will call the generated method directly.
    eval("sub $method { my \$self = shift; \$self->_call('$method', \@_); }");

    $self->$method(@_);
}

1;