/**
* SEXP to REXP objects parser
*/
public static function parseREXP($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;
if (($ra & 64) == 64) {
throw new Exception('Long packets are not supported (yet).');
}
if ($ra > self::XT_HAS_ATTR) {
$ra &= ~self::XT_HAS_ATTR;
$al = int24($r, $i + 1);
$tmp = $i;
$attr = self::parseREXP($buf, $tmp);
$i += $al + 4;
}
$class = $attr ? $attr->at('class') : null;
if ($class) {
$class = $class->getValues();
}
switch ($ra) {
case self::XT_NULL:
$a = new Rserve_REXP_Null();
break;
case self::XT_VECTOR:
// generic vector
$v = array();
while ($i < $eoa) {
$v[] = self::parseREXP($buf, $i);
}
$klass = 'Rserve_REXP_GenericVector';
if ($class) {
if (in_array('data.frame', $class)) {
$klass = 'Rserve_REXP_Dataframe';
}
}
$a = new $klass();
$a->setValues($v);
break;
case self::XT_SYMNAME:
// symbol
$oi = $i;
while ($i < $eoa && ord($r[$i]) != 0) {
$i++;
}
$v = substr($buf, $oi, $i - $oi);
$a = new Rserve_REXP_Symbol();
$a->setValue($v);
break;
case self::XT_LIST_NOTAG:
case self::XT_LANG_NOTAG:
// pairlist w/o tags
$v = array();
while ($i < $eoa) {
$v[] = self::parseREXP($buf, $i);
}
$clasz = $ra == self::XT_LIST_NOTAG ? 'Rserve_REXP_List' : 'Rserve_REXP_Language';
$a = new $clasz();
$a->setValues($a);
break;
case self::XT_LIST_TAG:
case self::XT_LANG_TAG:
// pairlist with tags
$clasz = $ra == self::XT_LIST_TAG ? 'Rserve_REXP_List' : 'Rserve_REXP_Language';
$v = array();
$names = array();
while ($i < $eoa) {
$v[] = self::parseREXP($buf, $i);
$names[] = self::parseREXP($buf, $i);
}
$a = new $clasz();
$a->setValues($v);
$a->setNames($names);
break;
case self::XT_ARRAY_INT:
// integer array
$v = array();
while ($i < $eoa) {
$v[] = int32($r, $i);
$i += 4;
}
$klass = 'Rserve_REXP_Integer';
if ($class) {
if (in_array('factor', $class)) {
$klass = 'Rserve_REXP_Factor';
}
}
$a = new $klass();
$a->setValues($v);
break;
case self::XT_ARRAY_DOUBLE:
// double array
$v = array();
while ($i < $eoa) {
$v[] = flt64($r, $i);
$i += 8;
}
$a = new Rserve_REXP_Double();
$a->setValues($v);
break;
case self::XT_ARRAY_STR:
// string array
$v = array();
$oi = $i;
while ($i < $eoa) {
if (ord($r[$i]) == 0) {
$v[] = substr($r, $oi, $i - $oi);
$oi = $i + 1;
}
$i++;
}
$a = new Rserve_REXP_String();
$a->setValues($v);
break;
case self::XT_ARRAY_BOOL:
// boolean vector
$n = int32($r, $i);
$i += 4;
$k = 0;
$vv = array();
while ($k < $n) {
$v = int8($r, $i++);
$vv[$k] = $v == 1 ? true : ($v == 0 ? false : null);
$k++;
}
$a = new Rserve_REXP_Logical();
$a->setValues($vv);
break;
case self::XT_RAW:
// raw vector
$len = int32($r, $i);
$i += 4;
$v = substr($r, $i, $len);
$a = new Rserve_REXP_Raw();
$a->setValue($v);
break;
case self::XT_ARRAY_CPLX:
$v = array();
while ($i < $eoa) {
$real = flt64($r, $i);
$i += 8;
$im = flt64($r, $i);
$i += 8;
$v[] = array($real, $im);
}
$a = new Rserve_REXP_Complex();
$a->setValues($v);
break;
/*
case 48: // unimplemented type in Rserve
$uit = int32($r, $i);
// echo "Note: result contains type #$uit unsupported by Rserve.<br/>";
$a = null;
break;
*/
/*
case 48: // unimplemented type in Rserve
$uit = int32($r, $i);
// echo "Note: result contains type #$uit unsupported by Rserve.<br/>";
$a = null;
break;
*/
default:
// handle unknown type
$a = new Rserve_REXP_Unknown($ra);
}
if ($attr && is_object($a)) {
$a->setAttributes($attr);
}
return $a;
}
public static function parseREXP($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;
if (($ra & 64) == 64) {
throw new Exception('Long packets are not supported (yet).');
}
if ($ra > self::XT_HAS_ATTR) {
$ra &= ~self::XT_HAS_ATTR;
$al = int24($r, $i + 1);
$attr = self::parseREXP($buf, $i);
$i += $al + 4;
}
switch ($ra) {
case self::XT_NULL:
$a = new Rserve_REXP_Null();
break;
case self::XT_VECTOR:
// generic vector
$v = array();
while ($i < $eoa) {
$v[] = self::parseREXP($buf, $i);
}
$a = new Rserve_REXP_GenericVector();
$a->setValues($v);
break;
case self::XT_SYMNAME:
// symbol
$oi = $i;
while ($i < $eoa && ord($r[$i]) != 0) {
$i++;
}
$v = substr($buf, $oi, $i - $oi);
$a = new Rserve_REXP_Symbol();
$a->setValue($v);
break;
case self::XT_LIST_NOTAG:
case self::XT_LANG_NOTAG:
// pairlist w/o tags
$v = array();
while ($i < $eoa) {
$v[] = self::parseREXP($buf, $i);
}
$clasz = $ra == self::XT_LIST_NOTAG ? 'Rserve_REXP_List' : 'Rserve_REXP_Language';
$a = new $clasz();
$a->setValues($a);
break;
case self::XT_LIST_TAG:
case self::XT_LANG_TAG:
// pairlist with tags
$clasz = $ra == self::XT_LIST_TAG ? 'Rserve_REXP_List' : 'Rserve_REXP_Language';
$v = array();
$names = array();
while ($i < $eoa) {
$v[] = self::parseREXP($buf, $i);
$names[] = self::parseREXP($buf, $i);
}
$a = new $clasz();
$a->setValues($v);
$a->setNames($names);
break;
case self::XT_ARRAY_INT:
// integer array
$v = array();
while ($i < $eoa) {
$v[] = int32($r, $i);
$i += 4;
}
$a = new Rserve_REXP_Integer();
$a->setValues($v);
break;
case self::XT_ARRAY_DOUBLE:
// double array
$v = array();
while ($i < $eoa) {
$v[] = flt64($r, $i);
$i += 8;
}
$a = new Rserve_REXP_Double();
$a->setValues($v);
break;
case self::XT_ARRAY_STR:
// string array
$v = array();
$oi = $i;
while ($i < $eoa) {
if (ord($r[$i]) == 0) {
$v[] = substr($r, $oi, $i - $oi);
$oi = $i + 1;
}
$i++;
}
$a = new Rserve_REXP_String();
$a->setValues($v);
break;
case self::XT_ARRAY_BOOL:
// boolean vector
$n = int32($r, $i);
$i += 4;
$k = 0;
$vv = array();
while ($k < $n) {
$v = int8($r, $i++);
$vv[$k] = $v == 1 ? TRUE : ($v == 0 ? FALSE : NULL);
$k++;
}
$a = new Rserve_REXP_Logical();
$a->setValues($vv);
break;
case self::XT_RAW:
// raw vector
$len = int32($r, $i);
$i += 4;
$v = substr($r, $i, $len);
$a = new Rserve_REXP_Raw();
$a->setValue($v);
break;
case self::XT_ARRAY_CPLX:
$a = FALSE;
break;
case 48:
// unimplemented type in Rserve
$uit = int32($r, $i);
// echo "Note: result contains type #$uit unsupported by Rserve.<br/>";
$a = NULL;
break;
default:
echo 'Warning: type ' . $ra . ' is currently not implemented in the PHP client.';
$a = FALSE;
}
if ($attr && is_object($a)) {
$a->setAttributes($attr);
}
return $a;
}
