lib/perl/lib/Thrift/BinaryProtocol.pm

   1 #
   2 # Copyright (c) 2006- Facebook
   3 # Distributed under the Thrift Software License
   4 #
   5 # See accompanying file LICENSE or visit the Thrift site at:
   6 # http://developers.facebook.com/thrift/
   7 #
   8 #  package - thrift.protocol.binary
   9 #  author  - T Jake Luciani <jakers@gmail.com>
  10 #  author  - Mark Slee      <mcslee@facebook.com>
  11 #
  12
  13 require 5.6.0;
  14
  15 use strict;
  16 use warnings;
  17
  18 use Thrift;
  19 use Thrift::Protocol;
  20
  21 use Bit::Vector;
  22
  23 #
  24 # Binary implementation of the Thrift protocol.
  25 #
  26 package Thrift::BinaryProtocol;
  27 use base('Thrift::Protocol');
  28
  29 use constant VERSION_MASK   => 0xffff0000;
  30 use constant VERSION_1      => 0x80010000;
  31
  32 sub new
  33 {
  34     my $classname = shift;
  35     my $trans     = shift;
  36     my $self      = $classname->SUPER::new($trans);
  37
  38     return bless($self,$classname);
  39 }
  40
  41 sub writeMessageBegin
  42 {
  43     my $self = shift;
  44     my ($name, $type, $seqid) = @_;
  45
  46     return
  47         $self->writeI32(VERSION_1 | $type) +
  48         $self->writeString($name) +
  49         $self->writeI32($seqid);
  50 }
  51
  52 sub writeMessageEnd
  53 {
  54     my $self = shift;
  55     return 0;
  56 }
  57
  58 sub writeStructBegin{
  59     my $self = shift;
  60     my $name = shift;
  61     return 0;
  62 }
  63
  64 sub writeStructEnd
  65 {
  66     my $self = shift;
  67     return 0;
  68 }
  69
  70 sub writeFieldBegin
  71 {
  72     my $self = shift;
  73     my ($fieldName, $fieldType, $fieldId) = @_;
  74
  75     return
  76         $self->writeByte($fieldType) +
  77         $self->writeI16($fieldId);
  78 }
  79
  80 sub writeFieldEnd
  81 {
  82     my $self = shift;
  83     return 0;
  84 }
  85
  86 sub writeFieldStop
  87 {
  88     my $self = shift;
  89     return $self->writeByte(TType::STOP);
  90 }
  91
  92 sub writeMapBegin
  93 {
  94     my $self = shift;
  95     my ($keyType, $valType, $size) = @_;
  96
  97     return
  98         $self->writeByte($keyType) +
  99         $self->writeByte($valType) +
 100         $self->writeI32($size);
 101 }
 102
 103 sub writeMapEnd
 104 {
 105     my $self = shift;
 106     return 0;
 107 }
 108
 109 sub writeListBegin
 110 {
 111     my $self = shift;
 112     my ($elemType, $size) = @_;
 113
 114     return
 115         $self->writeByte($elemType) +
 116         $self->writeI32($size);
 117 }
 118
 119 sub writeListEnd
 120 {
 121     my $self = shift;
 122     return 0;
 123 }
 124
 125 sub writeSetBegin
 126 {
 127     my $self = shift;
 128     my ($elemType, $size) = @_;
 129
 130     return
 131         $self->writeByte($elemType) +
 132         $self->writeI32($size);
 133 }
 134
 135 sub writeSetEnd
 136 {
 137     my $self = shift;
 138     return 0;
 139 }
 140
 141 sub writeBool
 142 {
 143     my $self = shift;
 144     my $value = shift;
 145
 146     my $data = pack('c', $value ? 1 : 0);
 147     $self->{trans}->write($data, 1);
 148     return 1;
 149 }
 150
 151 sub writeByte
 152 {
 153     my $self = shift;
 154     my $value= shift;
 155
 156     my $data = pack('c', $value);
 157     $self->{trans}->write($data, 1);
 158     return 1;
 159 }
 160
 161 sub writeI16
 162 {
 163     my $self = shift;
 164     my $value= shift;
 165
 166     my $data = pack('n', $value);
 167     $self->{trans}->write($data, 2);
 168     return 2;
 169 }
 170
 171 sub writeI32
 172 {
 173     my $self = shift;
 174     my $value= shift;
 175
 176     my $data = pack('N', $value);
 177     $self->{trans}->write($data, 4);
 178     return 4;
 179 }
 180
 181 sub writeI64
 182 {
 183     my $self = shift;
 184     my $value= shift;
 185     my $data;
 186
 187     my $vec;
 188     #stop annoying error
 189     $vec = Bit::Vector->new_Dec(64, $value);
 190     $data = pack 'NN', $vec->Chunk_Read(32, 32), $vec->Chunk_Read(32, 0);
 191
 192     $self->{trans}->write($data, 8);
 193
 194     return 8;
 195 }
 196
 197
 198 sub writeDouble
 199 {
 200     my $self = shift;
 201     my $value= shift;
 202
 203     my $data = pack('d', $value);
 204     $self->{trans}->write(scalar reverse($data), 8);
 205     return 8;
 206 }
 207
 208 sub writeString{
 209     my $self = shift;
 210     my $value= shift;
 211
 212     my $len = length($value);
 213
 214     my $result = $self->writeI32($len);
 215     if ($len) {
 216         $self->{trans}->write($value,$len);
 217     }
 218     return $result + $len;
 219   }
 220
 221
 222 #
 223 #All references
 224 #
 225 sub readMessageBegin
 226 {
 227     my $self = shift;
 228     my ($name, $type, $seqid) = @_;
 229
 230     my $version = 0;
 231     my $result = $self->readI32(\$version);
 232     if (($version & VERSION_MASK) > 0) {
 233       if (($version & VERSION_MASK) != VERSION_1) {
 234         die new Thrift::TException('Missing version identifier')
 235       }
 236       $$type = $version & 0x000000ff;
 237       return
 238           $result +
 239           $self->readString($name) +
 240           $self->readI32($seqid);
 241     } else { # old client support code
 242       return
 243         $result +
 244         $self->readStringBody($name, $version) + # version here holds the size of the string
 245         $self->readByte($type) +
 246         $self->readI32($seqid);
 247     }
 248 }
 249
 250 sub readMessageEnd
 251 {
 252     my $self = shift;
 253     return 0;
 254 }
 255
 256 sub readStructBegin
 257 {
 258     my $self = shift;
 259     my $name = shift;
 260
 261     $$name = '';
 262
 263     return 0;
 264 }
 265
 266 sub readStructEnd
 267 {
 268     my $self = shift;
 269     return 0;
 270 }
 271
 272 sub readFieldBegin
 273 {
 274     my $self = shift;
 275     my ($name, $fieldType, $fieldId) = @_;
 276
 277     my $result = $self->readByte($fieldType);
 278
 279     if ($$fieldType == TType::STOP) {
 280       $$fieldId = 0;
 281       return $result;
 282     }
 283
 284     $result += $self->readI16($fieldId);
 285
 286     return $result;
 287 }
 288
 289 sub readFieldEnd() {
 290     my $self = shift;
 291     return 0;
 292 }
 293
 294 sub readMapBegin
 295 {
 296     my $self = shift;
 297     my ($keyType, $valType, $size) = @_;
 298
 299     return
 300         $self->readByte($keyType) +
 301         $self->readByte($valType) +
 302         $self->readI32($size);
 303 }
 304
 305 sub readMapEnd()
 306 {
 307     my $self = shift;
 308     return 0;
 309 }
 310
 311 sub readListBegin
 312 {
 313     my $self = shift;
 314     my ($elemType, $size) = @_;
 315
 316     return
 317         $self->readByte($elemType) +
 318         $self->readI32($size);
 319 }
 320
 321 sub readListEnd
 322 {
 323     my $self = shift;
 324     return 0;
 325 }
 326
 327 sub readSetBegin
 328 {
 329     my $self = shift;
 330     my ($elemType, $size) = @_;
 331
 332     return
 333         $self->readByte($elemType) +
 334         $self->readI32($size);
 335 }
 336
 337 sub readSetEnd
 338 {
 339     my $self = shift;
 340     return 0;
 341 }
 342
 343 sub readBool
 344 {
 345     my $self  = shift;
 346     my $value = shift;
 347
 348     my $data = $self->{trans}->readAll(1);
 349     my @arr = unpack('c', $data);
 350     $$value = $arr[0] == 1;
 351     return 1;
 352 }
 353
 354 sub readByte
 355 {
 356     my $self  = shift;
 357     my $value = shift;
 358
 359     my $data = $self->{trans}->readAll(1);
 360     my @arr = unpack('c', $data);
 361     $$value = $arr[0];
 362     return 1;
 363 }
 364
 365 sub readI16
 366 {
 367     my $self  = shift;
 368     my $value = shift;
 369
 370     my $data  = $self->{trans}->readAll(2);
 371
 372     my @arr   = unpack('n', $data);
 373
 374     $$value = $arr[0];
 375
 376     if ($$value > 0x7fff) {
 377       $$value = 0 - (($$value - 1) ^ 0xffff);
 378     }
 379
 380     return 2;
 381 }
 382
 383 sub readI32
 384 {
 385     my $self = shift;
 386     my $value= shift;
 387
 388     my $data = $self->{trans}->readAll(4);
 389     my @arr = unpack('N', $data);
 390
 391     $$value = $arr[0];
 392     if ($$value > 0x7fffffff) {
 393       $$value = 0 - (($$value - 1) ^ 0xffffffff);
 394     }
 395     return 4;
 396 }
 397
 398 sub readI64
 399 {
 400     my $self  = shift;
 401     my $value = shift;
 402
 403     my $data = $self->{trans}->readAll(8);
 404
 405     my ($hi,$lo)=unpack('NN',$data);
 406
 407     my $vec = new Bit::Vector(64);
 408
 409     $vec->Chunk_Store(32,32,$hi);
 410     $vec->Chunk_Store(32,0,$lo);
 411
 412     $$value = $vec->to_Dec();
 413
 414     return 8;
 415 }
 416
 417 sub readDouble
 418 {
 419     my $self  = shift;
 420     my $value = shift;
 421
 422     my $data = scalar reverse($self->{trans}->readAll(8));
 423     my @arr = unpack('d', $data);
 424
 425     $$value = $arr[0];
 426
 427     return 8;
 428 }
 429
 430 sub readString
 431 {
 432     my $self  = shift;
 433     my $value = shift;
 434
 435     my $len;
 436     my $result = $self->readI32(\$len);
 437
 438     if ($len) {
 439       $$value = $self->{trans}->readAll($len);
 440     } else {
 441       $$value = '';
 442     }
 443
 444     return $result + $len;
 445 }
 446
 447 sub readStringBody
 448 {
 449     my $self  = shift;
 450     my $value = shift;
 451     my $len   = shift;
 452
 453     if ($len) {
 454       $$value = $self->{trans}->readAll($len);
 455     } else {
 456       $$value = '';
 457     }
 458
 459     return $len;
 460 }
 461
 462 #
 463 # Binary Protocol Factory
 464 #
 465 package TBinaryProtocolFactory;
 466 use base('TProtocolFactory');
 467
 468 sub new
 469 {
 470     my $classname = shift;
 471     my $self      = $classname->SUPER::new();
 472
 473     return bless($self,$classname);
 474 }
 475
 476 sub getProtocol{
 477     my $self  = shift;
 478     my $trans = shift;
 479
 480     return new TBinaryProtocol($trans);
 481 }
 482
 483 1;