6 files changed, 438 insertions, 0 deletions
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');