summaryrefslogtreecommitdiffstats
path: root/src/jaegertracing/thrift/lib/perl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/jaegertracing/thrift/lib/perl/MANIFEST.SKIP14
-rw-r--r--src/jaegertracing/thrift/lib/perl/Makefile.PL49
-rw-r--r--src/jaegertracing/thrift/lib/perl/Makefile.am108
-rw-r--r--src/jaegertracing/thrift/lib/perl/README.md124
-rwxr-xr-xsrc/jaegertracing/thrift/lib/perl/build-cpan-dist.sh56
-rw-r--r--src/jaegertracing/thrift/lib/perl/coding_standards.md2
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift.pm36
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/BinaryProtocol.pm518
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/BufferedTransport.pm139
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/Exception.pm161
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/FramedTransport.pm194
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/HttpClient.pm204
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/MemoryBuffer.pm148
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/MessageType.pm37
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProcessor.pm133
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProtocol.pm68
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/Protocol.pm549
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/ProtocolDecorator.pm363
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLServerSocket.pm76
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLSocket.pm126
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/Server.pm311
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/ServerSocket.pm125
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/Socket.pm327
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/Transport.pm180
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/Type.pm50
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixServerSocket.pm84
-rw-r--r--src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixSocket.pm67
-rw-r--r--src/jaegertracing/thrift/lib/perl/t/Makefile.am20
-rw-r--r--src/jaegertracing/thrift/lib/perl/t/memory_buffer.t53
-rw-r--r--src/jaegertracing/thrift/lib/perl/t/multiplex.t201
-rw-r--r--src/jaegertracing/thrift/lib/perl/t/processor.t104
-rw-r--r--src/jaegertracing/thrift/lib/perl/test.pl25
-rw-r--r--src/jaegertracing/thrift/lib/perl/tools/FixupDist.pl35
33 files changed, 4687 insertions, 0 deletions
diff --git a/src/jaegertracing/thrift/lib/perl/MANIFEST.SKIP b/src/jaegertracing/thrift/lib/perl/MANIFEST.SKIP
new file mode 100644
index 000000000..9b044509e
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/MANIFEST.SKIP
@@ -0,0 +1,14 @@
+blib/.*$
+build-cpan-dist.sh
+FixupDist.pl
+MANIFEST.bak
+MANIFEST.SKIP
+MYMETA.json
+Makefile
+Makefile.am
+Makefile.in
+pm_to_blib
+t/Makefile
+t/Makefile.am
+t/Makefile.in
+tools/FixupDist.pl
diff --git a/src/jaegertracing/thrift/lib/perl/Makefile.PL b/src/jaegertracing/thrift/lib/perl/Makefile.PL
new file mode 100644
index 000000000..5e60ab40a
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/Makefile.PL
@@ -0,0 +1,49 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile( ABSTRACT => 'Apache Thrift is a software framework for scalable cross-language services development.',
+ AUTHOR => 'Apache Thrift <dev@thrift.apache.org>',
+ LICENSE => 'apache_2_0',
+ MIN_PERL_VERSION => '5.010000',
+ NAME => 'Thrift',
+ NEEDS_LINKING => 0,
+ PREREQ_PM => {
+ 'Bit::Vector' => 0,
+ 'Class::Accessor' => 0
+ },
+# SIGN => 1,
+ VERSION_FROM => 'lib/Thrift.pm' );
+
+# THRIFT-4691
+package MY; # so that "SUPER" works right
+sub test {
+ # Adds gen-perl and gen-perl2 to the test execution as include paths
+ # Could not find anything in MakeMaker that would do this...
+ my @result;
+ for (@result = shift->SUPER::test(@_)) {
+ s/\$\(TEST_FILES\)/-Igen-perl -Igen-perl2 \$(TEST_FILES)/ig;
+ }
+ @result;
+}
diff --git a/src/jaegertracing/thrift/lib/perl/Makefile.am b/src/jaegertracing/thrift/lib/perl/Makefile.am
new file mode 100644
index 000000000..abae1e77f
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/Makefile.am
@@ -0,0 +1,108 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+SUBDIRS = t
+
+Makefile-perl.mk : Makefile.PL
+ $(PERL) Makefile.PL MAKEFILE=Makefile-perl.mk INSTALLDIRS=$(INSTALLDIRS) INSTALL_BASE=$(PERL_PREFIX)
+
+all-local: Makefile-perl.mk
+ $(MAKE) -f $<
+ find blib -name 'Makefile*' -exec rm -f {} \;
+
+install-exec-local: Makefile-perl.mk
+ $(MAKE) -f $< install DESTDIR=$(DESTDIR)/
+
+clean-local:
+ if test -f Makefile-perl.mk ; then \
+ $(MAKE) -f Makefile-perl.mk clean ; \
+ fi
+ $(RM) Makefile-perl.mk.old
+ $(RM) -r gen-perl gen-perl2
+
+EXTRA_DIST = \
+ coding_standards.md \
+ build-cpan-dist.sh \
+ Makefile.PL \
+ test.pl \
+ lib/Thrift.pm \
+ lib/Thrift.pm \
+ lib/Thrift/BinaryProtocol.pm \
+ lib/Thrift/BufferedTransport.pm \
+ lib/Thrift/Exception.pm \
+ lib/Thrift/FramedTransport.pm \
+ lib/Thrift/HttpClient.pm \
+ lib/Thrift/MemoryBuffer.pm \
+ lib/Thrift/MessageType.pm \
+ lib/Thrift/MultiplexedProcessor.pm \
+ lib/Thrift/MultiplexedProtocol.pm \
+ lib/Thrift/Protocol.pm \
+ lib/Thrift/ProtocolDecorator.pm \
+ lib/Thrift/Server.pm \
+ lib/Thrift/ServerSocket.pm \
+ lib/Thrift/Socket.pm \
+ lib/Thrift/SSLSocket.pm \
+ lib/Thrift/SSLServerSocket.pm \
+ lib/Thrift/UnixServerSocket.pm \
+ lib/Thrift/UnixSocket.pm \
+ lib/Thrift/Type.pm \
+ lib/Thrift/Transport.pm \
+ README.md
+
+THRIFT = @top_builddir@/compiler/cpp/thrift
+THRIFT_IF = @top_srcdir@/test/ThriftTest.thrift
+NAME_BENCHMARKSERVICE = @top_srcdir@/lib/rb/benchmark/Benchmark.thrift
+NAME_AGGR = @top_srcdir@/contrib/async-test/aggr.thrift
+
+THRIFTTEST_GEN = \
+ gen-perl/ThriftTest/Constants.pm \
+ gen-perl/ThriftTest/SecondService.pm \
+ gen-perl/ThriftTest/ThriftTest.pm \
+ gen-perl/ThriftTest/Types.pm
+
+BENCHMARK_GEN = \
+ gen-perl/BenchmarkService.pm \
+ gen-perl/Constants.pm \
+ gen-perl/Types.pm
+
+AGGR_GEN = \
+ gen-perl2/Aggr.pm \
+ gen-perl2/Constants.pm \
+ gen-perl2/Types.pm
+
+PERL_GEN = \
+ $(THRIFTTEST_GEN) \
+ $(BENCHMARK_GEN) \
+ $(AGGR_GEN)
+
+BUILT_SOURCES = $(PERL_GEN)
+
+check-local: $(PERL_GEN)
+ $(PERL) -Iblib/lib -I@abs_srcdir@ -I@builddir@/gen-perl2 -I@builddir@/gen-perl \
+ @abs_srcdir@/test.pl @abs_srcdir@/t/*.t
+
+$(THRIFTTEST_GEN): $(THRIFT_IF) $(THRIFT)
+ $(THRIFT) --gen perl $<
+
+$(BENCHMARK_GEN): $(NAME_BENCHMARKSERVICE) $(THRIFT)
+ $(THRIFT) --gen perl $<
+
+$(AGGR_GEN): $(NAME_AGGR) $(THRIFT)
+ $(MKDIR_P) gen-perl2
+ $(THRIFT) -out gen-perl2 --gen perl $<
diff --git a/src/jaegertracing/thrift/lib/perl/README.md b/src/jaegertracing/thrift/lib/perl/README.md
new file mode 100644
index 000000000..bd1e5b2e4
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/README.md
@@ -0,0 +1,124 @@
+Thrift Perl Software Library
+
+# Summary
+
+Apache Thrift is a software framework for scalable cross-language services development.
+It combines a software stack with a code generation engine to build services that work
+efficiently and seamlessly between many programming languages. A language-neutral IDL
+is used to generate functioning client libraries and server-side handling frameworks.
+
+# License
+
+Licensed to the Apache Software Foundation (ASF) under one
+or more contributor license agreements. See the NOTICE file
+distributed with this work for additional information
+regarding copyright ownership. The ASF licenses this file
+to you under the Apache License, Version 2.0 (the
+"License"); you may not use this file except in compliance
+with the License. You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+Unless required by applicable law or agreed to in writing,
+software distributed under the License is distributed on an
+"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+KIND, either express or implied. See the License for the
+specific language governing permissions and limitations
+under the License.
+
+# For More Information
+
+See the [Apache Thrift Web Site](http://thrift.apache.org/) for more information.
+
+# Using Thrift with Perl
+
+Thrift requires Perl >= 5.10.0
+
+Unexpected exceptions in a service handler are converted to
+TApplicationException with type INTERNAL ERROR and the string
+of the exception is delivered as the message.
+
+On the client side, exceptions are thrown with die, so be sure
+to wrap eval{} statments around any code that contains exceptions.
+
+Please see tutoral and test dirs for examples.
+
+The Perl ForkingServer ignores SIGCHLD allowing the forks to be
+reaped by the operating system naturally when they exit. This means
+one cannot use a custom SIGCHLD handler in the consuming perl
+implementation that calls serve(). It is acceptable to use
+a custom SIGCHLD handler within a thrift handler implementation
+as the ForkingServer resets the forked child process to use
+default signal handling.
+
+# Dependencies
+
+The following modules are not provided by Perl 5.10.0 but are required
+to use Thrift.
+
+## Runtime
+
+ * Bit::Vector
+ * Class::Accessor
+
+### HttpClient Transport
+
+These are only required if using Thrift::HttpClient:
+
+ * HTTP::Request
+ * IO::String
+ * LWP::UserAgent
+
+### SSL/TLS
+
+These are only required if using Thrift::SSLSocket or Thrift::SSLServerSocket:
+
+ * IO::Socket::SSL
+
+# Breaking Changes
+
+## 0.10.0
+
+The socket classes were refactored in 0.10.0 so that there is one package per
+file. This means `use Socket;` no longer defines SSLSocket. You can use this
+technique to make your application run against 0.10.0 as well as earlier versions:
+
+`eval { require Thrift::SSLSocket; } or do { require Thrift::Socket; }`
+
+## 0.11.0
+
+ * Namespaces of packages that were not scoped within Thrift have been fixed.
+ ** TApplicationException is now Thrift::TApplicationException
+ ** TException is now Thrift::TException
+ ** TMessageType is now Thrift::TMessageType
+ ** TProtocolException is now Thrift::TProtocolException
+ ** TProtocolFactory is now Thrift::TProtocolFactory
+ ** TTransportException is now Thrift::TTransportException
+ ** TType is now Thrift::TType
+
+If you need a single version of your code to work with both older and newer thrift
+namespace changes, you can make the new, correct namespaces behave like the old ones
+in your files with this technique to create an alias, which will allow you code to
+run against either version of the perl runtime for thrift:
+
+`BEGIN {*TType:: = *Thrift::TType::}`
+
+ * Packages found in Thrift.pm were moved into the Thrift/ directory in separate files:
+ ** Thrift::TApplicationException is now in Thrift/Exception.pm
+ ** Thrift::TException is now in Thrift/Exception.pm
+ ** Thrift::TMessageType is now in Thrift/MessageType.pm
+ ** Thrift::TType is now in Thrift/Type.pm
+
+If you need to modify your code to work against both older or newer thrift versions,
+you can deal with these changes in a backwards compatible way in your projects using eval:
+
+`eval { require Thrift::Exception; require Thrift::MessageType; require Thrift::Type; }
+ or do { require Thrift; }`
+
+# Deprecations
+
+## 0.11.0
+
+Thrift::HttpClient setRecvTimeout() and setSendTimeout() are deprecated.
+Use setTimeout instead.
+
diff --git a/src/jaegertracing/thrift/lib/perl/build-cpan-dist.sh b/src/jaegertracing/thrift/lib/perl/build-cpan-dist.sh
new file mode 100755
index 000000000..c92fd76b5
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/build-cpan-dist.sh
@@ -0,0 +1,56 @@
+#!/bin/bash
+#
+# This script is intended to be used after tagging the repository and updating
+# the version files for a release. It will create a CPAN archive. Run this
+# from inside a docker image like ubuntu-xenial.
+#
+
+set -e
+
+rm -f MANIFEST
+rm -rf Thrift-*
+
+# setup cpan without a prompt
+echo | cpan
+cpan install HTTP::Date Log::Log4perl
+cpan install CPAN
+cpan install CPAN::Meta ExtUtils::MakeMaker JSON::PP
+# cpan install Module::Signature
+
+perl Makefile.PL
+rm MYMETA.yml
+make manifest
+make dist
+
+#
+# We unpack the archive so we can add version metadata for CPAN
+# so that it properly indexes Thrift and remove unnecessary files.
+#
+
+echo '-----------------------------------------------------------'
+set -x
+
+DISTFILE=$(ls Thrift*.gz)
+NEWFILE=${DISTFILE/t-v/t-}
+if [[ "$DISTFILE" != "$NEWFILE" ]]; then
+ mv $DISTFILE $NEWFILE
+ DISTFILE="$NEWFILE"
+fi
+tar xzf $DISTFILE
+rm $DISTFILE
+DISTDIR=$(ls -d Thrift*)
+# cpan doesn't like "Thrift-v0.nn.0 as a directory name
+# needs to be Thrift-0.nn.0
+NEWDIR=${DISTDIR/t-v/t-}
+if [[ "$DISTDIR" != "$NEWDIR" ]]; then
+ mv $DISTDIR $NEWDIR
+ DISTDIR="$NEWDIR"
+fi
+cd $DISTDIR
+cp -p ../Makefile.PL .
+cp -pr ../gen-perl .
+cp -pr ../gen-perl2 .
+perl ../tools/FixupDist.pl
+cd ..
+tar cvzf --hard-dereference $DISTFILE $DISTDIR
+rm -r $DISTDIR
diff --git a/src/jaegertracing/thrift/lib/perl/coding_standards.md b/src/jaegertracing/thrift/lib/perl/coding_standards.md
new file mode 100644
index 000000000..e4e825555
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/coding_standards.md
@@ -0,0 +1,2 @@
+Please follow [General Coding Standards](/doc/coding_standards.md).
+Additional perl coding standards can be found in [perlstyle](http://perldoc.perl.org/perlstyle.html).
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift.pm
new file mode 100644
index 000000000..01985ea87
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift.pm
@@ -0,0 +1,36 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+#
+# Versioning
+#
+# Every perl module for Thrift will have the same version
+# declaration. For a production build, change it below to
+# something like "v0.11.0" and all of the packages in all
+# of the files will pick it up from here.
+#
+
+package Thrift;
+use version 0.77; our $VERSION = version->declare("v0.13.0");
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/BinaryProtocol.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/BinaryProtocol.pm
new file mode 100644
index 000000000..d62509a56
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/BinaryProtocol.pm
@@ -0,0 +1,518 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Bit::Vector;
+use Encode;
+use Thrift;
+use Thrift::Exception;
+use Thrift::MessageType;
+use Thrift::Protocol;
+use Thrift::Type;
+use utf8;
+
+#
+# Binary implementation of the Thrift protocol.
+#
+package Thrift::BinaryProtocol;
+use base('Thrift::Protocol');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+use constant VERSION_MASK => 0xffff0000;
+use constant VERSION_1 => 0x80010000;
+use constant IS_BIG_ENDIAN => unpack('h*', pack('s', 1)) =~ m/01/;
+
+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->writeI32(VERSION_1 | $type) +
+ $self->writeString($name) +
+ $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(Thrift::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);
+ if (IS_BIG_ENDIAN) {
+ $self->{trans}->write($data, 8);
+ }
+ else {
+ $self->{trans}->write(scalar reverse($data), 8);
+ }
+ return 8;
+}
+
+sub writeString{
+ my $self = shift;
+ my $value= shift;
+
+ if( utf8::is_utf8($value) ){
+ $value = Encode::encode_utf8($value);
+ }
+
+ 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) = @_;
+
+ my $version = 0;
+ my $result = $self->readI32(\$version);
+ if (($version & VERSION_MASK) > 0) {
+ if (($version & VERSION_MASK) != VERSION_1) {
+ die Thrift::TProtocolException->new('Missing version identifier',
+ Thrift::TProtocolException::BAD_VERSION);
+ }
+ $$type = $version & 0x000000ff;
+ return
+ $result +
+ $self->readString($name) +
+ $self->readI32($seqid);
+ }
+ else { # old client support code
+ return
+ $result +
+ $self->readStringBody($name, $version) + # version here holds the size of the string
+ $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 == Thrift::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 = Bit::Vector->new(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;
+ if (IS_BIG_ENDIAN) {
+ $data = $self->{trans}->readAll(8);
+ }
+ else {
+ $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;
+}
+
+sub readStringBody
+{
+ my $self = shift;
+ my $value = shift;
+ my $len = shift;
+
+ if ($len) {
+ $$value = $self->{trans}->readAll($len);
+ }
+ else {
+ $$value = '';
+ }
+
+ return $len;
+}
+
+#
+# Binary Protocol Factory
+#
+package Thrift::BinaryProtocolFactory;
+use base('Thrift::TProtocolFactory');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new
+{
+ my $classname = shift;
+ my $self = $classname->SUPER::new();
+
+ return bless($self,$classname);
+}
+
+sub getProtocol{
+ my $self = shift;
+ my $trans = shift;
+
+ return Thrift::BinaryProtocol->new($trans);
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/BufferedTransport.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/BufferedTransport.pm
new file mode 100644
index 000000000..6b5bf7a4c
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/BufferedTransport.pm
@@ -0,0 +1,139 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Exception;
+use Thrift::Transport;
+
+package Thrift::BufferedTransport;
+use base('Thrift::Transport');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+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);
+}
+
+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} = '';
+ }
+ $self->{transport}->flush();
+}
+
+
+#
+# BufferedTransport factory creates buffered transport objects from transports
+#
+package Thrift::BufferedTransportFactory;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new {
+ my $classname = shift;
+ my $self = {};
+
+ return bless($self,$classname);
+}
+
+#
+# Build a buffered transport from the base transport
+#
+# @return Thrift::BufferedTransport transport
+#
+sub getTransport
+{
+ my $self = shift;
+ my $trans = shift;
+
+ my $buffered = Thrift::BufferedTransport->new($trans);
+ return $buffered;
+}
+
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Exception.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Exception.pm
new file mode 100644
index 000000000..e4040689c
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Exception.pm
@@ -0,0 +1,161 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Type;
+
+package Thrift::TException;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+use overload '""' => sub {
+ return
+ sprintf '%s error: %s (code %s)',
+ ref( $_[0] ),
+ ( $_[0]->{message} || 'empty message' ),
+ ( defined $_[0]->{code} ? $_[0]->{code} : 'undefined' );
+ };
+
+sub new {
+ my $classname = shift;
+ my $self = {message => shift, code => shift || 0};
+
+ return bless($self,$classname);
+}
+
+package Thrift::TApplicationException;
+use parent -norequire, 'Thrift::TException';
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+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;
+use constant INTERNAL_ERROR => 6;
+use constant PROTOCOL_ERROR => 7;
+use constant INVALID_TRANSFORM => 8;
+use constant INVALID_PROTOCOL => 9;
+use constant UNSUPPORTED_CLIENT_TYPE => 10;
+
+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 == Thrift::TType::STOP) {
+ last; next;
+ }
+
+ SWITCH: for($fid)
+ {
+ /1/ && do{
+
+ if ($ftype == Thrift::TType::STRING) {
+ $xfer += $input->readString(\$self->{message});
+ }
+ else {
+ $xfer += $input->skip($ftype);
+ }
+
+ last;
+ };
+
+ /2/ && do{
+ if ($ftype == Thrift::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', Thrift::TType::STRING, 1);
+ $xfer += $output->writeString($self->getMessage());
+ $xfer += $output->writeFieldEnd();
+ }
+
+ if ($self->getCode()) {
+ $xfer += $output->writeFieldBegin('type', Thrift::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/src/jaegertracing/thrift/lib/perl/lib/Thrift/FramedTransport.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/FramedTransport.pm
new file mode 100644
index 000000000..ba89ba3e0
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/FramedTransport.pm
@@ -0,0 +1,194 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.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
+#
+package Thrift::FramedTransport;
+use base('Thrift::Transport');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+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;
+
+ if (defined $self->{transport}) {
+ $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;
+
+ if (!$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[0];
+
+ $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} = '';
+
+}
+
+#
+# FramedTransport factory creates framed transport objects from transports
+#
+package Thrift::FramedTransportFactory;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new {
+ my $classname = shift;
+ my $self = {};
+
+ return bless($self, $classname);
+}
+
+#
+# Build a framed transport from the base transport
+#
+# @return Thrift::FramedTransport transport
+#
+sub getTransport
+{
+ my $self = shift;
+ my $trans = shift;
+
+ my $buffered = Thrift::FramedTransport->new($trans);
+ return $buffered;
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/HttpClient.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/HttpClient.pm
new file mode 100644
index 000000000..40ec9ce20
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/HttpClient.pm
@@ -0,0 +1,204 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use HTTP::Request;
+use IO::String;
+use LWP::UserAgent;
+use Thrift;
+use Thrift::Exception;
+use Thrift::Transport;
+
+package Thrift::HttpClient;
+use base('Thrift::Transport');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new
+{
+ my $classname = shift;
+ my $url = shift || 'http://localhost:9090';
+
+ my $out = IO::String->new;
+ binmode($out);
+
+ my $self = {
+ url => $url,
+ out => $out,
+ timeout => 100,
+ handle => undef,
+ headers => {},
+ };
+
+ return bless($self,$classname);
+}
+
+sub setTimeout
+{
+ my $self = shift;
+ my $timeout = shift;
+
+ $self->{timeout} = $timeout;
+}
+
+sub setRecvTimeout
+{
+ warn 'setRecvTimeout is deprecated - use setTimeout instead';
+ # note: recvTimeout was never used so we do not need to do anything here
+}
+
+sub setSendTimeout
+{
+ my $self = shift;
+ my $timeout = shift;
+
+ warn 'setSendTimeout is deprecated - use setTimeout instead';
+
+ $self->setTimeout($timeout);
+}
+
+sub setHeader
+{
+ my $self = shift;
+ my ($name, $value) = @_;
+
+ $self->{headers}->{$name} = $value;
+}
+
+#
+# Tests whether this is open
+#
+# @return bool true if the socket is open
+#
+sub isOpen
+{
+ return 1;
+}
+
+sub open {}
+
+#
+# Cleans up the buffer.
+#
+sub close
+{
+ my $self = shift;
+ if (defined($self->{io})) {
+ close($self->{io});
+ $self->{io} = undef;
+ }
+}
+
+#
+# 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 $buf = $self->read($len);
+
+ if (!defined($buf)) {
+ die Thrift::TTransportException->new("TSocket: Could not read $len bytes from input buffer",
+ Thrift::TTransportException::END_OF_FILE);
+ }
+ return $buf;
+}
+
+#
+# Read and return string
+#
+sub read
+{
+ my $self = shift;
+ my $len = shift;
+
+ my $buf;
+
+ my $in = $self->{in};
+
+ if (!defined($in)) {
+ die Thrift::TTransportException->new('Response buffer is empty, no request.',
+ Thrift::TTransportException::END_OF_FILE);
+ }
+ eval {
+ my $ret = sysread($in, $buf, $len);
+ if (! defined($ret)) {
+ die Thrift::TTransportException->new('No more data available.',
+ Thrift::TTransportException::TIMED_OUT);
+ }
+ };
+ if($@){
+ die Thrift::TTransportException->new("$@", Thrift::TTransportException::UNKNOWN);
+ }
+
+ return $buf;
+}
+
+#
+# Write string
+#
+sub write
+{
+ my $self = shift;
+ my $buf = shift;
+ $self->{out}->print($buf);
+}
+
+#
+# Flush output (do the actual HTTP/HTTPS request)
+#
+sub flush
+{
+ my $self = shift;
+
+ my $ua = LWP::UserAgent->new(
+ 'timeout' => ($self->{timeout} / 1000),
+ 'agent' => 'Perl/THttpClient'
+ );
+ $ua->default_header('Accept' => 'application/x-thrift');
+ $ua->default_header('Content-Type' => 'application/x-thrift');
+ $ua->cookie_jar({}); # hash to remember cookies between redirects
+
+ my $out = $self->{out};
+ $out->setpos(0); # rewind
+ my $buf = join('', <$out>);
+
+ my $request = HTTP::Request->new(POST => $self->{url}, ($self->{headers} || undef), $buf);
+ my $response = $ua->request($request);
+ my $content_ref = $response->content_ref;
+
+ my $in = IO::String->new($content_ref);
+ binmode($in);
+ $self->{in} = $in;
+ $in->setpos(0); # rewind
+
+ # reset write buffer
+ $out = IO::String->new;
+ binmode($out);
+ $self->{out} = $out;
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/MemoryBuffer.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MemoryBuffer.pm
new file mode 100644
index 000000000..be97ce4f8
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MemoryBuffer.pm
@@ -0,0 +1,148 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Transport;
+
+package Thrift::MemoryBuffer;
+use base('Thrift::Transport');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new
+{
+ my $classname = shift;
+
+ my $bufferSize= shift || 1024;
+
+ my $self = {
+ buffer => '',
+ bufferSize => $bufferSize,
+ wPos => 0,
+ rPos => 0,
+ };
+
+ return bless($self,$classname);
+}
+
+sub isOpen
+{
+ return 1;
+}
+
+sub open
+{
+
+}
+
+sub close
+{
+
+}
+
+sub peek
+{
+ my $self = shift;
+ return($self->{rPos} < $self->{wPos});
+}
+
+
+sub getBuffer
+{
+ my $self = shift;
+ return $self->{buffer};
+}
+
+sub resetBuffer
+{
+ my $self = shift;
+
+ my $new_buffer = shift || '';
+
+ $self->{buffer} = $new_buffer;
+ $self->{bufferSize} = length($new_buffer);
+ $self->{wPos} = length($new_buffer);
+ $self->{rPos} = 0;
+}
+
+sub available
+{
+ my $self = shift;
+ return ($self->{wPos} - $self->{rPos});
+}
+
+sub read
+{
+ my $self = shift;
+ my $len = shift;
+ my $ret;
+
+ my $avail = ($self->{wPos} - $self->{rPos});
+ return '' if $avail == 0;
+
+ #how much to give
+ my $give = $len;
+ $give = $avail if $avail < $len;
+
+ $ret = substr($self->{buffer},$self->{rPos},$give);
+
+ $self->{rPos} += $give;
+
+ return $ret;
+}
+
+sub readAll
+{
+ my $self = shift;
+ my $len = shift;
+
+ my $avail = ($self->{wPos} - $self->{rPos});
+ if ($avail < $len) {
+ die TTransportException->new("Attempt to readAll($len) found only $avail available",
+ Thrift::TTransportException::END_OF_FILE);
+ }
+
+ my $data = '';
+ my $got = 0;
+
+ while (($got = length($data)) < $len) {
+ $data .= $self->read($len - $got);
+ }
+
+ return $data;
+}
+
+sub write
+{
+ my $self = shift;
+ my $buf = shift;
+
+ $self->{buffer} .= $buf;
+ $self->{wPos} += length($buf);
+}
+
+sub flush
+{
+
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/MessageType.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MessageType.pm
new file mode 100644
index 000000000..d25c2f771
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MessageType.pm
@@ -0,0 +1,37 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+
+#
+# Message types for RPC
+#
+package Thrift::TMessageType;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+use constant CALL => 1;
+use constant REPLY => 2;
+use constant EXCEPTION => 3;
+use constant ONEWAY => 4;
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProcessor.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProcessor.pm
new file mode 100644
index 000000000..ae925d7cd
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProcessor.pm
@@ -0,0 +1,133 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::MessageType;
+use Thrift::MultiplexedProtocol;
+use Thrift::Protocol;
+use Thrift::ProtocolDecorator;
+
+package Thrift::StoredMessageProtocol;
+use base qw(Thrift::ProtocolDecorator);
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new {
+ my $classname = shift;
+ my $protocol = shift;
+ my $fname = shift;
+ my $mtype = shift;
+ my $rseqid = shift;
+ my $self = $classname->SUPER::new($protocol);
+
+ $self->{fname} = $fname;
+ $self->{mtype} = $mtype;
+ $self->{rseqid} = $rseqid;
+
+ return bless($self,$classname);
+}
+
+sub readMessageBegin
+{
+ my $self = shift;
+ my $name = shift;
+ my $type = shift;
+ my $seqid = shift;
+
+ $$name = $self->{fname};
+ $$type = $self->{mtype};
+ $$seqid = $self->{rseqid};
+}
+
+package Thrift::MultiplexedProcessor;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new {
+ my $classname = shift;
+ my $self = {};
+
+ $self->{serviceProcessorMap} = {};
+ $self->{defaultProcessor} = undef;
+
+ return bless($self,$classname);
+}
+
+sub defaultProcessor {
+ my $self = shift;
+ my $processor = shift;
+
+ $self->{defaultProcessor} = $processor;
+}
+
+sub registerProcessor {
+ my $self = shift;
+ my $serviceName = shift;
+ my $processor = shift;
+
+ $self->{serviceProcessorMap}->{$serviceName} = $processor;
+}
+
+sub process {
+ my $self = shift;
+ my $input = shift;
+ my $output = shift;
+
+ #
+ # Use the actual underlying protocol (e.g. BinaryProtocol) to read the
+ # message header. This pulls the message "off the wire", which we'll
+ # deal with at the end of this method.
+ #
+
+ my ($fname, $mtype, $rseqid);
+ $input->readMessageBegin(\$fname, \$mtype, \$rseqid);
+
+ if ($mtype ne Thrift::TMessageType::CALL && $mtype ne Thrift::TMessageType::ONEWAY) {
+ die Thrift::TException->new('This should not have happened!?');
+ }
+
+ # Extract the service name and the new Message name.
+ if (index($fname, Thrift::MultiplexedProtocol::SEPARATOR) == -1) {
+ if (defined $self->{defaultProcessor}) {
+ return $self->{defaultProcessor}->process(
+ Thrift::StoredMessageProtocol->new($input, $fname, $mtype, $rseqid), $output
+ );
+ } else {
+ die Thrift::TException->new("Service name not found in message name: {$fname} and no default processor defined. Did you " .
+ 'forget to use a MultiplexProtocol in your client?');
+ }
+ }
+
+ (my $serviceName, my $messageName) = split(':', $fname, 2);
+
+ if (!exists($self->{serviceProcessorMap}->{$serviceName})) {
+ die Thrift::TException->new("Service name not found: {$serviceName}. Did you forget " .
+ 'to call registerProcessor()?');
+ }
+
+ # Dispatch processing to the stored processor
+ my $processor = $self->{serviceProcessorMap}->{$serviceName};
+ return $processor->process(
+ Thrift::StoredMessageProtocol->new($input, $messageName, $mtype, $rseqid), $output
+ );
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProtocol.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProtocol.pm
new file mode 100644
index 000000000..5b5b60bc7
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/MultiplexedProtocol.pm
@@ -0,0 +1,68 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::MessageType;
+use Thrift::Protocol;
+use Thrift::ProtocolDecorator;
+
+package Thrift::MultiplexedProtocol;
+use base qw(Thrift::ProtocolDecorator);
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+use constant SEPARATOR => ':';
+
+sub new {
+ my $classname = shift;
+ my $protocol = shift;
+ my $serviceName = shift;
+ my $self = $classname->SUPER::new($protocol);
+
+ $self->{serviceName} = $serviceName;
+
+ return bless($self,$classname);
+}
+
+#
+# Writes the message header.
+# Prepends the service name to the function name, separated by MultiplexedProtocol::SEPARATOR.
+#
+# @param string $name Function name.
+# @param int $type Message type.
+# @param int $seqid The sequence id of this message.
+#
+sub writeMessageBegin
+{
+ my $self = shift;
+ my ($name, $type, $seqid) = @_;
+
+ if ($type == Thrift::TMessageType::CALL || $type == Thrift::TMessageType::ONEWAY) {
+ my $nameWithService = $self->{serviceName}.SEPARATOR.$name;
+ $self->SUPER::writeMessageBegin($nameWithService, $type, $seqid);
+ }
+ else {
+ $self->SUPER::writeMessageBegin($name, $type, $seqid);
+ }
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Protocol.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Protocol.pm
new file mode 100644
index 000000000..26ef46a00
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Protocol.pm
@@ -0,0 +1,549 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Exception;
+use Thrift::Type;
+
+#
+# Protocol exceptions
+#
+package Thrift::TProtocolException;
+use base('Thrift::TException');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+use constant UNKNOWN => 0;
+use constant INVALID_DATA => 1;
+use constant NEGATIVE_SIZE => 2;
+use constant SIZE_LIMIT => 3;
+use constant BAD_VERSION => 4;
+use constant NOT_IMPLEMENTED => 5;
+use constant DEPTH_LIMIT => 6;
+
+sub new {
+ my $classname = shift;
+
+ my $self = $classname->SUPER::new();
+
+ return bless($self,$classname);
+}
+
+#
+# Protocol base class module.
+#
+package Thrift::Protocol;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+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 TProtocolException on write error
+# @return int How many bytes written
+#
+sub writeStructBegin {
+ my ($name);
+
+ die 'abstract';
+}
+
+#
+# Close a struct.
+#
+# @throws TProtocolException 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 TProtocolException 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 == Thrift::TType::BOOL)
+ {
+ return $self->readBool(\$ref);
+ }
+ elsif($type == Thrift::TType::BYTE){
+ return $self->readByte(\$ref);
+ }
+ elsif($type == Thrift::TType::I16){
+ return $self->readI16(\$ref);
+ }
+ elsif($type == Thrift::TType::I32){
+ return $self->readI32(\$ref);
+ }
+ elsif($type == Thrift::TType::I64){
+ return $self->readI64(\$ref);
+ }
+ elsif($type == Thrift::TType::DOUBLE){
+ return $self->readDouble(\$ref);
+ }
+ elsif($type == Thrift::TType::STRING)
+ {
+ return $self->readString(\$ref);
+ }
+ elsif($type == Thrift::TType::STRUCT)
+ {
+ $result = $self->readStructBegin(\$ref);
+ while (1) {
+ my ($ftype,$fid);
+ $result += $self->readFieldBegin(\$ref, \$ftype, \$fid);
+ if ($ftype == Thrift::TType::STOP) {
+ last;
+ }
+ $result += $self->skip($ftype);
+ $result += $self->readFieldEnd();
+ }
+ $result += $self->readStructEnd();
+ return $result;
+ }
+ elsif($type == Thrift::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 == Thrift::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 == Thrift::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;
+ }
+
+ die Thrift::TProtocolException->new("Type $type not recognized --- corrupt data?",
+ Thrift::TProtocolException::INVALID_DATA);
+
+ }
+
+#
+# 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 == Thrift::TType::BOOL)
+ {
+ return $itrans->readAll(1);
+ }
+ elsif($type == Thrift::TType::BYTE)
+ {
+ return $itrans->readAll(1);
+ }
+ elsif($type == Thrift::TType::I16)
+ {
+ return $itrans->readAll(2);
+ }
+ elsif($type == Thrift::TType::I32)
+ {
+ return $itrans->readAll(4);
+ }
+ elsif($type == Thrift::TType::I64)
+ {
+ return $itrans->readAll(8);
+ }
+ elsif($type == Thrift::TType::DOUBLE)
+ {
+ return $itrans->readAll(8);
+ }
+ elsif( $type == Thrift::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 == Thrift::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 == Thrift::TType::STOP) {
+ last;
+ }
+ # I16 field id
+ $result += $itrans->readAll(2);
+ $result += $self->skipBinary($itrans, $ftype);
+ }
+ return $result;
+ }
+ elsif($type == Thrift::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 == Thrift::TType::SET || $type == Thrift::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;
+ }
+
+ die Thrift::TProtocolException->new("Type $type not recognized --- corrupt data?",
+ Thrift::TProtocolException::INVALID_DATA);
+}
+
+#
+# Protocol factory creates protocol objects from transports
+#
+package Thrift::TProtocolFactory;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+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/src/jaegertracing/thrift/lib/perl/lib/Thrift/ProtocolDecorator.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/ProtocolDecorator.pm
new file mode 100644
index 000000000..cc5c9dae0
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/ProtocolDecorator.pm
@@ -0,0 +1,363 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Protocol;
+
+package Thrift::ProtocolDecorator;
+use base qw(Thrift::Protocol);
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new {
+ my $classname = shift;
+ my $protocol = shift;
+ my $self = $classname->SUPER::new($protocol->getTransport());
+
+ $self->{concreteProtocol} = $protocol;
+
+ return bless($self,$classname);
+}
+
+#
+# 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 $self = shift;
+ my ($name, $type, $seqid) = @_;
+
+ return $self->{concreteProtocol}->writeMessageBegin($name, $type, $seqid);
+}
+
+#
+# Close the message
+#
+sub writeMessageEnd {
+ my $self = shift;
+
+ return $self->{concreteProtocol}->writeMessageEnd();
+}
+
+#
+# Writes a struct header.
+#
+# @param string $name Struct name
+# @throws TException on write error
+# @return int How many bytes written
+#
+sub writeStructBegin {
+ my $self = shift;
+ my ($name) = @_;
+
+ return $self->{concreteProtocol}->writeStructBegin($name);
+}
+
+#
+# Close a struct.
+#
+# @throws TException on write error
+# @return int How many bytes written
+#
+sub writeStructEnd {
+ my $self = shift;
+
+ return $self->{concreteProtocol}->writeStructEnd();
+}
+
+#
+# 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 $self = shift;
+ my ($fieldName, $fieldType, $fieldId) = @_;
+
+ return $self->{concreteProtocol}->writeFieldBegin($fieldName, $fieldType, $fieldId);
+}
+
+sub writeFieldEnd {
+ my $self = shift;
+
+ return $self->{concreteProtocol}->writeFieldEnd();
+}
+
+sub writeFieldStop {
+ my $self = shift;
+
+ return $self->{concreteProtocol}->writeFieldStop();
+}
+
+sub writeMapBegin {
+ my $self = shift;
+ my ($keyType, $valType, $size) = @_;
+
+ return $self->{concreteProtocol}->writeMapBegin($keyType, $valType, $size);
+}
+
+sub writeMapEnd {
+ my $self = shift;
+
+ return $self->{concreteProtocol}->writeMapEnd();
+}
+
+sub writeListBegin {
+ my $self = shift;
+ my ($elemType, $size) = @_;
+
+ return $self->{concreteProtocol}->writeListBegin($elemType, $size);
+}
+
+sub writeListEnd {
+ my $self = shift;
+
+ return $self->{concreteProtocol}->writeListEnd();
+}
+
+sub writeSetBegin {
+ my $self = shift;
+ my ($elemType, $size) = @_;
+
+ return $self->{concreteProtocol}->writeSetBegin($elemType, $size);
+}
+
+sub writeSetEnd {
+ my $self = shift;
+
+ return $self->{concreteProtocol}->writeListEnd();
+}
+
+sub writeBool {
+ my $self = shift;
+ my $bool = shift;
+
+ return $self->{concreteProtocol}->writeBool($bool);
+}
+
+sub writeByte {
+ my $self = shift;
+ my $byte = shift;
+
+ return $self->{concreteProtocol}->writeByte($byte);
+}
+
+sub writeI16 {
+ my $self = shift;
+ my $i16 = shift;
+
+ return $self->{concreteProtocol}->writeI16($i16);
+}
+
+sub writeI32 {
+ my $self = shift;
+ my ($i32) = @_;
+
+ return $self->{concreteProtocol}->writeI32($i32);
+
+}
+
+sub writeI64 {
+ my $self = shift;
+ my $i64 = shift;
+
+ return $self->{concreteProtocol}->writeI64($i64);
+}
+
+sub writeDouble {
+ my $self = shift;
+ my $dub = shift;
+
+ return $self->{concreteProtocol}->writeDouble($dub);
+}
+
+sub writeString {
+ my $self = shift;
+ my $str = shift;
+
+ return $self->{concreteProtocol}->writeString($str);
+}
+
+#
+# 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 $self = shift;
+ my ($name, $type, $seqid) = @_;
+
+ return $self->{concreteProtocol}->readMessageBegin($name, $type, $seqid);
+}
+
+#
+# Read the close of message
+#
+sub readMessageEnd
+{
+ my $self = shift;
+
+ return $self->{concreteProtocol}->readMessageEnd();
+}
+
+sub readStructBegin
+{
+ my $self = shift;
+ my $name = shift;
+
+ return $self->{concreteProtocol}->readStructBegin($name);
+}
+
+sub readStructEnd
+{
+ my $self = shift;
+
+ return $self->{concreteProtocol}->readStructEnd();
+}
+
+sub readFieldBegin
+{
+ my $self = shift;
+ my ($name, $fieldType, $fieldId) = @_;
+
+ return $self->{concreteProtocol}->readFieldBegin($name, $fieldType, $fieldId);
+}
+
+sub readFieldEnd
+{
+ my $self = shift;
+
+ return $self->{concreteProtocol}->readFieldEnd();
+}
+
+sub readMapBegin
+{
+ my $self = shift;
+ my ($keyType, $valType, $size) = @_;
+
+ return $self->{concreteProtocol}->readMapBegin($keyType, $valType, $size);
+}
+
+sub readMapEnd
+{
+ my $self = shift;
+
+ return $self->{concreteProtocol}->readMapEnd();
+}
+
+sub readListBegin
+{
+ my $self = shift;
+ my ($elemType, $size) = @_;
+
+ return $self->{concreteProtocol}->readListBegin($elemType, $size);
+}
+
+sub readListEnd
+{
+ my $self = shift;
+
+ return $self->{concreteProtocol}->readListEnd();
+}
+
+sub readSetBegin
+{
+ my $self = shift;
+ my ($elemType, $size) = @_;
+
+ return $self->{concreteProtocol}->readSetBegin($elemType, $size);
+}
+
+sub readSetEnd
+{
+ my $self = shift;
+
+ return $self->{concreteProtocol}->readSetEnd();
+}
+
+sub readBool
+{
+ my $self = shift;
+ my $bool = shift;
+
+ return $self->{concreteProtocol}->readBool($bool);
+}
+
+sub readByte
+{
+ my $self = shift;
+ my $byte = shift;
+
+ return $self->{concreteProtocol}->readByte($byte);
+}
+
+sub readI16
+{
+ my $self = shift;
+ my $i16 = shift;
+
+ return $self->{concreteProtocol}->readI16($i16);
+}
+
+sub readI32
+{
+ my $self = shift;
+ my $i32 = shift;
+
+ return $self->{concreteProtocol}->readI32($i32);
+}
+
+sub readI64
+{
+ my $self = shift;
+ my $i64 = shift;
+
+ return $self->{concreteProtocol}->readI64($i64);
+}
+
+sub readDouble
+{
+ my $self = shift;
+ my $dub = shift;
+
+ return $self->{concreteProtocol}->readDouble($dub);
+}
+
+sub readString
+{
+ my $self = shift;
+ my $str = shift;
+
+ return $self->{concreteProtocol}->readString($str);
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLServerSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLServerSocket.pm
new file mode 100644
index 000000000..7b0643102
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLServerSocket.pm
@@ -0,0 +1,76 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::SSLSocket;
+use Thrift::ServerSocket;
+
+use IO::Socket::SSL;
+
+package Thrift::SSLServerSocket;
+use base qw( Thrift::ServerSocket );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+#
+# Constructor.
+# Takes a hash:
+# See Thrift::Socket for base class parameters.
+# @param[in] ca certificate authority filename - not required
+# @param[in] cert certificate filename; may contain key in which case key is not required
+# @param[in] key private key filename for the certificate if it is not inside the cert file
+#
+sub new
+{
+ my $classname = shift;
+ my $self = $classname->SUPER::new(@_);
+ return bless($self, $classname);
+}
+
+sub __client
+{
+ return Thrift::SSLSocket->new();
+}
+
+sub __listen
+{
+ my $self = shift;
+ my $opts = {Listen => $self->{queue},
+ LocalAddr => $self->{host},
+ LocalPort => $self->{port},
+ Proto => 'tcp',
+ ReuseAddr => 1};
+
+ my $verify = IO::Socket::SSL::SSL_VERIFY_PEER | IO::Socket::SSL::SSL_VERIFY_FAIL_IF_NO_PEER_CERT | IO::Socket::SSL::SSL_VERIFY_CLIENT_ONCE;
+
+ $opts->{SSL_ca_file} = $self->{ca} if defined $self->{ca};
+ $opts->{SSL_cert_file} = $self->{cert} if defined $self->{cert};
+ $opts->{SSL_cipher_list} = $self->{ciphers} if defined $self->{ciphers};
+ $opts->{SSL_key_file} = $self->{key} if defined $self->{key};
+ $opts->{SSL_use_cert} = (defined $self->{cert}) ? 1 : 0;
+ $opts->{SSL_verify_mode} = (defined $self->{ca}) ? $verify : IO::Socket::SSL::SSL_VERIFY_NONE;
+ $opts->{SSL_version} = (defined $self->{version}) ? $self->{version} : 'SSLv23:!SSLv3:!SSLv2';
+
+ return IO::Socket::SSL->new(%$opts);
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLSocket.pm
new file mode 100644
index 000000000..e34924df4
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/SSLSocket.pm
@@ -0,0 +1,126 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Socket;
+
+use IO::Socket::SSL;
+
+package Thrift::SSLSocket;
+use base qw( Thrift::Socket );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+#
+# Construction and usage
+#
+# my $opts = {}
+# my $socket = Thrift::SSLSocket->new(\%opts);
+#
+# options:
+#
+# Any option from Socket.pm is valid, and then:
+#
+# ca => certificate authority file (PEM file) to authenticate the
+# server against; if not specified then the server is not
+# authenticated
+# cert => certificate to use as the client; if not specified then
+# the client does not present one but still connects using
+# secure protocol
+# ciphers => allowed cipher list
+# (see http://www.openssl.org/docs/apps/ciphers.html#CIPHER_STRINGS)
+# key => certificate key for "cert" option
+# version => acceptable SSL/TLS versions - if not specified then the
+# default is to use SSLv23 handshake but only negotiate
+# at TLSv1.0 or later
+#
+
+sub new
+{
+ my $classname = shift;
+ my $self = $classname->SUPER::new(@_);
+
+ return bless($self, $classname);
+}
+
+sub __open
+{
+ my $self = shift;
+ my $opts = {PeerAddr => $self->{host},
+ PeerPort => $self->{port},
+ Proto => 'tcp',
+ Timeout => $self->{sendTimeout} / 1000};
+
+ my $verify = IO::Socket::SSL::SSL_VERIFY_PEER | IO::Socket::SSL::SSL_VERIFY_FAIL_IF_NO_PEER_CERT | IO::Socket::SSL::SSL_VERIFY_CLIENT_ONCE;
+
+ $opts->{SSL_ca_file} = $self->{ca} if defined $self->{ca};
+ $opts->{SSL_cert_file} = $self->{cert} if defined $self->{cert};
+ $opts->{SSL_cipher_list} = $self->{ciphers} if defined $self->{ciphers};
+ $opts->{SSL_key_file} = $self->{key} if defined $self->{key};
+ $opts->{SSL_use_cert} = (defined $self->{cert}) ? 1 : 0;
+ $opts->{SSL_verify_mode} = (defined $self->{ca}) ? $verify : IO::Socket::SSL::SSL_VERIFY_NONE;
+ $opts->{SSL_version} = (defined $self->{version}) ? $self->{version} : 'SSLv23:!SSLv3:!SSLv2';
+
+ return IO::Socket::SSL->new(%$opts);
+}
+
+sub __close
+{
+ my $self = shift;
+ my $sock = ($self->{handle}->handles())[0];
+ if ($sock) {
+ $sock->close(SSL_no_shutdown => 1);
+ }
+}
+
+sub __recv
+{
+ my $self = shift;
+ my $sock = shift;
+ my $len = shift;
+ my $buf = undef;
+ if ($sock) {
+ sysread($sock, $buf, $len);
+ }
+ return $buf;
+}
+
+sub __send
+{
+ my $self = shift;
+ my $sock = shift;
+ my $buf = shift;
+ return syswrite($sock, $buf);
+}
+
+sub __wait
+{
+ my $self = shift;
+ my $sock = ($self->{handle}->handles())[0];
+ if ($sock and $sock->pending() eq 0) {
+ return $self->SUPER::__wait();
+ }
+ return $sock;
+}
+
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Server.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Server.pm
new file mode 100644
index 000000000..28822e874
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Server.pm
@@ -0,0 +1,311 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::BinaryProtocol;
+use Thrift::BufferedTransport;
+use Thrift::Exception;
+
+#
+# Server base class module
+#
+package Thrift::Server;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+#
+# 3 possible constructors:
+# 1. (processor, serverTransport)
+# Uses a BufferedTransportFactory and a BinaryProtocolFactory.
+# 2. (processor, serverTransport, transportFactory, protocolFactory)
+# Uses the same factory for input and output of each type.
+# 3. (processor, serverTransport,
+# inputTransportFactory, outputTransportFactory,
+# inputProtocolFactory, outputProtocolFactory)
+#
+sub new
+{
+ my $classname = shift;
+ my @args = @_;
+
+ my $self;
+
+ if (scalar @args == 2)
+ {
+ $self = _init($args[0], $args[1],
+ Thrift::BufferedTransportFactory->new(),
+ Thrift::BufferedTransportFactory->new(),
+ Thrift::BinaryProtocolFactory->new(),
+ Thrift::BinaryProtocolFactory->new());
+ }
+ elsif (scalar @args == 4)
+ {
+ $self = _init($args[0], $args[1], $args[2], $args[2], $args[3], $args[3]);
+ }
+ elsif (scalar @args == 6)
+ {
+ $self = _init($args[0], $args[1], $args[2], $args[3], $args[4], $args[5]);
+ }
+ else
+ {
+ die Thrift::TException->new('Thrift::Server expects exactly 2, 4, or 6 args');
+ }
+
+ return bless($self,$classname);
+}
+
+sub _init
+{
+ my $processor = shift;
+ my $serverTransport = shift;
+ my $inputTransportFactory = shift;
+ my $outputTransportFactory = shift;
+ my $inputProtocolFactory = shift;
+ my $outputProtocolFactory = shift;
+
+ my $self = {
+ processor => $processor,
+ serverTransport => $serverTransport,
+ inputTransportFactory => $inputTransportFactory,
+ outputTransportFactory => $outputTransportFactory,
+ inputProtocolFactory => $inputProtocolFactory,
+ outputProtocolFactory => $outputProtocolFactory,
+ };
+}
+
+sub serve
+{
+ die 'abstract';
+}
+
+sub _clientBegin
+{
+ my $self = shift;
+ my $iprot = shift;
+ my $oprot = shift;
+
+ if (exists $self->{serverEventHandler} and
+ defined $self->{serverEventHandler})
+ {
+ $self->{serverEventHandler}->clientBegin($iprot, $oprot);
+ }
+}
+
+sub _handleException
+{
+ my $self = shift;
+ my $e = shift;
+
+ if ($e->isa('Thrift::TException') and exists $e->{message}) {
+ my $message = $e->{message};
+ my $code = $e->{code};
+ my $out = $code . ':' . $message;
+
+ $message =~ m/TTransportException/ and die $out;
+ if ($message =~ m/Socket/) {
+ # suppress Socket messages
+ }
+ else {
+ warn $out;
+ }
+ }
+ else {
+ warn $e;
+ }
+}
+
+#
+# SimpleServer from the Server base class that handles one connection at a time
+#
+package Thrift::SimpleServer;
+use parent -norequire, 'Thrift::Server';
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new
+{
+ my $classname = shift;
+
+ my $self = $classname->SUPER::new(@_);
+
+ return bless($self,$classname);
+}
+
+sub serve
+{
+ my $self = shift;
+ my $stop = 0;
+
+ $self->{serverTransport}->listen();
+ while (!$stop) {
+ my $client = $self->{serverTransport}->accept();
+ if (defined $client) {
+ my $itrans = $self->{inputTransportFactory}->getTransport($client);
+ my $otrans = $self->{outputTransportFactory}->getTransport($client);
+ my $iprot = $self->{inputProtocolFactory}->getProtocol($itrans);
+ my $oprot = $self->{outputProtocolFactory}->getProtocol($otrans);
+ eval {
+ $self->_clientBegin($iprot, $oprot);
+ while (1)
+ {
+ $self->{processor}->process($iprot, $oprot);
+ }
+ };
+ if($@) {
+ $self->_handleException($@);
+ }
+ $itrans->close();
+ $otrans->close();
+ } else {
+ $stop = 1;
+ }
+ }
+}
+
+
+#
+# ForkingServer that forks a new process for each request
+#
+package Thrift::ForkingServer;
+use parent -norequire, 'Thrift::Server';
+use POSIX ':sys_wait_h';
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new
+{
+ my $classname = shift;
+ my @args = @_;
+
+ my $self = $classname->SUPER::new(@args);
+ return bless($self,$classname);
+}
+
+
+sub serve
+{
+ my $self = shift;
+
+ # THRIFT-3848: without ignoring SIGCHLD, perl ForkingServer goes into a tight loop
+ $SIG{CHLD} = 'IGNORE';
+
+ $self->{serverTransport}->listen();
+ while (1)
+ {
+ my $client = $self->{serverTransport}->accept();
+ $self->_client($client);
+ }
+}
+
+sub _client
+{
+ my $self = shift;
+ my $client = shift;
+
+ eval {
+ my $itrans = $self->{inputTransportFactory}->getTransport($client);
+ my $otrans = $self->{outputTransportFactory}->getTransport($client);
+
+ my $iprot = $self->{inputProtocolFactory}->getProtocol($itrans);
+ my $oprot = $self->{outputProtocolFactory}->getProtocol($otrans);
+
+ $self->_clientBegin($iprot, $oprot);
+
+ my $pid = fork();
+
+ if ($pid)
+ {
+ $self->_parent($pid, $itrans, $otrans);
+ }
+ else {
+ $self->_child($itrans, $otrans, $iprot, $oprot);
+ }
+ };
+ if($@) {
+ $self->_handleException($@);
+ }
+}
+
+sub _parent
+{
+ my $self = shift;
+ my $pid = shift;
+ my $itrans = shift;
+ my $otrans = shift;
+
+ # Parent must close socket or the connection may not get closed promptly
+ $self->tryClose($itrans);
+ $self->tryClose($otrans);
+}
+
+sub _child
+{
+ my $self = shift;
+ my $itrans = shift;
+ my $otrans = shift;
+ my $iprot = shift;
+ my $oprot = shift;
+
+ my $ecode = 0;
+ eval {
+ # THRIFT-4065 ensure child process has normal signal handling in case thrift handler uses it
+ $SIG{CHLD} = 'DEFAULT';
+ while (1)
+ {
+ $self->{processor}->process($iprot, $oprot);
+ }
+ };
+ if($@) {
+ $ecode = 1;
+ $self->_handleException($@);
+ }
+
+ $self->tryClose($itrans);
+ $self->tryClose($otrans);
+
+ exit($ecode);
+}
+
+sub tryClose
+{
+ my $self = shift;
+ my $file = shift;
+
+ eval {
+ if (defined $file)
+ {
+ $file->close();
+ }
+ };
+ if($@) {
+ if ($@->isa('Thrift::TException') and exists $@->{message}) {
+ my $message = $@->{message};
+ my $code = $@->{code};
+ my $out = $code . ':' . $message;
+
+ warn $out;
+ }
+ else {
+ warn $@;
+ }
+ }
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/ServerSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/ServerSocket.pm
new file mode 100644
index 000000000..39726438b
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/ServerSocket.pm
@@ -0,0 +1,125 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use IO::Socket::INET;
+use IO::Select;
+use Thrift;
+use Thrift::Transport;
+use Thrift::Socket;
+
+package Thrift::ServerSocket;
+use base qw( Thrift::ServerTransport );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+#
+# Constructor.
+# Legacy construction takes one argument, port number.
+# New construction takes a hash:
+# @param[in] host host interface to listen on (undef = all interfaces)
+# @param[in] port port number to listen on (required)
+# @param[in] queue the listen queue size (default if not specified is 128)
+# @example my $serversock = Thrift::ServerSocket->new(host => undef, port => port)
+#
+sub new
+{
+ my $classname = shift;
+ my $args = shift;
+ my $self;
+
+ # Support both old-style "port number" construction and newer...
+ if (ref($args) eq 'HASH') {
+ $self = $args;
+ }
+ else {
+ $self = { port => $args };
+ }
+
+ if (not defined $self->{queue}) {
+ $self->{queue} = 128;
+ }
+
+ return bless($self, $classname);
+}
+
+sub listen
+{
+ my $self = shift;
+
+ my $sock = $self->__listen() || do {
+ my $error = ref($self) . ': Could not bind to ' . '*:' . $self->{port} . ' (' . $! . ')';
+
+ if ($self->{debug}) {
+ $self->{debugHandler}->($error);
+ }
+
+ die Thrift::TTransportException->new($error, Thrift::TTransportException::NOT_OPEN);
+ };
+
+ $self->{handle} = $sock;
+}
+
+sub accept
+{
+ my $self = shift;
+
+ if ( exists $self->{handle} and defined $self->{handle} ) {
+ my $client = $self->{handle}->accept();
+ my $result = $self->__client();
+ $result->{handle} = IO::Select->new($client);
+ return $result;
+ }
+
+ return undef;
+}
+
+sub close
+{
+ my $self = shift;
+
+ if ( exists $self->{handle} and defined $self->{handle} )
+ {
+ $self->{handle}->close();
+ }
+}
+
+###
+### Overridable methods
+###
+
+sub __client
+{
+ return Thrift::Socket->new();
+}
+
+sub __listen
+{
+ my $self = shift;
+ return IO::Socket::INET->new(LocalAddr => $self->{host},
+ LocalPort => $self->{port},
+ Proto => 'tcp',
+ Listen => $self->{queue},
+ ReuseAddr => 1);
+}
+
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Socket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Socket.pm
new file mode 100644
index 000000000..ba0db5eb4
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Socket.pm
@@ -0,0 +1,327 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Exception;
+use Thrift::Transport;
+
+use IO::Socket::INET;
+use IO::Select;
+
+package Thrift::Socket;
+use base qw( Thrift::Transport );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+#
+# Construction and usage
+#
+# my $opts = {}
+# my $socket = Thrift::Socket->new(\%opts);
+#
+# options:
+#
+# host => host to connect to
+# port => port to connect to
+# sendTimeout => timeout used for send and for connect
+# recvTimeout => timeout used for recv
+#
+
+sub new
+{
+ my $classname = shift;
+ my $opts = shift;
+
+ # default settings:
+ my $self = {
+ host => 'localhost',
+ port => 9090,
+ recvTimeout => 10000,
+ sendTimeout => 10000,
+
+ handle => undef
+ };
+
+ if (defined $opts and ref $opts eq ref {}) {
+
+ # argument is a hash of options so override the defaults
+ $self->{$_} = $opts->{$_} for keys %$opts;
+
+ } else {
+
+ # older style constructor takes 3 arguments, none of which are required
+ $self->{host} = $opts || 'localhost';
+ $self->{port} = shift || 9090;
+
+ }
+
+ 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;
+}
+
+
+#
+# Tests whether this is open
+#
+# @return bool true if the socket is open
+#
+sub isOpen
+{
+ my $self = shift;
+
+ if( defined $self->{handle} ){
+ return ($self->{handle}->handles())[0]->connected;
+ }
+
+ return 0;
+}
+
+#
+# Connects the socket.
+#
+sub open
+{
+ my $self = shift;
+
+ my $sock = $self->__open() || do {
+ my $error = ref($self).': Could not connect to '.$self->{host}.':'.$self->{port}.' ('.$!.')';
+ die Thrift::TTransportException->new($error, Thrift::TTransportException::NOT_OPEN);
+ };
+
+ $self->{handle} = IO::Select->new( $sock );
+}
+
+#
+# Closes the socket.
+#
+sub close
+{
+ my $self = shift;
+ if( defined $self->{handle} ) {
+ $self->__close();
+ }
+}
+
+#
+# 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;
+
+
+ return unless defined $self->{handle};
+
+ my $pre = "";
+ while (1) {
+
+ my $sock = $self->__wait();
+ my $buf = $self->__recv($sock, $len);
+
+ if (!defined $buf || $buf eq '') {
+
+ die Thrift::TTransportException->new(ref($self).': Could not read '.$len.' bytes from '.
+ $self->{host}.':'.$self->{port}, Thrift::TTransportException::END_OF_FILE);
+
+ }
+ elsif ((my $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;
+
+ return unless defined $self->{handle};
+
+ my $sock = $self->__wait();
+ my $buf = $self->__recv($sock, $len);
+
+ if (!defined $buf || $buf eq '') {
+
+ die Thrift::TTransportException->new(ref($self).': Could not read '.$len.' bytes from '.
+ $self->{host}.':'.$self->{port}, Thrift::TTransportException::END_OF_FILE);
+
+ }
+
+ return $buf;
+}
+
+
+#
+# Write to the socket.
+#
+# @param string $buf The data to write
+#
+sub write
+{
+ my $self = shift;
+ my $buf = shift;
+
+ return unless defined $self->{handle};
+
+ while (length($buf) > 0) {
+ #check for timeout
+ my @sockets = $self->{handle}->can_write( $self->{sendTimeout} / 1000 );
+
+ if(@sockets == 0){
+ die Thrift::TTransportException->new(ref($self).': timed out writing to bytes from '.
+ $self->{host}.':'.$self->{port}, Thrift::TTransportException::TIMED_OUT);
+ }
+
+ my $sent = $self->__send($sockets[0], $buf);
+
+ if (!defined $sent || $sent == 0 ) {
+
+ die Thrift::TTransportException->new(ref($self).': Could not write '.length($buf).' bytes '.
+ $self->{host}.':'.$self->{host}, Thrift::TTransportException::END_OF_FILE);
+
+ }
+
+ $buf = substr($buf, $sent);
+ }
+}
+
+#
+# Flush output to the socket.
+#
+sub flush
+{
+ my $self = shift;
+
+ return unless defined $self->{handle};
+
+ my $ret = ($self->{handle}->handles())[0]->flush;
+}
+
+###
+### Overridable methods
+###
+
+#
+# Open a connection to a server.
+#
+sub __open
+{
+ my $self = shift;
+ return IO::Socket::INET->new(PeerAddr => $self->{host},
+ PeerPort => $self->{port},
+ Proto => 'tcp',
+ Timeout => $self->{sendTimeout} / 1000);
+}
+
+#
+# Close the connection
+#
+sub __close
+{
+ my $self = shift;
+ CORE::close(($self->{handle}->handles())[0]);
+}
+
+#
+# Read data
+#
+# @param[in] $sock the socket
+# @param[in] $len the length to read
+# @returns the data buffer that was read
+#
+sub __recv
+{
+ my $self = shift;
+ my $sock = shift;
+ my $len = shift;
+ my $buf = undef;
+ $sock->recv($buf, $len);
+ return $buf;
+}
+
+#
+# Send data
+#
+# @param[in] $sock the socket
+# @param[in] $buf the data buffer
+# @returns the number of bytes written
+#
+sub __send
+{
+ my $self = shift;
+ my $sock = shift;
+ my $buf = shift;
+ return $sock->send($buf);
+}
+
+#
+# Wait for data to be readable
+#
+# @returns a socket that can be read
+#
+sub __wait
+{
+ my $self = shift;
+ my @sockets = $self->{handle}->can_read( $self->{recvTimeout} / 1000 );
+
+ if (@sockets == 0) {
+ die Thrift::TTransportException->new(ref($self).': timed out reading from '.
+ $self->{host}.':'.$self->{port}, Thrift::TTransportException::TIMED_OUT);
+ }
+
+ return $sockets[0];
+}
+
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Transport.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Transport.pm
new file mode 100644
index 000000000..41b7e150f
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Transport.pm
@@ -0,0 +1,180 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Exception;
+
+#
+# Transport exceptions
+#
+package Thrift::TTransportException;
+use base('Thrift::TException');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+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;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+#
+# 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
+{
+ 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
+{
+ die 'abstract';
+}
+
+#
+# Flushes any pending data out of a buffer
+#
+# @throws TTransportException if a writing error occurs
+#
+sub flush {}
+
+
+#
+# TransportFactory creates transport objects from transports
+#
+package Thrift::TransportFactory;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub new {
+ my $classname = shift;
+ my $self = {};
+
+ return bless($self,$classname);
+}
+
+#
+# Build a transport from the base transport
+#
+# @return Thrift::Transport transport
+#
+sub getTransport
+{
+ my $self = shift;
+ my $trans = shift;
+
+ return $trans;
+}
+
+
+#
+# ServerTransport base class module
+#
+package Thrift::ServerTransport;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+sub listen
+{
+ die 'abstract';
+}
+
+sub accept
+{
+ die 'abstract';
+}
+
+sub close
+{
+ die 'abstract';
+}
+
+
+1;
+
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/Type.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Type.pm
new file mode 100644
index 000000000..ad8da3b6c
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/Type.pm
@@ -0,0 +1,50 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+
+#
+# Data types that can be sent via Thrift
+#
+package Thrift::TType;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+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;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixServerSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixServerSocket.pm
new file mode 100644
index 000000000..875e8049a
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixServerSocket.pm
@@ -0,0 +1,84 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::ServerSocket;
+use Thrift::UnixSocket;
+
+use IO::Socket::UNIX;
+
+package Thrift::UnixServerSocket;
+use base qw( Thrift::ServerSocket );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+#
+# Constructor.
+# If a single argument is given that is not a hash, that is the unix domain socket path.
+# If a single argument is given that is a hash:
+# @param[in] path unix domain socket file name
+# @param[in] queue the listen queue size (default is not specified is supplied by ServerSocket)
+# @example my $serversock = Thrift::UnixServerSocket->new($path);
+# @example my $serversock = Thrift::UnixServerSocket->new(path => "somepath", queue => 64);
+#
+sub new
+{
+ my $classname = shift;
+ my $args = shift;
+ my $self;
+
+ if (ref($args) eq 'HASH') {
+ $self = $classname->SUPER::new($args);
+ } else {
+ $self = $classname->SUPER::new();
+ $self->{path} = $args;
+ }
+
+ return bless($self, $classname);
+}
+
+sub __client
+{
+ return Thrift::UnixSocket->new();
+}
+
+sub __listen
+{
+ my $self = shift;
+
+ my $sock = IO::Socket::UNIX->new(
+ Type => IO::Socket::SOCK_STREAM,
+ Local => $self->{path},
+ Listen => $self->{queue})
+ || do {
+ my $error = 'UnixServerSocket: Could not bind to ' .
+ $self->{path} . ' (' . $! . ')';
+ if ($self->{debug}) {
+ $self->{debugHandler}->($error);
+ }
+ die Thrift::TTransportException->new($error, Thrift::TTransportException::NOT_OPEN);
+ };
+
+ return $sock;
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixSocket.pm b/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixSocket.pm
new file mode 100644
index 000000000..ba386d1ce
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/lib/Thrift/UnixSocket.pm
@@ -0,0 +1,67 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Socket;
+
+use IO::Socket::UNIX;
+
+package Thrift::UnixSocket;
+use base qw( Thrift::Socket );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
+
+#
+# Constructor.
+# Takes a unix domain socket filename.
+# See Thrift::Socket for base class parameters.
+# @param[in] path path to unix socket file
+# @example my $sock = Thrift::UnixSocket->new($path);
+#
+sub new
+{
+ my $classname = shift;
+ my $self = $classname->SUPER::new();
+ $self->{path} = shift;
+ return bless($self, $classname);
+}
+
+sub __open
+{
+ my $self = shift;
+
+ my $sock = IO::Socket::UNIX->new(
+ Type => IO::Socket::SOCK_STREAM,
+ Peer => $self->{path})
+ || do {
+ my $error = 'UnixSocket: Could not connect to ' .
+ $self->{path} . ' (' . $! . ')';
+ if ($self->{debug}) {
+ $self->{debugHandler}->($error);
+ }
+ die Thrift::TTransportException->new($error, Thrift::TTransportException::NOT_OPEN);
+ };
+
+ return $sock;
+}
+
+1;
diff --git a/src/jaegertracing/thrift/lib/perl/t/Makefile.am b/src/jaegertracing/thrift/lib/perl/t/Makefile.am
new file mode 100644
index 000000000..de0397186
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/t/Makefile.am
@@ -0,0 +1,20 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+EXTRA_DIST = memory_buffer.t processor.t multiplex.t
diff --git a/src/jaegertracing/thrift/lib/perl/t/memory_buffer.t b/src/jaegertracing/thrift/lib/perl/t/memory_buffer.t
new file mode 100644
index 000000000..8fa9fd72e
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/t/memory_buffer.t
@@ -0,0 +1,53 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use Test::More tests => 6;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+use Thrift::BinaryProtocol;
+use Thrift::MemoryBuffer;
+
+use ThriftTest::Types;
+
+
+my $transport = Thrift::MemoryBuffer->new();
+my $protocol = Thrift::BinaryProtocol->new($transport);
+
+my $a = ThriftTest::Xtruct->new();
+$a->i32_thing(10);
+$a->i64_thing(30);
+$a->string_thing('Hello, world!');
+$a->write($protocol);
+
+my $b = ThriftTest::Xtruct->new();
+$b->read($protocol);
+is($b->i32_thing, $a->i32_thing);
+is($b->i64_thing, $a->i64_thing);
+is($b->string_thing, $a->string_thing);
+
+$b->write($protocol);
+my $c = ThriftTest::Xtruct->new();
+$c->read($protocol);
+is($c->i32_thing, $a->i32_thing);
+is($c->i64_thing, $a->i64_thing);
+is($c->string_thing, $a->string_thing);
diff --git a/src/jaegertracing/thrift/lib/perl/t/multiplex.t b/src/jaegertracing/thrift/lib/perl/t/multiplex.t
new file mode 100644
index 000000000..90a9b4d02
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/t/multiplex.t
@@ -0,0 +1,201 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use Test::More tests => 6;
+
+use strict;
+use warnings;
+
+use Thrift::BinaryProtocol;
+use Thrift::FramedTransport;
+use Thrift::MemoryBuffer;
+use Thrift::MessageType;
+use Thrift::MultiplexedProcessor;
+use Thrift::Server;
+use Thrift::Socket;
+
+use BenchmarkService;
+use Aggr;
+
+use constant NAME_BENCHMARKSERVICE => 'BenchmarkService';
+use constant NAME_AGGR => 'Aggr';
+
+my $buffer = Thrift::MemoryBuffer->new(1024);
+my $aggr_protocol = Thrift::MultiplexedProtocol->new(Thrift::BinaryProtocol->new($buffer), NAME_AGGR);
+my $aggr_client = AggrClient->new($aggr_protocol);
+my $benchmark_protocol = Thrift::MultiplexedProtocol->new(Thrift::BinaryProtocol->new($buffer), NAME_BENCHMARKSERVICE);
+my $benchmark_client = BenchmarkServiceClient->new($benchmark_protocol);
+
+$buffer->open();
+
+for(my $i = 1; $i <= 5; $i++) {
+ $aggr_client->send_addValue($i);
+ $aggr_client->{seqid}++;
+}
+
+$aggr_client->send_getValues();
+
+for(my $i = 1; $i <= 5; $i++) {
+ $benchmark_client->send_fibonacci($i);
+ $benchmark_client->{seqid}++;
+}
+$benchmark_client->{seqid}--;
+
+my $client_command_binary = $buffer->getBuffer;
+$buffer->resetBuffer;
+
+
+# Process by server
+my $server_output_binary;
+{
+ my $benchmark_handler = My::BenchmarkService->new();
+ my $benchmark_processor = BenchmarkServiceProcessor->new($benchmark_handler);
+ my $aggr_handler = My::Aggr->new();
+ my $aggr_processor = AggrProcessor->new($aggr_handler);
+
+ my $protocol_factory = Thrift::BinaryProtocolFactory->new();
+
+ my $input_buffer = Thrift::MemoryBuffer->new();
+ $input_buffer->write($client_command_binary);
+
+ my $input_protocol = $protocol_factory->getProtocol($input_buffer);
+
+ my $output_buffer = Thrift::MemoryBuffer->new();
+ my $output_protocol = $protocol_factory->getProtocol($output_buffer);
+
+ my $processor = Thrift::MultiplexedProcessor->new();
+
+ $processor->registerProcessor(NAME_BENCHMARKSERVICE, $benchmark_processor);
+ $processor->registerProcessor(NAME_AGGR, $aggr_processor);
+ my $result;
+ for(my $i = 1; $i <= 11; $i++) {
+ $result = $processor->process($input_protocol, $output_protocol);
+ print "process resulted in $result\n";
+ }
+
+ $server_output_binary = $output_buffer->getBuffer();
+}
+
+$buffer->write($server_output_binary);
+
+
+
+for(my $i = 1; $i <= 5; $i++) {
+ my ($function_name, $message_type, $sequence_id);
+
+ $aggr_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
+
+ if ($message_type == Thrift::TMessageType::EXCEPTION) {
+ die;
+ }
+
+ my $aggr_result = Aggr_addValue_result->new();
+ $aggr_result->read($aggr_protocol);
+ $aggr_protocol->readMessageEnd();
+}
+
+my ($function_name, $message_type, $sequence_id);
+
+$aggr_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
+
+if ($message_type == Thrift::TMessageType::EXCEPTION) {
+ die;
+}
+
+my $aggr_result = Aggr_getValues_result->new();
+$aggr_result->read($aggr_protocol);
+$aggr_protocol->readMessageEnd();
+
+is_deeply($aggr_result->success(), [1,2,3,4,5]);
+
+
+foreach my $val((1,2,3,5,8)) {
+ my ($function_name, $message_type, $sequence_id);
+
+ $benchmark_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
+
+ if ($message_type == Thrift::TMessageType::EXCEPTION) {
+ die;
+ }
+ my $benchmark_result = BenchmarkService_fibonacci_result->new();
+ $benchmark_result->read($benchmark_protocol);
+ $benchmark_protocol->readMessageEnd();
+
+ is($benchmark_result->success(), $val);
+}
+
+
+package My::Aggr;
+use base qw(AggrIf);
+
+use strict;
+use warnings;
+
+sub new {
+ my $classname = shift;
+ my $self = {};
+
+ $self->{values} = ();
+
+ return bless($self,$classname);
+}
+
+sub addValue{
+ my $self = shift;
+ my $value = shift;
+
+ push (@{$self->{values}}, $value);
+}
+
+sub getValues{
+ my $self = shift;
+
+ return $self->{values};
+}
+
+
+
+package My::BenchmarkService;
+use base qw(BenchmarkServiceIf);
+
+use strict;
+use warnings;
+
+sub new {
+ my $class = shift;
+ return bless {}, $class;
+}
+
+sub fibonacci {
+ my ($self, $n) = @_;
+
+ my $prev = 0;
+ my $next;
+ my $result = 1;
+
+ while ($n > 0) {
+ $next = $result + $prev;
+ $prev = $result;
+ $result = $next;
+ --$n;
+ }
+
+ return $result;
+}
+
diff --git a/src/jaegertracing/thrift/lib/perl/t/processor.t b/src/jaegertracing/thrift/lib/perl/t/processor.t
new file mode 100644
index 000000000..f8330354f
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/t/processor.t
@@ -0,0 +1,104 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use Test::More tests => 2;
+
+use strict;
+use warnings;
+
+use Thrift::BinaryProtocol;
+use Thrift::MemoryBuffer;
+use Thrift::MessageType;
+
+use ThriftTest::ThriftTest;
+use ThriftTest::Types;
+
+use Data::Dumper;
+
+my $buffer = Thrift::MemoryBuffer->new(1024);
+my $protocol = Thrift::BinaryProtocol->new($buffer);
+my $client = ThriftTest::ThriftTestClient->new($protocol);
+
+$buffer->open();
+$client->send_testString("foo");
+$client->{seqid}++;
+$client->send_testString("bar");
+
+my $client_command_binary = $buffer->getBuffer;
+$buffer->resetBuffer;
+
+# Process by server
+
+my $server_output_binary;
+{
+ my $protocol_factory = Thrift::BinaryProtocolFactory->new();
+
+ my $input_buffer = Thrift::MemoryBuffer->new();
+ $input_buffer->write($client_command_binary);
+ my $input_protocol = $protocol_factory->getProtocol($input_buffer);
+
+ my $output_buffer = Thrift::MemoryBuffer->new();
+ my $output_protocol = $protocol_factory->getProtocol($output_buffer);
+
+ my $processor = ThriftTest::ThriftTestProcessor->new( My::ThriftTest->new() );
+ my $result = $processor->process($input_protocol, $output_protocol);
+ print "process resulted in $result\n";
+ $result = $processor->process($input_protocol, $output_protocol);
+ print "process resulted in $result\n";
+ $server_output_binary = $output_buffer->getBuffer();
+}
+
+$buffer->write($server_output_binary);
+
+foreach my $val (("got foo","got bar")){
+ my ($function_name, $message_type, $sequence_id);
+
+ $protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
+ print " $function_name, $message_type, $sequence_id\n";
+
+ if ($message_type == Thrift::TMessageType::EXCEPTION) {
+ die;
+ }
+
+ my $result = ThriftTest::ThriftTest_testString_result->new();
+ $result->read($protocol);
+ $protocol->readMessageEnd();
+
+ is($result->success(),$val);
+}
+
+
+package My::ThriftTest;
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+sub new {
+ my $class = shift;
+ return bless {}, $class;
+}
+
+sub testString {
+ my ($self, $string) = @_;
+
+ print __PACKAGE__ . "->testString()\n";
+
+ return "got ".$string;
+}
diff --git a/src/jaegertracing/thrift/lib/perl/test.pl b/src/jaegertracing/thrift/lib/perl/test.pl
new file mode 100644
index 000000000..7e068402f
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/test.pl
@@ -0,0 +1,25 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use strict;
+use warnings;
+
+use Test::Harness;
+
+runtests(@ARGV);
diff --git a/src/jaegertracing/thrift/lib/perl/tools/FixupDist.pl b/src/jaegertracing/thrift/lib/perl/tools/FixupDist.pl
new file mode 100644
index 000000000..24a2b200a
--- /dev/null
+++ b/src/jaegertracing/thrift/lib/perl/tools/FixupDist.pl
@@ -0,0 +1,35 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+#
+# This will fix up the distribution so that CPAN properly
+# indexes Thrift.
+#
+
+use 5.10.0;
+use strict;
+use warnings;
+use utf8;
+
+use Data::Dumper;
+use CPAN::Meta;
+
+my $meta = CPAN::Meta->load_file('META.json');
+$meta->{'provides'} = { 'Thrift' => { 'file' => 'lib/Thrift.pm', 'version' => $meta->version() } };
+$meta->save('META.json');