package StoryServer::CMS;

use strict;
use IO::Socket;
use subs '_hexdump';
use Carp qw'croak confess';

sub new {
	my ($package, $host, $port) = @_;
	my $sock = IO::Socket::INET->new (
		PeerAddr=>$host,
		PeerPort=>$port,
	) or croak "Failed to connect to $host:$port ($!)\n";
	bless {Socket => $sock}, $package;
}

sub _raw_request {
	my ($self, $req_string) = @_;
	my $sock = $self->{Socket};
	$sock->send(pack("N",length($req_string)).$req_string);
	$sock->recv (my $l, 4);

	my $r = '';
	1 while $sock->sysread ($r, unpack ('N', $l) - length($r), length($r));

	return $r;
}

sub _request {
	my ($self, @args) = @_;
	return $self->_raw_request (_bob_encode (@args));
}

sub request_scalar {
	my ($self, $req_type, @args) = @_;
	return _bob_decode_reply ($req_type, $self->_request ($req_type, @args));
}

sub get_sub_attr {
	my ($self, $bob_class, @attr_name) = @_;
	return $self->request_scalar ('GetSubAttr', $bob_class, @attr_name);
}

sub get_obj {
        my ($self, $bob_class) = @_;
        return $self->request_scalar ('GetObj', $bob_class);
}

sub authn_login {
        my ($self, $username, $passwd) = @_;
        return $self->request_scalar ('AuthnLogin', $username, $passwd);
}

sub _bob_encode {
	return '['.
		(join ',', map {"#".length($_)."#$_"} @_).
	       ']'; 
}

sub _bob_decode_reply {
	my ($req_type, $reply) = @_;
	my $rtlen = length($req_type);
	if ($reply =~ /\A\[#5#Reply,#$rtlen#$req_type,(.*)\]\z/s) {
		my $v = $1;
		if ($v =~ /\AError/) {die "Error: $v\n"}
		if ($v =~ /\A#\d+#(.*)/s) {return $1}
		die "Failed to parse reply: $reply\n";
	} else {
		die "Invalid reply: $reply";
	}
}

sub _hexdump {
        my ($data) = @_;

        while ( length ($data) ) {
                my $x = substr($data,0,16,'');
                my $hex = sprintf ("%02X "x length($x) . "   "x(16-length($x)),
                        map ord, split//, $x);
                $x =~ s/[^\040-\176]/./g;
                print "$hex   $x\n";
        }

}


1;	# be true