#* Rserve client for Perl
#* Supports Rserve protocol 0103 only (used by Rserve 0.5 and higher)
#* $Revision$
#* @author Djun Kim
#* Based on Clément TURBELIN's PHP client.
#* Licensed under #GPL v2 or at your option v3
#
# * Read byte from a binary packed format @see Rserve protocol
# * @param string $buf buffer
# * @param int $o offset
#use strict;
package
Statistics::RserveClient::Funclib;
use
Exporter;
our
@EXPORT
=
qw( _rserve_make_packet int8 )
;
#sub int8($buf, $o = 0) {
sub
int8($$) {
my
$buf
=
shift
;
my
$o
=
shift
;
$o
=
defined
(
$o
) ?
$o
: 0;
my
@buf
=
@$buf
;
# print "buf = "; foreach (@buf) {print "[" . $_ . "]"}; print "\n";
# print "o = $o\n";
return
ord
(
$buf
[
$o
] );
}
#
# * Read an integer from a 24 bits binary packed format @see Rserve protocol
# * @param string $buf buffer
# * @param int $o offset
#sub int24($b, $o = 0) {
sub
int24($$) {
my
$b
=
shift
;
my
$o
=
shift
;
my
@buf
=
@$b
;
$o
=
defined
(
$o
) ?
$o
: 0;
return
(
ord
(
$buf
[
$o
] ) | (
ord
(
$buf
[
$o
+ 1 ] ) << 8 )
| (
ord
(
$buf
[
$o
+ 2 ] ) << 16 ) );
}
# * Read an integer from a 32 bits binary packed format @see Rserve protocol
# * @param string $buf buffer
# * @param int $o offset
#sub int32($buf, $o=0) {
sub
int32(@) {
my
$buf
=
shift
;
my
$offset
=
shift
;
$offset
=
defined
(
$offset
) ?
$offset
: 0;
my
@buf
=
@$buf
;
# foreach (@buf) {print "[". $_ . "]"}; print "\n";
# print "offset = $offset\n";
#print "0:" . ord($buf[$offset]) . "\n";
#print "1:" . (ord($buf[$offset+1]) << 8) . "\n";
#print "2:" . (ord($buf[$offset+2]) << 16) . "\n";
#print "3:" . (ord($buf[$offset+3]) << 24) . "\n";
return
(
ord
(
$buf
[
$offset
] ) | (
ord
(
$buf
[
$offset
+ 1 ] ) << 8 )
| (
ord
(
$buf
[
$offset
+ 2 ] ) << 16 )
| (
ord
(
$buf
[
$offset
+ 3 ] ) << 24 ) );
}
# One Byte
# @param $i
sub
mkint8($) {
my
$i
=
shift
;
return
chr
(
$i
& 255 );
}
# * Make a binary representation of integer using 32 bits
# * @param int $i
# * @return string
sub
mkint32($) {
my
$i
=
shift
;
my
$r
=
chr
(
$i
& 255 );
$i
>>= 8;
$r
.=
chr
(
$i
& 255 );
$i
>>= 8;
$r
.=
chr
(
$i
& 255 );
$i
>>= 8;
$r
.=
chr
(
$i
& 255 );
return
$r
;
}
# * Create a 24 bit integer
# * @return string binary representation of the int using 24 bits
sub
mkint24($) {
my
$i
=
shift
;
my
$r
=
chr
(
$i
& 255 );
$i
>>= 8;
$r
.=
chr
(
$i
& 255 );
$i
>>= 8;
$r
.=
chr
(
$i
& 255 );
return
$r
;
}
# * Create a 24 bit integer
# * @return string binary representation of the int using 24 bits
sub
mkint24b($) {
my
$i
=
shift
;
my
@r
;
$r
[0] =
$i
& 255;
$i
>>= 8;
$r
[1] =
$i
& 255;
$i
>>= 8;
$r
[2] =
$i
& 255;
return
@r
;
}
#
# * Create a binary representation of float to 64bits
# * TODO: works only for intel endianess, should be adapted for no big endian proc
# * @param double $v
sub
mkfloat64($) {
my
$v
=
shift
;
return
pack
(
'd'
,
$v
);
}
# * 64bit integer to Float
# * @param $buf
# * @param $o
#sub flt64($buf, $o = 0) {
sub
flt64($$) {
my
(
$b
,
$o
) =
@_
;
$o
=
defined
(
$o
) ?
$o
: 0;
my
@buf
=
@$b
;
my
@ss
=
@buf
[
$o
.. (
$o
+ 7 ) ];
# if (Rserve_Connection::$machine_is_bigendian) {
if
( Statistics::RserveClient::Connection::machine_is_bigendian() ) {
for
(
my
$k
= 0;
$k
< 7;
$k
++ ) {
$ss
[ 7 -
$k
] =
$buf
[
$o
+
$k
];
}
}
my
$r
=
unpack
(
'd'
,
join
(
''
,
@ss
) );
return
$r
+ 0;
}
# * Create a packet for QAP1 message
# * @param int $cmd command identifier
# * @param string $string contents of the message
#sub _rserve_make_packet($cmd, $string) {
sub
_rserve_make_packet($$) {
my
$cmd
=
shift
;
my
$string
=
shift
;
#$n = length($string) + 1;
$string
.=
chr
(0);
my
$n
=
length
(
$string
);
# print "cmd: $cmd; string: $string, n=$n\n";
# take next largest muliple of 4 to pad out string length
$n
=
$n
+ ( (
$n
% 4 ) ? ( 4 -
$n
% 4 ) : 0 );
#print "n = $n\n";
#print "string = $string\n";
my
@len24
= mkint24b(
$n
);
#foreach (@len24) {print "[". $_ . "]";}; print "\n";
#print "len len24 = " . length(@len24) . "\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)
my
$pkt
=
pack
(
"V V V V C C3 A$n"
,
(
$cmd
,
$n
+ 4, 0, 0, 4,
$len24
[0],
$len24
[1],
$len24
[2],
$string
) );
#my @p = split ('', $pkt);
#for ($i = 0; $i < @p; $i++) {
# print ("[$i:" . $p[$i] . ":" . ord($p[$i]) . "] ");
#}
#print "\n";
#print "packed pkt:". unpack("V V V V C C3 A$n", $pkt) . "\n";
return
$pkt
;
#return (mkint32($cmd), mkint32($n + 4), mkint32(0), mkint32(0), chr(4), mkint24($n), $string);
}
# * Make a data packet
# * @param unknown_type $type
# * @param unknown_type $string NULL terminated string
#sub _rserve_make_data($type, $string) {
sub
_rserve_make_data($$) {
my
(
$type
,
$string
) =
shift
;
my
$s
=
''
;
my
$len
=
length
(
$string
);
# Length of the binary string
my
$is_large
=
$len
> 0xfffff0;
my
$pad
= 0;
# Number of padding needed
while
( (
$len
& 3 ) != 0 ) {
# ensure the data packet size is divisible by 4
++
$len
;
++
$pad
;
}
$s
.=
chr
(
$type
& 255 )
| (
$is_large
? Statistics::RserveClient::Connection::DT_LARGE : 0 );
$s
.=
chr
(
$len
& 255 );
$s
.=
chr
( (
$len
& 0xff00 ) >> 8 );
$s
.=
chr
( (
$len
& 0xff0000 ) >> 16 );
if
(
$is_large
) {
$s
.=
chr
( (
$len
& 0xff000000 ) >> 24 ) .
chr
(0) .
chr
(0) .
chr
(0);
}
$s
.=
$string
;
if
(
$pad
) {
$s
.= str_repeat(
chr
(0),
$pad
);
}
}
# * Parse a Rserve packet from socket connection
# * @param unknown_type $socket
sub
_rserve_get_response($) {
my
$socket
=
shift
;
my
$buf
;
my
$n
= socket_recv(
$socket
,
$buf
, 16, 0 );
if
(
$n
!= 16 ) {
return
FALSE;
}
my
$len
= int32(
$buf
, 4 );
my
$ltg
=
$len
;
my
$b2
;
while
(
$ltg
> 0 ) {
$n
= socket_recv(
$socket
,
$b2
,
$ltg
, 0 );
if
(
$n
> 0 ) {
$buf
.=
$b2
;
unset(
$b2
);
$ltg
-=
$n
;
}
else
{
last
;
}
}
return
$buf
;
}
1;