# Talker using SCGI over Unix Domain Socket
#
# (c) 2008 by Christian Garbs <mitch@cgarbs.de>
# licensed under GNU GPL v2

package xmlrtorrent::SocketTalker;
use xmlrtorrent::RTorrentTalkerBase;
@ISA = qw(xmlrtorrent::RTorrentTalkerBase);

use RPC::XML;
use RPC::XML::Parser;
use IO::Socket::UNIX;
use strict;

sub new {
    my $class = shift;
    my $self = $class->SUPER::new();

    $self->{'NAME'} = 'socket';
    $self->{'DESC'} = 'talker using SCGI over Unix Domain Socket';
    $self->{'_PARAMS'} = {
        'SOCKET' => ['', 'filename of socket'],
    };
    $self->{'__RPCXMLPARSER'} = RPC::XML::Parser->new();

    bless($self, $class);

    $self->_prepare_parameters();

    return $self;
}

sub _create_netstring($$) {
    my $self = shift;
    my $string = shift;
    my $len = length $string;
    return "$len:$string,";
}

sub _create_scgi_header($$$) {
    my $self = shift;
    my ($name, $value) = (@_);
    return "$name\0$value\0";
}

sub send_request {
    my $self = shift;
    my (@params) = (@_);

    my $socketfile = $self->_getval('SOCKET');

    unless (defined $socketfile and $socketfile ne '') {
        return 'socket talker: SOCKET not set';
    }

    # prepare socket
    my $socket = IO::Socket::UNIX->new(
                       'Type' => SOCK_STREAM,
                        'Peer' => $socketfile,
                        )
        or return "socket talker: cannot connect to SOCKET: $!";
    $socket->autoflush(1);  # default since 1.18, but be sure

    # prepare XML RPC request
    my $rpc_request = RPC::XML::request->new(@params)->as_string();

    # prpepare SCGI request
    my $scgi_request = 
        $self->_create_netstring(
                    $self->_create_scgi_header('CONTENT_LENGTH', length $rpc_request)
                    .
                    $self->_create_scgi_header('SCGI', '1')
                    )
        .
        $rpc_request;
    
    # write to socket
    $socket->print($scgi_request);
    
    # read from socket
    while (my $line = <$socket>) {
        last if ($line =~ /^\s*$/);  # munch headers
    }
    my $ret = '';
    while (my $line = <$socket>) {
        $ret .= $line;
    }

    $socket->close() or return "socket talker: cannot close SOCKET: $!";

    return $self->{'__RPCXMLPARSER'}->parse($ret);
}

1;