THRIFT-3033 Perl: Support for Multiplexing Services on any Transport, Protocol and Server
Client: Perl
Patch: Harry S. <hs2323@gmail.com> & Jens Geyer
This closes #405
This closes #418
diff --git a/lib/perl/Makefile.am b/lib/perl/Makefile.am
index 067ed69..60eb1ef 100644
--- a/lib/perl/Makefile.am
+++ b/lib/perl/Makefile.am
@@ -28,6 +28,8 @@
check-local:
$(PERL) -Iblib/lib -I@abs_srcdir@ -I@builddir@/test/gen-perl \
+ -I@builddir@/test/gen-perl/BenchmarkTest \
+ -I@builddir@/test/gen-perl/Aggr \
@abs_srcdir@/test.pl @abs_srcdir@/test/*.t
install-exec-local: Makefile-perl.mk
@@ -49,7 +51,11 @@
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/Socket.pm \
lib/Thrift/Transport.pm \
diff --git a/lib/perl/lib/Thrift/MessageType.pm b/lib/perl/lib/Thrift/MessageType.pm
new file mode 100644
index 0000000..c8902cc
--- /dev/null
+++ b/lib/perl/lib/Thrift/MessageType.pm
@@ -0,0 +1,32 @@
+#
+# 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;
+
+package Thrift::MessageType;
+
+use strict;
+
+use constant CALL => 1;
+use constant REPLY => 2;
+use constant EXCEPTION => 3;
+use constant ONEWAY => 4;
+
+1;
\ No newline at end of file
diff --git a/lib/perl/lib/Thrift/MultiplexedProcessor.pm b/lib/perl/lib/Thrift/MultiplexedProcessor.pm
new file mode 100644
index 0000000..421bf73
--- /dev/null
+++ b/lib/perl/lib/Thrift/MultiplexedProcessor.pm
@@ -0,0 +1,121 @@
+#
+# 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 Thrift;
+use Thrift::Protocol;
+use Thrift::MultiplexedProtocol;
+use Thrift::ProtocolDecorator;
+use Thrift::MessageType;
+
+package Thrift::StoredMessageProtocol;
+use base qw(Thrift::ProtocolDecorator);
+
+use strict;
+
+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 strict;
+
+sub new {
+ my $classname = shift;
+ my $self = {};
+
+ $self->{serviceProcessorMap} = {};
+
+ return bless($self,$classname);
+}
+
+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::MessageType::CALL && $mtype ne Thrift::MessageType::ONEWAY) {
+ die new Thrift::TException("This should not have happened!?");
+ }
+
+ # Extract the service name and the new Message name.
+ if (index($fname, Thrift::MultiplexedProtocol::SEPARATOR) == -1) {
+ die new Thrift::TException("Service name not found in message name: {$fname}. Did you " .
+ "forget to use a MultiplexProtocol in your client?");
+ }
+
+ (my $serviceName, my $messageName) = split(':', $fname, 2);
+
+ if (!exists($self->{serviceProcessorMap}->{$serviceName})) {
+ die new Thrift::TException("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(
+ new Thrift::StoredMessageProtocol($input, $messageName, $mtype, $rseqid), $output
+ );
+}
+
+1;
\ No newline at end of file
diff --git a/lib/perl/lib/Thrift/MultiplexedProtocol.pm b/lib/perl/lib/Thrift/MultiplexedProtocol.pm
new file mode 100644
index 0000000..83a4eaf
--- /dev/null
+++ b/lib/perl/lib/Thrift/MultiplexedProtocol.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 strict;
+use warnings;
+
+use Thrift::Protocol;
+use Thrift::ProtocolDecorator;
+use Thrift::MessageType;
+
+package Thrift::MultiplexedProtocol;
+use base qw(Thrift::ProtocolDecorator);
+
+use strict;
+
+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::MessageType::CALL || $type == Thrift::MessageType::ONEWAY) {
+ my $nameWithService = $self->{serviceName}.SEPARATOR.$name;
+ $self->SUPER::writeMessageBegin($nameWithService, $type, $seqid);
+ }
+ else {
+ $self->SUPER::writeMessageBegin($name, $type, $seqid);
+ }
+}
+
+1;
\ No newline at end of file
diff --git a/lib/perl/lib/Thrift/ProtocolDecorator.pm b/lib/perl/lib/Thrift/ProtocolDecorator.pm
new file mode 100644
index 0000000..8120200
--- /dev/null
+++ b/lib/perl/lib/Thrift/ProtocolDecorator.pm
@@ -0,0 +1,360 @@
+#
+# 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 Thrift::Protocol;
+
+package Thrift::ProtocolDecorator;
+use base qw(Thrift::Protocol);
+
+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/lib/perl/test/Makefile.am b/lib/perl/test/Makefile.am
index 795aaed..2c9ce2a 100644
--- a/lib/perl/test/Makefile.am
+++ b/lib/perl/test/Makefile.am
@@ -19,13 +19,24 @@
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
-check-local: gen-perl/ThriftTest/Types.pm
+check-local: \
+ gen-perl/ThriftTest/Types.pm \
+ gen-perl/BenchmarkTest/BenchmarkService.pm \
+ gen-perl/Aggr/Aggr.pm
gen-perl/ThriftTest/Types.pm: $(THRIFT_IF)
$(THRIFT) --gen perl $(THRIFT_IF)
clean-local:
rm -rf gen-perl
+
+gen-perl/BenchmarkTest/BenchmarkService.pm: $(NAME_BENCHMARKSERVICE)
+ $(THRIFT) --gen perl $(NAME_BENCHMARKSERVICE)
+
+gen-perl/Aggr/Aggr.pm: $(NAME_AGGR)
+ $(THRIFT) --gen perl $(NAME_AGGR)
-EXTRA_DIST = memory_buffer.t processor.t
+EXTRA_DIST = memory_buffer.t processor.t multiplex.t
diff --git a/lib/perl/test/multiplex.t b/lib/perl/test/multiplex.t
new file mode 100644
index 0000000..76f2706
--- /dev/null
+++ b/lib/perl/test/multiplex.t
@@ -0,0 +1,203 @@
+#
+# 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;
+use Thrift::Socket;
+use Thrift::Server;
+use Thrift::MultiplexedProcessor;
+use Thrift::BinaryProtocol;
+use Thrift::MemoryBuffer;
+use Thrift::FramedTransport;
+use Thrift::MemoryBuffer;
+
+
+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 == 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 == 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 == 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;
+}
+