function parse_SEXP($buf, $offset, $attr = NULL)
{
$r = $buf;
$i = $offset;
// some simple parsing - just skip attributes and assume short responses
$ra = int8($r, $i);
$rl = int24($r, $i + 1);
$i += 4;
$offset = $eoa = $i + $rl;
// echo "[data type ".($ra & 63).", length ".$rl." with payload from ".$i." to ".$eoa."]<br/>\n";
if (($ra & 64) == 64) {
echo "sorry, long packets are not supported (yet).";
return FALSE;
}
if ($ra > 127) {
$ra &= 127;
$al = int24($r, $i + 1);
$attr = parse_SEXP($buf, $i);
$i += $al + 4;
}
if ($ra == 0) {
return NULL;
}
if ($ra == 16) {
// generic vector
$a = array();
while ($i < $eoa) {
$a[] = parse_SEXP($buf, &$i);
}
// if the 'names' attribute is set, convert the plain array into a map
if (isset($attr['names'])) {
$names = $attr['names'];
$na = array();
$n = count($a);
for ($k = 0; $k < $n; $k++) {
$na[$names[$k]] = $a[$k];
}
return $na;
}
return $a;
}
if ($ra == 19) {
// symbol
$oi = $i;
while ($i < $eoa && ord($r[$i]) != 0) {
$i++;
}
return substr($buf, $oi, $i - $oi);
}
if ($ra == 20 || $ra == 22) {
// pairlist w/o tags
$a = array();
while ($i < $eoa) {
$a[] = parse_SEXP($buf, &$i);
}
return $a;
}
if ($ra == 21 || $ra == 23) {
// pairlist with tags
$a = array();
while ($i < $eoa) {
$val = parse_SEXP($buf, &$i);
$tag = parse_SEXP($buf, &$i);
$a[$tag] = $val;
}
return $a;
}
if ($ra == 32) {
// integer array
$a = array();
while ($i < $eoa) {
$a[] = int32($r, $i);
$i += 4;
}
if (count($a) == 1) {
return $a[0];
}
return $a;
}
if ($ra == 33) {
// double array
$a = array();
while ($i < $eoa) {
$a[] = flt64($r, $i);
$i += 8;
}
if (count($a) == 1) {
return $a[0];
}
return $a;
}
if ($ra == 34) {
// string array
$a = array();
$oi = $i;
while ($i < $eoa) {
if (ord($r[$i]) == 0) {
$a[] = substr($r, $oi, $i - $oi);
$oi = $i + 1;
}
$i++;
}
if (count($a) == 1) {
return $a[0];
}
return $a;
}
if ($ra == 36) {
// boolean vector
$n = int32($r, $i);
$i += 4;
$k = 0;
$a = array();
while ($k < $n) {
$v = int8($r, $i++);
$a[$k++] = $v == 1 ? TRUE : ($v == 0 ? FALSE : NULL);
}
if ($n == 1) {
return $a[0];
}
return $a;
}
if ($ra == 37) {
// raw vector
$len = int32($r, $i);
$i += 4;
return substr($r, $i, $len);
}
if ($ra == 48) {
// unimplemented type in Rserve
$uit = int32($r, $i);
// echo "Note: result contains type #$uit unsupported by Rserve.<br/>";
return NULL;
}
echo "Warning: type " . $ra . " is currently not implemented in the PHP client.";
return FALSE;
}
function Rserve_eval($socket, $command, $attr = NULL)
{
$pkt = mkp_str(3, $command);
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;
}
if (int8($r, 16) != 10) {
echo "invalid response (expecting SEXP)";
return FALSE;
}
$i = 20;
return parse_SEXP($r, $i, &$attr);
}
