/**
* Make a data packet
* @param unknown_type $type
* @param unknown_type $string NULL terminated string
*/
function _rserve_make_data($type, $string)
{
if ($type == Rserve_Connection::DT_STRING) {
$string .= chr(0);
}
$len = strlen($string);
// Length of the binary string
$pad = $len % 4;
// Number of padding needed
if ($pad > 0) {
$pad = 4 - $pad;
}
$len += $pad;
$s = chr($type & 255);
// [0] Type
$s .= mkint24($len);
// [1] Length (24bits)
$s .= $string;
// Data
if ($pad) {
$s .= str_repeat(chr(0), $pad);
}
return $s;
}
/**
*
* @param Rserve_REXP $value
* This function is not functionnal. Please use it only for testing
*/
public static function createBinary(Rserve_REXP $value)
{
// Current offset
$o = 0;
// Init with header size
$contents = '';
$type = $value->getType();
switch ($type) {
case self::XT_S4:
case self::XT_NULL:
break;
case self::XT_INT:
$v = (int) $value->at(0);
$contents .= mkint32($v);
$o += 4;
break;
case self::XT_DOUBLE:
$v = (double) $value->at(0);
$contents .= mkfloat64($v);
$o += 8;
break;
case self::XT_ARRAY_INT:
$vv = $value->getValues();
$n = count($vv);
for ($i = 0; $i < $n; ++$i) {
$v = $vv[$i];
$contents .= mkint32($v);
$o += 4;
}
break;
case self::XT_ARRAY_BOOL:
$vv = $value->getValues();
$n = count($vv);
$contents .= mkint32($n);
$o += 4;
if ($n) {
for ($i = 0; $i < $n; ++$i) {
$v = $vv[$i];
if (is_null($v)) {
$v = 2;
} else {
$v = (int) $v;
}
if ($v != 0 and $v != 1) {
$v = 2;
}
$contents .= chr($v);
++$o;
}
while (($o & 3) != 0) {
$contents .= chr(3);
++$o;
}
}
break;
case self::XT_ARRAY_DOUBLE:
$vv = $value->getValues();
$n = count($vv);
for ($i = 0; $i < $n; ++$i) {
$v = (double) $vv[$i];
$contents .= mkfloat64($v);
$o += 8;
}
break;
case self::XT_RAW:
$v = $value->getValue();
$n = $value->length();
$contents .= mkint32($n);
$o += 4;
$contents .= $v;
break;
case self::XT_ARRAY_STR:
$vv = $value->getValues();
$n = count($vv);
for ($i = 0; $i < $n; ++$i) {
$v = $vv[$i];
if (!is_null($v)) {
$contents .= $v;
$contents .= chr(0);
$o += strlen($v) + 1;
} else {
$contents .= chr(255) . chr(0);
$o += 2;
}
}
while (($o & 3) != 0) {
$contents .= chr(1);
++$o;
}
break;
case self::XT_LIST_TAG:
case self::XT_LIST_NOTAG:
case self::XT_LANG_TAG:
case self::XT_LANG_NOTAG:
case self::XT_LIST:
case self::XT_VECTOR:
case self::XT_VECTOR_EXP:
$l = $value->getValues();
if ($type == XT_LIST_TAG || $type == XT_LANG_TAG) {
$names = $value->getNames();
}
$i = 0;
$n = count($l);
while ($i < $n) {
$x = $l[$i];
if (is_null($x)) {
$x = new Rserve_REXP_Null();
}
$iof = strlen($contents);
$contents .= self::createBinary($x);
if ($type == XT_LIST_TAG || $type == XT_LANG_TAG) {
$sym = new Rserve_REXP_Symbol();
$sym->setValue($names[$i]);
$contents .= self::createBinary($sym);
}
++$i;
}
break;
case self::XT_SYMNAME:
case self::XT_STR:
$s = (string) $value->getValues();
$contents .= $s;
$o += strlen($s);
$contents .= chr(0);
++$o;
//padding if necessary
while (($o & 3) != 0) {
$contents .= chr(0);
++$o;
}
break;
}
/*
TODO: handling attr
$attr = $value->attributes();
$attr_bin = '';
if( is_null($attr) ) {
$attr_off = self::createBinary($attr, $attr_bin, 0);
$attr_flag = self::XT_HAS_ATTR;
} else {
$attr_off = 0;
$attr_flag = 0;
}
// [0] (4) header SEXP: len=4+m+n, XT_HAS_ATTR is set
// [4] (4) header attribute SEXP: len=n
// [8] (n) data attribute SEXP
// [8+n] (m) data SEXP
*/
$attr_flag = 0;
$length = $o;
$isLarge = $length > 0xfffff0;
$code = $type | $attr_flag;
// SEXP Header (without ATTR)
// [0] (byte) eXpression Type
// [1] (24-bit int) length
$r = chr($code & 255);
$r .= mkint24($length);
$r .= $contents;
return $r;
}
function mkp_str($cmd, $string)
{
$n = strlen($string) + 1;
$string .= chr(0);
while (($n & 3) != 0) {
$string .= chr(1);
$n++;
}
return mkint32($cmd) . mkint32($n + 4) . mkint32(0) . mkint32(0) . chr(4) . mkint24($n) . $string;
}
/**
* Create a packet for QAP1 message
* @param int $cmd command identifier
* @param string $string contents of the message
*/
function _rserve_make_packet($cmd, $string)
{
$n = strlen($string) + 1;
$string .= chr(0);
while (($n & 3) != 0) {
$string .= chr(1);
$n++;
}
// [0] (int) command
// [4] (int) length of the message (bits 0-31)
// [8] (int) offset of the data part
// [12] (int) length of the message (bits 32-63)
return mkint32($cmd) . mkint32($n + 4) . mkint32(0) . mkint32(0) . chr(4) . mkint24($n) . $string;
}
function Rserve_assign_raw($socket, $name, $what)
{
// CMD_setSEXP
$bl = strlen($what);
if ($bl > 16777088) {
trigger_error("Body in Rserve_assign_raw is too big ({$bl} bytes), only small QAP packets are currently supported.");
}
$n = strlen($name) + 1;
$name .= chr(0);
while (($n & 3) != 0) {
$name .= chr(1);
$n++;
}
// [CMD_setSEXP][DT_STRING(name)][DT_SEXP([XT_RAW, (i32) len, what])] = payload + 4 + 4 + 8
$pkt = mkint32(0x20) . mkint32($n + $bl + 16) . mkint32(0) . mkint32(0) . chr(4) . mkint24($n) . $name . chr(10) . mkint24($bl + 8) . chr(37) . mkint24($bl + 4) . mkint32($bl) . $what;
socket_send($socket, $pkt, strlen($pkt), 0);
$r = get_rsp($socket);
$res = int32($r);
$sc = $res >> 24 & 127;
$rr = $res & 255;
if ($rr != 1) {
echo "eval failed with error code " . $sc;
return FALSE;
}
return TRUE;
}
