From: Mark Slee Date: Wed, 16 May 2007 02:21:06 +0000 (+0000) Subject: Perl library for Thrift X-Git-Tag: 0.2.0~1360 X-Git-Url: https://source.supwisdom.com/gerrit/gitweb?a=commitdiff_plain;h=254ce20e51f61f919c8ff903ad66a72f0e133c99;p=common%2Fthrift.git Perl library for Thrift Summary: Submitted by Jake Luciani Reviewed By: mcslee git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@665112 13f79535-47bb-0310-9956-ffa450edef68 --- diff --git a/lib/perl/COPYING b/lib/perl/COPYING new file mode 100644 index 00000000..039f21e3 --- /dev/null +++ b/lib/perl/COPYING @@ -0,0 +1,24 @@ +Thrift Software License +Copyright (c) 2006- Facebook, Inc. + +Permission is hereby granted, free of charge, to any person or organization +obtaining a copy of the software and accompanying documentation covered by +this license (the "Software") to use, reproduce, display, distribute, +execute, and transmit the Software, and to prepare derivative works of the +Software, and to permit third-parties to whom the Software is furnished to +do so, all subject to the following: + +The copyright notices in the Software and this entire statement, including +the above license grant, this restriction and the following disclaimer, +must be included in all copies of the Software, in whole or in part, and +all derivative works of the Software, unless such copies or derivative +works are solely in the form of machine-executable object code generated by +a source language processor. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT +SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE +FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +DEALINGS IN THE SOFTWARE. diff --git a/lib/perl/LICENSE b/lib/perl/LICENSE new file mode 100644 index 00000000..039f21e3 --- /dev/null +++ b/lib/perl/LICENSE @@ -0,0 +1,24 @@ +Thrift Software License +Copyright (c) 2006- Facebook, Inc. + +Permission is hereby granted, free of charge, to any person or organization +obtaining a copy of the software and accompanying documentation covered by +this license (the "Software") to use, reproduce, display, distribute, +execute, and transmit the Software, and to prepare derivative works of the +Software, and to permit third-parties to whom the Software is furnished to +do so, all subject to the following: + +The copyright notices in the Software and this entire statement, including +the above license grant, this restriction and the following disclaimer, +must be included in all copies of the Software, in whole or in part, and +all derivative works of the Software, unless such copies or derivative +works are solely in the form of machine-executable object code generated by +a source language processor. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT +SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE +FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +DEALINGS IN THE SOFTWARE. diff --git a/lib/perl/Makefile.PL b/lib/perl/Makefile.PL new file mode 100644 index 00000000..fa3ea882 --- /dev/null +++ b/lib/perl/Makefile.PL @@ -0,0 +1,9 @@ +use ExtUtils::MakeMaker; +WriteMakefile( 'NAME' => 'Thrift', + 'VERSION_FROM' => 'lib/Thrift.pm', + 'PREREQ_PM' => { + 'Bit::Vector' => 0 + }, + ($] >= 5.005 ? + ( AUTHOR => 'T Jake Luciani ') : ()), + ); diff --git a/lib/perl/README b/lib/perl/README new file mode 100644 index 00000000..d1eef70b --- /dev/null +++ b/lib/perl/README @@ -0,0 +1,38 @@ +Thrift Perl Software Library + +Author: T Jake Luciani (jakers@gmail.com) +Last Modified: 2007-Apr-28 + +Thrift is distributed under the Thrift open source software license. +Please see the included LICENSE file. + +Using Thrift with Perl +===================== + +Thrift requires Perl >= 5.6.0 + +Exceptions are thrown with die so be sure to wrap eval{} statments +around any code that contains exceptions. + +The 64bit Integers work only upto 2^42 on my machine :-? +Math::BigInt is probably needed. + +The only other issue I have with this implementation is the lack of +strict accessor methods, for example: to set a struct with variable +foo you must assign it via hash key: + +my $x = new StructWithFoo(); +$x->{foo} = "bar"; + +rather than: + +$x->foo("bar"); + +Please see tutoral and test dirs for examples... + +Dependencies +============ + +Bit::Vector - comes with modern perl installations. + + diff --git a/lib/perl/lib/Thrift.pm b/lib/perl/lib/Thrift.pm new file mode 100644 index 00000000..bd0096f9 --- /dev/null +++ b/lib/perl/lib/Thrift.pm @@ -0,0 +1,169 @@ +# +# Copyright (c) 2006- Facebook +# Distributed under the Thrift Software License +# +# See accompanying file LICENSE or visit the Thrift site at: +# http://developers.facebook.com/thrift/ +# +# package - thrift +# author - T Jake Luciani +# author - Mark Slee +# + +our $VERSION = '0.1'; + +require 5.6.0; +use strict; +use warnings; + +# +# Data types that can be sent via Thrift +# +package TType; +use constant STOP => 0; +use constant VOID => 1; +use constant BOOL => 2; +use constant BYTE => 3; +use constant I08 => 3; +use constant DOUBLE => 4; +use constant I16 => 6; +use constant I32 => 8; +use constant I64 => 10; +use constant STRING => 11; +use constant UTF7 => 11; +use constant STRUCT => 12; +use constant MAP => 13; +use constant SET => 14; +use constant LIST => 15; +use constant UTF8 => 16; +use constant UTF16 => 17; +1; + +# +# Message types for RPC +# +package TMessageType; +use constant CALL => 1; +use constant REPLY => 2; +use constant EXCEPTION => 3; +1; + +package Thrift::TException; + +sub new { + my $classname = shift; + my $self = {message => shift, code => shift || 0}; + + return bless($self,$classname); +} +1; + +package TApplicationException; +use base('Thrift::TException'); + +use constant UNKNOWN => 0; +use constant UNKNOWN_METHOD => 1; +use constant INVALID_MESSAGE_TYPE => 2; +use constant WRONG_METHOD_NAME => 3; +use constant BAD_SEQUENCE_ID => 4; +use constant MISSING_RESULT => 5; + +sub new { + my $classname = shift; + + my $self = $classname->SUPER::new(); + + return bless($self,$classname); +} + +sub read { + my $self = shift; + my $input = shift; + + my $xfer = 0; + my $fname = undef; + my $ftype = 0; + my $fid = 0; + + $xfer += $input->readStructBegin($fname); + + while (1) + { + $xfer += $input->readFieldBegin($fname, $ftype, $fid); + if ($ftype == TType::STOP) { + last; next; + } + + SWITCH: for($fid) + { + /1/ && do{ + + if ($ftype == TType::STRING) { + $xfer += $input->readString($self->{message}); + } else { + $xfer += $input->skip($ftype); + } + + last; + }; + + /2/ && do{ + if ($ftype == TType::I32) { + $xfer += $input->readI32($self->{code}); + } else { + $xfer += $input->skip($ftype); + } + last; + }; + + $xfer += $input->skip($ftype); + } + + $xfer += $input->readFieldEnd(); + } + $xfer += $input->readStructEnd(); + + return $xfer; +} + +sub write { + my $self = shift; + my $output = shift; + + my $xfer = 0; + + $xfer += $output->writeStructBegin('TApplicationException'); + + if ($self->getMessage()) { + $xfer += $output->writeFieldBegin('message', TType::STRING, 1); + $xfer += $output->writeString($self->getMessage()); + $xfer += $output->writeFieldEnd(); + } + + if ($self->getCode()) { + $xfer += $output->writeFieldBegin('type', TType::I32, 2); + $xfer += $output->writeI32($self->getCode()); + $xfer += $output->writeFieldEnd(); + } + + $xfer += $output->writeFieldStop(); + $xfer += $output->writeStructEnd(); + + return $xfer; +} + +sub getMessage +{ + my $self = shift; + + return $self->{message}; +} + +sub getCode +{ + my $self = shift; + + return $self->{code}; +} + +1; diff --git a/lib/perl/lib/Thrift/BinaryProtocol.pm b/lib/perl/lib/Thrift/BinaryProtocol.pm new file mode 100644 index 00000000..c17fe91a --- /dev/null +++ b/lib/perl/lib/Thrift/BinaryProtocol.pm @@ -0,0 +1,451 @@ +# +# Copyright (c) 2006- Facebook +# Distributed under the Thrift Software License +# +# See accompanying file LICENSE or visit the Thrift site at: +# http://developers.facebook.com/thrift/ +# +# package - thrift.protocol.binary +# author - T Jake Luciani +# author - Mark Slee +# + +require 5.6.0; + +use strict; +use warnings; + +use Thrift; +use Thrift::Protocol; + +use Bit::Vector; + +# +# Binary implementation of the Thrift protocol. +# +package Thrift::BinaryProtocol; +use base('Thrift::Protocol'); + +sub new +{ + my $classname = shift; + my $trans = shift; + my $self = $classname->SUPER::new($trans); + + return bless($self,$classname); +} + +sub writeMessageBegin +{ + my $self = shift; + my ($name, $type, $seqid) = @_; + + return + $self->writeString($name) + + $self->writeByte($type) + + $self->writeI32($seqid); +} + +sub writeMessageEnd +{ + my $self = shift; + return 0; +} + +sub writeStructBegin{ + my $self = shift; + my $name = shift; + return 0; +} + +sub writeStructEnd +{ + my $self = shift; + return 0; +} + +sub writeFieldBegin +{ + my $self = shift; + my ($fieldName, $fieldType, $fieldId) = @_; + + return + $self->writeByte($fieldType) + + $self->writeI16($fieldId); +} + +sub writeFieldEnd +{ + my $self = shift; + return 0; +} + +sub writeFieldStop +{ + my $self = shift; + return $self->writeByte(TType::STOP); +} + +sub writeMapBegin +{ + my $self = shift; + my ($keyType, $valType, $size) = @_; + + return + $self->writeByte($keyType) + + $self->writeByte($valType) + + $self->writeI32($size); +} + +sub writeMapEnd +{ + my $self = shift; + return 0; +} + +sub writeListBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return + $self->writeByte($elemType) + + $self->writeI32($size); +} + +sub writeListEnd +{ + my $self = shift; + return 0; +} + +sub writeSetBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return + $self->writeByte($elemType) + + $self->writeI32($size); +} + +sub writeSetEnd +{ + my $self = shift; + return 0; +} + +sub writeBool +{ + my $self = shift; + my $value = shift; + + my $data = pack('c', $value ? 1 : 0); + $self->{trans}->write($data, 1); + return 1; +} + +sub writeByte +{ + my $self = shift; + my $value= shift; + + my $data = pack('c', $value); + $self->{trans}->write($data, 1); + return 1; +} + +sub writeI16 +{ + my $self = shift; + my $value= shift; + + my $data = pack('n', $value); + $self->{trans}->write($data, 2); + return 2; +} + +sub writeI32 +{ + my $self = shift; + my $value= shift; + + my $data = pack('N', $value); + $self->{trans}->write($data, 4); + return 4; +} + +sub writeI64 +{ + my $self = shift; + my $value= shift; + my $data; + + my $vec; + #stop annoying error + $vec = Bit::Vector->new_Dec(64, $value); + $data = pack 'NN', $vec->Chunk_Read(32, 32), $vec->Chunk_Read(32, 0); + + $self->{trans}->write($data, 8); + + return 8; +} + + +sub writeDouble +{ + my $self = shift; + my $value= shift; + + my $data = pack('d', $value); + $self->{trans}->write(scalar reverse($data), 8); + return 8; +} + +sub writeString{ + my $self = shift; + my $value= shift; + + my $len = length($value); + + my $result = $self->writeI32($len); + if ($len) { + $self->{trans}->write($value,$len); + } + return $result + $len; + } + + +# +#All references +# +sub readMessageBegin +{ + my $self = shift; + my ($name, $type, $seqid) = @_; + + return + $self->readString($name) + + $self->readByte($type) + + $self->readI32($seqid); +} + +sub readMessageEnd +{ + my $self = shift; + return 0; +} + +sub readStructBegin +{ + my $self = shift; + my $name = shift; + + $$name = ''; + + return 0; +} + +sub readStructEnd +{ + my $self = shift; + return 0; +} + +sub readFieldBegin +{ + my $self = shift; + my ($name, $fieldType, $fieldId) = @_; + + my $result = $self->readByte($fieldType); + + if ($$fieldType == TType::STOP) { + $$fieldId = 0; + return $result; + } + + $result += $self->readI16($fieldId); + + return $result; +} + +sub readFieldEnd() { + my $self = shift; + return 0; +} + +sub readMapBegin +{ + my $self = shift; + my ($keyType, $valType, $size) = @_; + + return + $self->readByte($keyType) + + $self->readByte($valType) + + $self->readI32($size); +} + +sub readMapEnd() +{ + my $self = shift; + return 0; +} + +sub readListBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return + $self->readByte($elemType) + + $self->readI32($size); +} + +sub readListEnd +{ + my $self = shift; + return 0; +} + +sub readSetBegin +{ + my $self = shift; + my ($elemType, $size) = @_; + + return + $self->readByte($elemType) + + $self->readI32($size); +} + +sub readSetEnd +{ + my $self = shift; + return 0; +} + +sub readBool +{ + my $self = shift; + my $value = shift; + + my $data = $self->{trans}->readAll(1); + my @arr = unpack('c', $data); + $$value = $arr[0] == 1; + return 1; +} + +sub readByte +{ + my $self = shift; + my $value = shift; + + my $data = $self->{trans}->readAll(1); + my @arr = unpack('c', $data); + $$value = $arr[0]; + return 1; +} + +sub readI16 +{ + my $self = shift; + my $value = shift; + + my $data = $self->{trans}->readAll(2); + + my @arr = unpack('n', $data); + + $$value = $arr[0]; + + if ($$value > 0x7fff) { + $$value = 0 - (($$value - 1) ^ 0xffff); + } + + return 2; +} + +sub readI32 +{ + my $self = shift; + my $value= shift; + + my $data = $self->{trans}->readAll(4); + my @arr = unpack('N', $data); + + $$value = $arr[0]; + if ($$value > 0x7fffffff) { + $$value = 0 - (($$value - 1) ^ 0xffffffff); + } + return 4; +} + +sub readI64 +{ + my $self = shift; + my $value = shift; + + my $data = $self->{trans}->readAll(8); + + my ($hi,$lo)=unpack('NN',$data); + + my $vec = new Bit::Vector(64); + + $vec->Chunk_Store(32,32,$hi); + $vec->Chunk_Store(32,0,$lo); + + $$value = $vec->to_Dec(); + + return 8; +} + +sub readDouble +{ + my $self = shift; + my $value = shift; + + my $data = scalar reverse($self->{trans}->readAll(8)); + my @arr = unpack('d', $data); + + $$value = $arr[0]; + + return 8; +} + +sub readString +{ + my $self = shift; + my $value = shift; + + my $len; + my $result = $self->readI32(\$len); + + if ($len) { + $$value = $self->{trans}->readAll($len); + } else { + $$value = ''; + } + + return $result + $len; +} + +# +# Binary Protocol Factory +# +package TBinaryProtocolFactory; +use base('TProtocolFactory'); + +sub new +{ + my $classname = shift; + my $self = $classname->SUPER::new(); + + return bless($self,$classname); +} + +sub getProtocol{ + my $self = shift; + my $trans = shift; + + return new TBinaryProtocol($trans); +} + +1; diff --git a/lib/perl/lib/Thrift/BufferedTransport.pm b/lib/perl/lib/Thrift/BufferedTransport.pm new file mode 100644 index 00000000..856a9432 --- /dev/null +++ b/lib/perl/lib/Thrift/BufferedTransport.pm @@ -0,0 +1,113 @@ +# +# Copyright (c) 2006- Facebook +# Distributed under the Thrift Software License +# +# See accompanying file LICENSE or visit the Thrift site at: +# http://developers.facebook.com/thrift/ +# +# package - thrift.transport.buffered +# author - T Jake Luciani +# author - Mark Slee +# + +require 5.6.0; +use strict; +use warnings; + +use Thrift; +use Thrift::Transport; + +package Thrift::BufferedTransport; +use base('Thrift::Transport'); + +sub new +{ + my $classname = shift; + my $transport = shift; + my $rBufSize = shift || 512; + my $wBufSize = shift || 512; + + my $self = { + transport => $transport, + rBufSize => $rBufSize, + wBufSize => $wBufSize, + wBuf => '', + rBuf => '', + }; + + return bless($self,$classname); +} + +sub isOpen +{ + my $self = shift; + + return $self->{transport}->isOpen(); +} + +sub open +{ + my $self = shift; + $self->{transport}->open(); +} + +sub close() +{ + my $self = shift; + $self->{transport}->close(); +} + +sub readAll +{ + my $self = shift; + my $len = shift; + + return $self->{transport}->readAll($len); +} + +sub read +{ + my $self = shift; + my $len = shift; + my $ret; + + # Methinks Perl is already buffering these for us + return $self->{transport}->read($len); + + if (length($self->{rBuf}) >= $len) { + $ret = substr($self->{rBuf}, 0, $len); + $self->{rBuf} = substr($self->rBuf_, $len); + return $ret; + } + + $self->{rBuf} .= $self->{transport}->read($self->{rBufSize}); + my $give = min(length($self->{rBuf}), $len); + $ret = substr($self->{rBuf}, 0, $give); + $self->{rBuf} = substr($self->{rBuf}, $give); + return $ret; +} + +sub write +{ + my $self = shift; + my $buf = shift; + + $self->{wBuf} .= $buf; + if (length($self->{wBuf}) >= $self->{wBufSize}) { + $self->{transport}->write($self->{wBuf}); + $self->{wBuf} = ''; + } +} + +sub flush +{ + my $self = shift; + + if (length($self->{wBuf}) > 0) { + $self->{transport}->write($self->{wBuf}); + $self->{wBuf} = ''; + } +} + + +1; diff --git a/lib/perl/lib/Thrift/FramedTransport.pm b/lib/perl/lib/Thrift/FramedTransport.pm new file mode 100644 index 00000000..43e7b6f6 --- /dev/null +++ b/lib/perl/lib/Thrift/FramedTransport.pm @@ -0,0 +1,156 @@ +# +# Copyright (c) 2006- Facebook +# Distributed under the Thrift Software License +# +# See accompanying file LICENSE or visit the Thrift site at: +# http://developers.facebook.com/thrift/ +# +# package - thrift +# author - T Jake Luciani +# author - Mark Slee +# +require 5.6.0; +use strict; +use warnings; + +use Thrift; +use Thrift::Transport; + +# +# Framed transport. Writes and reads data in chunks that are stamped with +# their length. +# +# @package thrift.transport +# @author Mark Slee +# +package Thrift::FramedTransport; + +use base('Thrift::Transport'); + +sub new +{ + my $classname = shift; + my $transport = shift; + my $read = shift || 1; + my $write = shift || 1; + + my $self = { + transport => $transport, + read => $read, + write => $write, + wBuf => '', + rBuf => '', + }; + + return bless($self,$classname); +} + +sub isOpen +{ + my $self = shift; + return $self->{transport}->isOpen(); +} + +sub open +{ + my $self = shift; + + $self->{transport}->open(); +} + +sub close +{ + my $self = shift; + + $self->{transport}->close(); +} + +# +# Reads from the buffer. When more data is required reads another entire +# chunk and serves future reads out of that. +# +# @param int $len How much data +# +sub read +{ + my $self = shift; + my $len = shift; + + unless($self->{read}) { + return $self->{transport}->read($len); + } + + if (length($self->{rBuf}) > 0) { + $self->_readFrame(); + } + + # Just return full buff + if ($len > length($self->{rBuf})) { + my $out = $self->{rBuf}; + $self->{rBuf} = ''; + return $out; + } + + # Return substr + my $out = substr($self->{rBuf}, 0, $len); + $self->{rBuf} = substr($self->{rBuf}, $len); + return $out; +} + +# +# Reads a chunk of data into the internal read buffer. +# (private) +sub _readFrame +{ + my $self = shift; + my $buf = $self->{transport}->readAll(4); + my @val = unpack('N', $buf); + my $sz = $val[1]; + + $self->{rBuf} = $self->{transport}->readAll($sz); +} + +# +# Writes some data to the pending output buffer. +# +# @param string $buf The data +# @param int $len Limit of bytes to write +# +sub write +{ + my $self = shift; + my $buf = shift; + my $len = shift; + + unless($self->{write}) { + return $self->{transport}->write($buf, $len); + } + + if ( defined $len && $len < length($buf)) { + $buf = substr($buf, 0, $len); + } + + $self->{wBuf} .= $buf; + } + +# +# Writes the output buffer to the stream in the format of a 4-byte length +# followed by the actual data. +# +sub flush +{ + my $self = shift; + + unless ($self->{write}) { + return $self->{transport}->flush(); + } + + my $out = pack('N', length($self->{wBuf})); + $out .= $self->{wBuf}; + $self->{transport}->write($out); + $self->{transport}->flush(); + $self->{wBuf} = ''; + +} + +1; diff --git a/lib/perl/lib/Thrift/Protocol.pm b/lib/perl/lib/Thrift/Protocol.pm new file mode 100644 index 00000000..ceea52e2 --- /dev/null +++ b/lib/perl/lib/Thrift/Protocol.pm @@ -0,0 +1,536 @@ +# +# Copyright (c) 2006- Facebook +# Distributed under the Thrift Software License +# +# See accompanying file LICENSE or visit the Thrift site at: +# http://developers.facebook.com/thrift/ +# +# package - thrift.protocol +# author - T Jake Luciani +# author - Mark Slee +# + +require 5.6.0; +use strict; +use warnings; + +use Thrift; + +# +# Protocol exceptions +# +package TProtocolException; +use base('Thrift::TException'); + +use constant UNKNOWN => 0; +use constant INVALID_DATA => 1; +use constant NEGATIVE_SIZE => 2; +use constant SIZE_LIMIT => 3; + + +sub new { + my $classname = shift; + + my $self = $classname->SUPER::new(); + + return bless($self,$classname); +} + +# +# Protocol base class module. +# +package Thrift::Protocol; + +sub new { + my $classname = shift; + my $self = {}; + + my $trans = shift; + $self->{trans}= $trans; + + return bless($self,$classname); +} + +sub getTransport +{ + my $self = shift; + + return $self->{trans}; +} + +# +# Writes the message header +# +# @param string $name Function name +# @param int $type message type TMessageType::CALL or TMessageType::REPLY +# @param int $seqid The sequence id of this message +# +sub writeMessageBegin +{ + my ($name, $type, $seqid); + die "abstract"; +} + +# +# Close the message +# +sub writeMessageEnd { + die "abstract"; +} + +# +# Writes a struct header. +# +# @param string $name Struct name +# @throws TException on write error +# @return int How many bytes written +# +sub writeStructBegin { + my ($name); + + die "abstract"; +} + +# +# Close a struct. +# +# @throws TException on write error +# @return int How many bytes written +# +sub writeStructEnd { + die "abstract"; +} + +# +# Starts a field. +# +# @param string $name Field name +# @param int $type Field type +# @param int $fid Field id +# @throws TException on write error +# @return int How many bytes written +# +sub writeFieldBegin { + my ($fieldName, $fieldType, $fieldId); + + die "abstract"; +} + +sub writeFieldEnd { + die "abstract"; +} + +sub writeFieldStop { + die "abstract"; +} + +sub writeMapBegin { + my ($keyType, $valType, $size); + + die "abstract"; +} + +sub writeMapEnd { + die "abstract"; +} + +sub writeListBegin { + my ($elemType, $size); + die "abstract"; +} + +sub writeListEnd { + die "abstract"; +} + +sub writeSetBegin { + my ($elemType, $size); + die "abstract"; +} + +sub writeSetEnd { + die "abstract"; +} + +sub writeBool { + my ($bool); + die "abstract"; +} + +sub writeByte { + my ($byte); + die "abstract"; +} + +sub writeI16 { + my ($i16); + die "abstract"; +} + +sub writeI32 { + my ($i32); + die "abstract"; +} + +sub writeI64 { + my ($i64); + die "abstract"; +} + +sub writeDouble { + my ($dub); + die "abstract"; +} + +sub writeString +{ + my ($str); + die "abstract"; +} + +# +# Reads the message header +# +# @param string $name Function name +# @param int $type message type TMessageType::CALL or TMessageType::REPLY +# @parem int $seqid The sequence id of this message +# +sub readMessageBegin +{ + my ($name, $type, $seqid); + die "abstract"; +} + +# +# Read the close of message +# +sub readMessageEnd +{ + die "abstract"; +} + +sub readStructBegin +{ + my($name); + + die "abstract"; +} + +sub readStructEnd +{ + die "abstract"; +} + +sub readFieldBegin +{ + my ($name, $fieldType, $fieldId); + die "abstract"; +} + +sub readFieldEnd +{ + die "abstract"; +} + +sub readMapBegin +{ + my ($keyType, $valType, $size); + die "abstract"; +} + +sub readMapEnd +{ + die "abstract"; +} + +sub readListBegin +{ + my ($elemType, $size); + die "abstract"; +} + +sub readListEnd +{ + die "abstract"; +} + +sub readSetBegin +{ + my ($elemType, $size); + die "abstract"; +} + +sub readSetEnd +{ + die "abstract"; +} + +sub readBool +{ + my ($bool); + die "abstract"; +} + +sub readByte +{ + my ($byte); + die "abstract"; +} + +sub readI16 +{ + my ($i16); + die "abstract"; +} + +sub readI32 +{ + my ($i32); + die "abstract"; +} + +sub readI64 +{ + my ($i64); + die "abstract"; +} + +sub readDouble +{ + my ($dub); + die "abstract"; +} + +sub readString +{ + my ($str); + die "abstract"; +} + +# +# The skip function is a utility to parse over unrecognized data without +# causing corruption. +# +# @param TType $type What type is it +# +sub skip +{ + my $self = shift; + my $type = shift; + + my $ref; + my $result; + my $i; + + if($type == TType::BOOL) + { + return $self->readBool(\$ref); + } + elsif($type == TType::BYTE){ + return $self->readByte(\$ref); + } + elsif($type == TType::I16){ + return $self->readI16(\$ref); + } + elsif($type == TType::I32){ + return $self->readI32(\$ref); + } + elsif($type == TType::I64){ + return $self->readI64(\$ref); + } + elsif($type == TType::DOUBLE){ + return $self->readDouble(\$ref); + } + elsif($type == TType::STRING) + { + return $self->readString(\$ref); + } + elsif($type == TType::STRUCT) + { + $result = $self->readStructBegin(\$ref); + while (1) { + my ($ftype,$fid); + $result += $self->readFieldBegin(\$ref, \$ftype, \$fid); + if ($ftype == TType::STOP) { + last; + } + $result += $self->skip($ftype); + $result += $self->readFieldEnd(); + } + $result += $self->readStructEnd(); + return $result; + } + elsif($type == TType::MAP) + { + my($keyType,$valType,$size); + $result = $self->readMapBegin(\$keyType, \$valType, \$size); + for ($i = 0; $i < $size; $i++) { + $result += $self->skip($keyType); + $result += $self->skip($valType); + } + $result += $self->readMapEnd(); + return $result; + } + elsif($type == TType::SET) + { + my ($elemType,$size); + $result = $self->readSetBegin(\$elemType, \$size); + for ($i = 0; $i < $size; $i++) { + $result += $self->skip($elemType); + } + $result += $self->readSetEnd(); + return $result; + } + elsif($type == TType::LIST) + { + my ($elemType,$size); + $result = $self->readListBegin(\$elemType, \$size); + for ($i = 0; $i < $size; $i++) { + $result += $self->skip($elemType); + } + $result += $self->readListEnd(); + return $result; + } + + + return 0; + + } + +# +# Utility for skipping binary data +# +# @param TTransport $itrans TTransport object +# @param int $type Field type +# +sub skipBinary +{ + my $self = shift; + my $itrans = shift; + my $type = shift; + + if($type == TType::BOOL) + { + return $itrans->readAll(1); + } + elsif($type == TType::BYTE) + { + return $itrans->readAll(1); + } + elsif($type == TType::I16) + { + return $itrans->readAll(2); + } + elsif($type == TType::I32) + { + return $itrans->readAll(4); + } + elsif($type == TType::I64) + { + return $itrans->readAll(8); + } + elsif($type == TType::DOUBLE) + { + return $itrans->readAll(8); + } + elsif( $type == TType::STRING ) + { + my @len = unpack('N', $itrans->readAll(4)); + my $len = $len[0]; + if ($len > 0x7fffffff) { + $len = 0 - (($len - 1) ^ 0xffffffff); + } + return 4 + $itrans->readAll($len); + } + elsif( $type == TType::STRUCT ) + { + my $result = 0; + while (1) { + my $ftype = 0; + my $fid = 0; + my $data = $itrans->readAll(1); + my @arr = unpack('c', $data); + $ftype = $arr[0]; + if ($ftype == TType::STOP) { + last; + } + # I16 field id + $result += $itrans->readAll(2); + $result += $self->skipBinary($itrans, $ftype); + } + return $result; + } + elsif($type == TType::MAP) + { + # Ktype + my $data = $itrans->readAll(1); + my @arr = unpack('c', $data); + my $ktype = $arr[0]; + # Vtype + $data = $itrans->readAll(1); + @arr = unpack('c', $data); + my $vtype = $arr[0]; + # Size + $data = $itrans->readAll(4); + @arr = unpack('N', $data); + my $size = $arr[0]; + if ($size > 0x7fffffff) { + $size = 0 - (($size - 1) ^ 0xffffffff); + } + my $result = 6; + for (my $i = 0; $i < $size; $i++) { + $result += $self->skipBinary($itrans, $ktype); + $result += $self->skipBinary($itrans, $vtype); + } + return $result; + } + elsif($type == TType::SET || $type == TType::LIST) + { + # Vtype + my $data = $itrans->readAll(1); + my @arr = unpack('c', $data); + my $vtype = $arr[0]; + # Size + $data = $itrans->readAll(4); + @arr = unpack('N', $data); + my $size = $arr[0]; + if ($size > 0x7fffffff) { + $size = 0 - (($size - 1) ^ 0xffffffff); + } + my $result = 5; + for (my $i = 0; $i < $size; $i++) { + $result += $self->skipBinary($itrans, $vtype); + } + return $result; + } + + return 0; + +} + +# +# Protocol factory creates protocol objects from transports +# +package TProtocolFactory; + + +sub new { + my $classname = shift; + my $self = {}; + + return bless($self,$classname); +} + +# +# Build a protocol from the base transport +# +# @return TProtcol protocol +# +sub getProtocol +{ + my ($trans); + die "interface"; +} + + +1; diff --git a/lib/perl/lib/Thrift/Socket.pm b/lib/perl/lib/Thrift/Socket.pm new file mode 100644 index 00000000..83daf4be --- /dev/null +++ b/lib/perl/lib/Thrift/Socket.pm @@ -0,0 +1,249 @@ +# +# Copyright (c) 2006- Facebook +# Distributed under the Thrift Software License +# +# See accompanying file LICENSE or visit the Thrift site at: +# http://developers.facebook.com/thrift/ +# +# package - thrift.socket +# author - T Jake Luciani +# author - Mark Slee +# + +require 5.6.0; +use strict; +use warnings; + +use Thrift; +use Thrift::Transport; + +use IO::Socket::INET; +use IO::Select; + +package Thrift::Socket; + +use base('Thrift::Transport'); + +sub new +{ + my $classname = shift; + my $host = shift || "localhost"; + my $port = shift || 9090; + my $debugHandler = shift; + + my $self = { + host => $host, + port => $port, + debugHandler => $debugHandler, + debug => 0, + sendTimeout => 100, + recvTimeout => 750, + handle => undef, + }; + + return bless($self,$classname); +} + + +sub setSendTimeout +{ + my $self = shift; + my $timeout = shift; + + $self->{sendTimeout} = $timeout; +} + +sub setRecvTimeout +{ + my $self = shift; + my $timeout = shift; + + $self->{recvTimeout} = $timeout; +} + + +# +#Sets debugging output on or off +# +# @param bool $debug +# +sub setDebug +{ + my $self = shift; + my $debug = shift; + + $self->{debug} = $debug; +} + +# +# Tests whether this is open +# +# @return bool true if the socket is open +# +sub isOpen +{ + my $self = shift; + + return $self->{handle}->handles->[0]->connected; +} + +# +# Connects the socket. +# +sub open +{ + my $self = shift; + + my $sock = IO::Socket::INET->new(PeerAddr => $self->{host}, + PeerPort => $self->{port}, + Proto => 'tcp', + Timeout => $self->{sendTimeout}/1000) + || do { + my $error = 'TSocket: Could not connect to '.$self->{host}.':'.$self->{port}.' ('.$!.')'; + + if ($self->{debug}) { + $self->{debugHandler}->($error); + } + + die new Thrift::TException($error); + + }; + + + $self->{handle} = new IO::Select( $sock ); +} + +# +# Closes the socket. +# +sub close +{ + my $self = shift; + + close( ($self->{handle}->handles())[0] ); +} + +# +# Uses stream get contents to do the reading +# +# @param int $len How many bytes +# @return string Binary data +# +sub readAll +{ + my $self = shift; + my $len = shift; + + + my $pre = ""; + while (1) { + + #check for timeout + my @sockets = $self->{handle}->can_read( $self->{recvTimeout} ); + + if(@sockets == 0){ + die new Thrift::TException('TSocket: timed out reading '.$len.' bytes from '. + $self->{host}.':'.$self->{port}); + } + + my $sock = $sockets[0]; + + my ($buf,$sz); + $sock->recv($buf, $len); + + if (!defined $buf || $buf eq '') { + + die new Thrift::TException('TSocket: Could not read '.$len.' bytes from '. + $self->{host}.':'.$self->{port}); + + } elsif (($sz = length($buf)) < $len) { + + $pre .= $buf; + $len -= $sz; + + } else { + return $pre.$buf; + } + } +} + +# +# Read from the socket +# +# @param int $len How many bytes +# @return string Binary data +# +sub read +{ + my $self = shift; + my $len = shift; + + #check for timeout + my @sockets = $self->{handle}->can_read( $self->{sendTimeout} ); + + if(@sockets == 0){ + die new Thrift::TException('TSocket: timed out reading '.$len.' bytes from '. + $self->{host}.':'.$self->{port}); + } + + my $sock = $sockets[0]; + + my ($buf,$sz); + $sock->recv($buf, $len); + + if (!defined $buf || $buf eq '') { + + die new TException('TSocket: Could not read '.$len.' bytes from '. + $self->{host}.':'.$self->{port}); + + } + + return $buf; +} + + +# +# Write to the socket. +# +# @param string $buf The data to write +# +sub write +{ + my $self = shift; + my $buf = shift; + + + while (length($buf) > 0) { + + + #check for timeout + my @sockets = $self->{handle}->can_write( $self->{recvTimeout} ); + + if(@sockets == 0){ + die new Thrift::TException('TSocket: timed out writing to bytes from '. + $self->{host}.':'.$self->{port}); + } + + my $sock = $sockets[0]; + + my $got = $sock->send($buf); + + if (!defined $got || $got == 0 ) { + die new Thrift::TException('TSocket: Could not write '.strlen($buf).' bytes '. + $self->{host}.':'.$self->{host}); + } + + $buf = substr($buf, $got); + } +} + +# +# Flush output to the socket. +# +sub flush +{ + my $self = shift; + my $ret = ($self->{handle}->handles())[0]->flush; +} + +1; diff --git a/lib/perl/lib/Thrift/Transport.pm b/lib/perl/lib/Thrift/Transport.pm new file mode 100644 index 00000000..989ccb68 --- /dev/null +++ b/lib/perl/lib/Thrift/Transport.pm @@ -0,0 +1,122 @@ +# +# Copyright (c) 2006- Facebook +# Distributed under the Thrift Software License +# +# See accompanying file LICENSE or visit the Thrift site at: +# http://developers.facebook.com/thrift/ +# +# package - thrift.transport +# author - T Jake Luciani +# author - Mark Slee +# + +require 5.6.0; +use strict; +use warnings; + +use Thrift; + +# +# Transport exceptions +# +package TTransportException; +use base('Thrift::TException'); + +use constant UNKNOWN => 0; +use constant NOT_OPEN => 1; +use constant ALREADY_OPEN => 2; +use constant TIMED_OUT => 3; +use constant END_OF_FILE => 4; + +sub new{ + my $classname = shift; + my $self = $classname->SUPER::new(@_); + + return bless($self,$classname); +} + +package Thrift::Transport; + +# +# Whether this transport is open. +# +# @return boolean true if open +# +sub isOpen +{ + die "abstract"; +} + +# +# Open the transport for reading/writing +# +# @throws TTransportException if cannot open +# +sub open +{ + die "abstract"; +} + +# +# Close the transport. +# +sub close +{ + die "abstract"; +} + +# +# Read some data into the array. +# +# @param int $len How much to read +# @return string The data that has been read +# @throws TTransportException if cannot read any more data +# +sub read +{ + my ($len); + die("abstract"); +} + +# +# Guarantees that the full amount of data is read. +# +# @return string The data, of exact length +# @throws TTransportException if cannot read data +# +sub readAll +{ + my $self = shift; + my $len = shift; + + my $data = ''; + my $got = 0; + + while (($got = length($data)) < $len) { + $data .= $self->read($len - $got); + } + + return $data; +} + +# +# Writes the given data out. +# +# @param string $buf The data to write +# @throws TTransportException if writing fails +# +sub write +{ + my ($buf); + die "abstract"; +} + +# +# Flushes any pending data out of a buffer +# +# @throws TTransportException if a writing error occurs +# +sub flush {} + +1; +