THRIFT-4069: perl library cleanup - namespaces, versioning, exception fixes
Client: perl
This closes #1220
diff --git a/compiler/cpp/src/thrift/generate/t_perl_generator.cc b/compiler/cpp/src/thrift/generate/t_perl_generator.cc
index 5e2a9e9..12b8bfc 100644
--- a/compiler/cpp/src/thrift/generate/t_perl_generator.cc
+++ b/compiler/cpp/src/thrift/generate/t_perl_generator.cc
@@ -255,10 +255,12 @@
string t_perl_generator::perl_includes() {
string inc;
- inc = "require 5.6.0;\n";
+ inc = "use 5.10.0;\n";
inc += "use strict;\n";
inc += "use warnings;\n";
- inc += "use Thrift;\n\n";
+ inc += "use Thrift::Exception;\n";
+ inc += "use Thrift::MessageType;\n";
+ inc += "use Thrift::Type;\n\n";
return inc;
}
@@ -546,7 +548,7 @@
indent(out) << "$xfer += $input->readFieldBegin(\\$fname, \\$ftype, \\$fid);" << endl;
// Check for field STOP marker and break
- indent(out) << "if ($ftype == TType::STOP) {" << endl;
+ indent(out) << "if ($ftype == Thrift::TType::STOP) {" << endl;
indent_up();
indent(out) << "last;" << endl;
indent_down();
@@ -749,11 +751,11 @@
<< "if (!$self->can($methodname)) {" << endl;
indent_up();
- f_service_ << indent() << "$input->skip(TType::STRUCT);" << endl << indent()
+ f_service_ << indent() << "$input->skip(Thrift::TType::STRUCT);" << endl << indent()
<< "$input->readMessageEnd();" << endl << indent()
- << "my $x = new TApplicationException('Function '.$fname.' not implemented.', "
- "TApplicationException::UNKNOWN_METHOD);" << endl << indent()
- << "$output->writeMessageBegin($fname, TMessageType::EXCEPTION, $rseqid);" << endl
+ << "my $x = new Thrift::TApplicationException('Function '.$fname.' not implemented.', "
+ "Thrift::TApplicationException::UNKNOWN_METHOD);" << endl << indent()
+ << "$output->writeMessageBegin($fname, Thrift::TMessageType::EXCEPTION, $rseqid);" << endl
<< indent() << "$x->write($output);" << endl << indent()
<< "$output->writeMessageEnd();" << endl << indent()
<< "$output->getTransport()->flush();" << endl << indent() << "return;" << endl;
@@ -851,8 +853,8 @@
f_service_ << indent() << "if ($@) {" << endl;
indent_up();
f_service_ << indent() << "$@ =~ s/^\\s+|\\s+$//g;" << endl
- << indent() << "my $err = new TApplicationException(\"Unexpected Exception: \" . $@, TApplicationException::INTERNAL_ERROR);" << endl
- << indent() << "$output->writeMessageBegin('" << tfunction->get_name() << "', TMessageType::EXCEPTION, $seqid);" << endl
+ << indent() << "my $err = new Thrift::TApplicationException(\"Unexpected Exception: \" . $@, Thrift::TApplicationException::INTERNAL_ERROR);" << endl
+ << indent() << "$output->writeMessageBegin('" << tfunction->get_name() << "', Thrift::TMessageType::EXCEPTION, $seqid);" << endl
<< indent() << "$err->write($output);" << endl
<< indent() << "$output->writeMessageEnd();" << endl
<< indent() << "$output->getTransport()->flush();" << endl
@@ -871,7 +873,7 @@
}
// Serialize the reply
- f_service_ << indent() << "$output->writeMessageBegin('" << tfunction->get_name() << "', TMessageType::REPLY, $seqid);" << endl
+ f_service_ << indent() << "$output->writeMessageBegin('" << tfunction->get_name() << "', Thrift::TMessageType::REPLY, $seqid);" << endl
<< indent() << "$result->write($output);" << endl
<< indent() << "$output->writeMessageEnd();" << endl
<< indent() << "$output->getTransport()->flush();" << endl;
@@ -1096,7 +1098,7 @@
// Serialize the request header
f_service_ << indent() << "$self->{output}->writeMessageBegin('" << (*f_iter)->get_name()
- << "', " << ((*f_iter)->is_oneway() ? "TMessageType::ONEWAY" : "TMessageType::CALL")
+ << "', " << ((*f_iter)->is_oneway() ? "Thrift::TMessageType::ONEWAY" : "Thrift::TMessageType::CALL")
<< ", $self->{seqid});" << endl;
f_service_ << indent() << "my $args = new " << argsname << "();" << endl;
@@ -1132,8 +1134,8 @@
<< indent() << "my $mtype = 0;" << endl << endl;
f_service_ << indent() << "$self->{input}->readMessageBegin(\\$fname, \\$mtype, \\$rseqid);"
- << endl << indent() << "if ($mtype == TMessageType::EXCEPTION) {" << endl
- << indent() << " my $x = new TApplicationException();" << endl << indent()
+ << endl << indent() << "if ($mtype == Thrift::TMessageType::EXCEPTION) {" << endl
+ << indent() << " my $x = new Thrift::TApplicationException();" << endl << indent()
<< " $x->read($self->{input});" << endl << indent()
<< " $self->{input}->readMessageEnd();" << endl << indent() << " die $x;" << endl
<< indent() << "}" << endl;
@@ -1644,30 +1646,30 @@
case t_base_type::TYPE_VOID:
throw "NO T_VOID CONSTRUCT";
case t_base_type::TYPE_STRING:
- return "TType::STRING";
+ return "Thrift::TType::STRING";
case t_base_type::TYPE_BOOL:
- return "TType::BOOL";
+ return "Thrift::TType::BOOL";
case t_base_type::TYPE_I8:
- return "TType::BYTE";
+ return "Thrift::TType::BYTE";
case t_base_type::TYPE_I16:
- return "TType::I16";
+ return "Thrift::TType::I16";
case t_base_type::TYPE_I32:
- return "TType::I32";
+ return "Thrift::TType::I32";
case t_base_type::TYPE_I64:
- return "TType::I64";
+ return "Thrift::TType::I64";
case t_base_type::TYPE_DOUBLE:
- return "TType::DOUBLE";
+ return "Thrift::TType::DOUBLE";
}
} else if (type->is_enum()) {
- return "TType::I32";
+ return "Thrift::TType::I32";
} else if (type->is_struct() || type->is_xception()) {
- return "TType::STRUCT";
+ return "Thrift::TType::STRUCT";
} else if (type->is_map()) {
- return "TType::MAP";
+ return "Thrift::TType::MAP";
} else if (type->is_set()) {
- return "TType::SET";
+ return "Thrift::TType::SET";
} else if (type->is_list()) {
- return "TType::LIST";
+ return "Thrift::TType::LIST";
}
throw "INVALID TYPE IN type_to_enum: " + type->get_name();
diff --git a/lib/perl/Makefile.PL b/lib/perl/Makefile.PL
index 92b05ba..ee7a436 100644
--- a/lib/perl/Makefile.PL
+++ b/lib/perl/Makefile.PL
@@ -18,15 +18,14 @@
#
use ExtUtils::MakeMaker;
-WriteMakefile( NAME => 'Thrift',
- VERSION_FROM => 'lib/Thrift.pm',
- MIN_PERL_VERSION => '5.006',
+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,
- 'IO::Socket::INET' => 0
+ 'Bit::Vector' => 0,
+ 'Class::Accessor' => 0
},
- ($] >= 5.006 ?
- ( AUTHOR => 'Apache Thrift <dev@thrift.apache.org>') : ()),
- );
-
+ VERSION_FROM => 'lib/Thrift.pm' );
diff --git a/lib/perl/README.md b/lib/perl/README.md
index 0540948..bd1e5b2 100644
--- a/lib/perl/README.md
+++ b/lib/perl/README.md
@@ -1,7 +1,13 @@
Thrift Perl Software Library
-License
-=======
+# 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
@@ -20,23 +26,13 @@
specific language governing permissions and limitations
under the License.
-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.
-
-For More Information
-====================
+# For More Information
See the [Apache Thrift Web Site](http://thrift.apache.org/) for more information.
-Using Thrift with Perl
-======================
+# Using Thrift with Perl
-Thrift requires Perl >= 5.6.0
+Thrift requires Perl >= 5.10.0
Unexpected exceptions in a service handler are converted to
TApplicationException with type INTERNAL ERROR and the string
@@ -55,12 +51,74 @@
as the ForkingServer resets the forked child process to use
default signal handling.
-Dependencies
-============
+# Dependencies
-Bit::Vector - comes with modern perl installations.
-Class::Accessor
-IO::Socket::INET - comes with modern perl installations.
-IO::Socket::SSL - required if using SSL/TLS.
-NET::SSLeay
-Crypt::SSLeay - for make cross
+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/lib/perl/lib/Thrift.pm b/lib/perl/lib/Thrift.pm
index bd7b65a..592d1dd 100644
--- a/lib/perl/lib/Thrift.pm
+++ b/lib/perl/lib/Thrift.pm
@@ -17,177 +17,20 @@
# under the License.
#
-package Thrift;
-
-our $VERSION = '1.0.0-dev';
-
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
#
-# Data types that can be sent via Thrift
+# Versioning
#
-package TType;
-use constant STOP => 0;
-use constant VOID => 1;
-use constant BOOL => 2;
-use constant BYTE => 3;
-use constant I08 => 3;
-use constant DOUBLE => 4;
-use constant I16 => 6;
-use constant I32 => 8;
-use constant I64 => 10;
-use constant STRING => 11;
-use constant UTF7 => 11;
-use constant STRUCT => 12;
-use constant MAP => 13;
-use constant SET => 14;
-use constant LIST => 15;
-use constant UTF8 => 16;
-use constant UTF16 => 17;
-1;
-
+# 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.
#
-# Message types for RPC
-#
-package TMessageType;
-use constant CALL => 1;
-use constant REPLY => 2;
-use constant EXCEPTION => 3;
-use constant ONEWAY => 4;
-1;
-package Thrift::TException;
-
-use overload '""' => sub {
- return
- ref( $_[0] )
- . " error: "
- . ( $_[0]->{message} || 'empty message' )
- . " (code "
- . ( defined $_[0]->{code} ? $_[0]->{code} : 'undefined' ) . ")";
- };
-
-sub new {
- my $classname = shift;
- my $self = {message => shift, code => shift || 0};
-
- return bless($self,$classname);
-}
-1;
-
-package TApplicationException;
-use base('Thrift::TException');
-
-use constant UNKNOWN => 0;
-use constant UNKNOWN_METHOD => 1;
-use constant INVALID_MESSAGE_TYPE => 2;
-use constant WRONG_METHOD_NAME => 3;
-use constant BAD_SEQUENCE_ID => 4;
-use constant MISSING_RESULT => 5;
-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 == TType::STOP) {
- last; next;
- }
-
- SWITCH: for($fid)
- {
- /1/ && do{
-
- if ($ftype == TType::STRING) {
- $xfer += $input->readString(\$self->{message});
- } else {
- $xfer += $input->skip($ftype);
- }
-
- last;
- };
-
- /2/ && do{
- if ($ftype == TType::I32) {
- $xfer += $input->readI32(\$self->{code});
- } else {
- $xfer += $input->skip($ftype);
- }
- last;
- };
-
- $xfer += $input->skip($ftype);
- }
-
- $xfer += $input->readFieldEnd();
- }
- $xfer += $input->readStructEnd();
-
- return $xfer;
-}
-
-sub write {
- my $self = shift;
- my $output = shift;
-
- my $xfer = 0;
-
- $xfer += $output->writeStructBegin('TApplicationException');
-
- if ($self->getMessage()) {
- $xfer += $output->writeFieldBegin('message', TType::STRING, 1);
- $xfer += $output->writeString($self->getMessage());
- $xfer += $output->writeFieldEnd();
- }
-
- if ($self->getCode()) {
- $xfer += $output->writeFieldBegin('type', TType::I32, 2);
- $xfer += $output->writeI32($self->getCode());
- $xfer += $output->writeFieldEnd();
- }
-
- $xfer += $output->writeFieldStop();
- $xfer += $output->writeStructEnd();
-
- return $xfer;
-}
-
-sub getMessage
-{
- my $self = shift;
-
- return $self->{message};
-}
-
-sub getCode
-{
- my $self = shift;
-
- return $self->{code};
-}
+package Thrift;
+use version 0.77; our $VERSION = version->declare("v1.0_0");
1;
diff --git a/lib/perl/lib/Thrift/BinaryProtocol.pm b/lib/perl/lib/Thrift/BinaryProtocol.pm
index c638ead..61937e4 100644
--- a/lib/perl/lib/Thrift/BinaryProtocol.pm
+++ b/lib/perl/lib/Thrift/BinaryProtocol.pm
@@ -17,24 +17,25 @@
# under the License.
#
-require 5.6.0;
-
+use 5.10.0;
use strict;
use warnings;
-use utf8;
-use Encode;
-
-use Thrift;
-use Thrift::Protocol;
-
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;
@@ -97,7 +98,7 @@
sub writeFieldStop
{
my $self = shift;
- return $self->writeByte(TType::STOP);
+ return $self->writeByte(Thrift::TType::STOP);
}
sub writeMapBegin
@@ -252,7 +253,8 @@
my $result = $self->readI32(\$version);
if (($version & VERSION_MASK) > 0) {
if (($version & VERSION_MASK) != VERSION_1) {
- die new Thrift::TException('Missing version identifier')
+ die new Thrift::TProtocolException('Missing version identifier',
+ Thrift::TProtocolException::BAD_VERSION);
}
$$type = $version & 0x000000ff;
return
@@ -297,7 +299,7 @@
my $result = $self->readByte($fieldType);
- if ($$fieldType == TType::STOP) {
+ if ($$fieldType == Thrift::TType::STOP) {
$$fieldId = 0;
return $result;
}
@@ -447,7 +449,7 @@
else {
$data = scalar reverse($self->{trans}->readAll(8));
}
-
+
my @arr = unpack('d', $data);
$$value = $arr[0];
@@ -491,7 +493,8 @@
# Binary Protocol Factory
#
package Thrift::BinaryProtocolFactory;
-use base('TProtocolFactory');
+use base('Thrift::TProtocolFactory');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
diff --git a/lib/perl/lib/Thrift/BufferedTransport.pm b/lib/perl/lib/Thrift/BufferedTransport.pm
index 3868ca2..6b5bf7a 100644
--- a/lib/perl/lib/Thrift/BufferedTransport.pm
+++ b/lib/perl/lib/Thrift/BufferedTransport.pm
@@ -17,15 +17,17 @@
# under the License.
#
-require 5.6.0;
+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
{
@@ -110,6 +112,7 @@
# 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;
diff --git a/lib/perl/lib/Thrift/Exception.pm b/lib/perl/lib/Thrift/Exception.pm
new file mode 100644
index 0000000..5f0d8fb
--- /dev/null
+++ b/lib/perl/lib/Thrift/Exception.pm
@@ -0,0 +1,160 @@
+#
+# 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
+ ref( $_[0] )
+ . " error: "
+ . ( $_[0]->{message} || 'empty message' )
+ . " (code "
+ . ( 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/lib/perl/lib/Thrift/FramedTransport.pm b/lib/perl/lib/Thrift/FramedTransport.pm
index 6f2d2cf..ee842e6 100644
--- a/lib/perl/lib/Thrift/FramedTransport.pm
+++ b/lib/perl/lib/Thrift/FramedTransport.pm
@@ -17,6 +17,7 @@
# under the License.
#
+use 5.10.0;
use strict;
use warnings;
@@ -30,8 +31,8 @@
# @package thrift.transport
#
package Thrift::FramedTransport;
-
use base('Thrift::Transport');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
@@ -167,6 +168,7 @@
# 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;
@@ -189,5 +191,4 @@
return $buffered;
}
-
1;
diff --git a/lib/perl/lib/Thrift/HttpClient.pm b/lib/perl/lib/Thrift/HttpClient.pm
index d6fc8be..2ad618f 100644
--- a/lib/perl/lib/Thrift/HttpClient.pm
+++ b/lib/perl/lib/Thrift/HttpClient.pm
@@ -17,26 +17,25 @@
# under the License.
#
-require 5.6.0;
+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;
-use HTTP::Request;
-use LWP::UserAgent;
-use IO::String;
-
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 $debugHandler = shift;
my $out = IO::String->new;
binmode($out);
@@ -44,44 +43,35 @@
my $self = {
url => $url,
out => $out,
- debugHandler => $debugHandler,
- debug => 0,
- sendTimeout => 100,
- recvTimeout => 750,
+ timeout => 100,
handle => undef,
};
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;
- $self->{sendTimeout} = $timeout;
-}
+ warn "setSendTimeout is deprecated - use setTimeout instead";
-sub setRecvTimeout
-{
- my $self = shift;
- my $timeout = shift;
-
- $self->{recvTimeout} = $timeout;
-}
-
-
-#
-#Sets debugging output on or off
-#
-# @param bool $debug
-#
-sub setDebug
-{
- my $self = shift;
- my $debug = shift;
-
- $self->{debug} = $debug;
+ $self->setTimeout($timeout);
}
#
@@ -122,7 +112,8 @@
my $buf = $self->read($len);
if (!defined($buf)) {
- die new Thrift::TException('TSocket: Could not read '.$len.' bytes from input buffer');
+ die new Thrift::TTransportException("TSocket: Could not read $len bytes from input buffer",
+ Thrift::TTransportException::END_OF_FILE);
}
return $buf;
}
@@ -140,15 +131,17 @@
my $in = $self->{in};
if (!defined($in)) {
- die new Thrift::TException("Response buffer is empty, no request.");
+ die new Thrift::TTransportException("Response buffer is empty, no request.",
+ Thrift::TTransportException::END_OF_FILE);
}
eval {
my $ret = sysread($in, $buf, $len);
if (! defined($ret)) {
- die new Thrift::TException("No more data available.");
+ die new Thrift::TTransportException("No more data available.",
+ Thrift::TTransportException::TIMED_OUT);
}
}; if($@){
- die new Thrift::TException($@);
+ die new Thrift::TTransportException("$@", Thrift::TTransportException::UNKNOWN);
}
return $buf;
@@ -171,7 +164,7 @@
{
my $self = shift;
- my $ua = LWP::UserAgent->new('timeout' => ($self->{sendTimeout} / 1000),
+ my $ua = LWP::UserAgent->new('timeout' => ($self->{timeout} / 1000),
'agent' => 'Perl/THttpClient'
);
$ua->default_header('Accept' => 'application/x-thrift');
diff --git a/lib/perl/lib/Thrift/MemoryBuffer.pm b/lib/perl/lib/Thrift/MemoryBuffer.pm
index 0b28687..1e51239 100644
--- a/lib/perl/lib/Thrift/MemoryBuffer.pm
+++ b/lib/perl/lib/Thrift/MemoryBuffer.pm
@@ -17,7 +17,7 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
@@ -26,6 +26,7 @@
package Thrift::MemoryBuffer;
use base('Thrift::Transport');
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
@@ -116,7 +117,8 @@
my $avail = ($self->{wPos} - $self->{rPos});
if ($avail < $len) {
- die new TTransportException("Attempt to readAll($len) found only $avail available");
+ die new TTransportException("Attempt to readAll($len) found only $avail available",
+ Thrift::TTransportException::END_OF_FILE);
}
my $data = '';
diff --git a/lib/perl/lib/Thrift/MessageType.pm b/lib/perl/lib/Thrift/MessageType.pm
index c8902cc..d25c2f7 100644
--- a/lib/perl/lib/Thrift/MessageType.pm
+++ b/lib/perl/lib/Thrift/MessageType.pm
@@ -17,16 +17,21 @@
# under the License.
#
+use 5.10.0;
use strict;
use warnings;
-package Thrift::MessageType;
+use Thrift;
-use strict;
+#
+# 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;
+use constant CALL => 1;
+use constant REPLY => 2;
+use constant EXCEPTION => 3;
+use constant ONEWAY => 4;
-1;
\ No newline at end of file
+1;
diff --git a/lib/perl/lib/Thrift/MultiplexedProcessor.pm b/lib/perl/lib/Thrift/MultiplexedProcessor.pm
index 421bf73..6629c0b 100644
--- a/lib/perl/lib/Thrift/MultiplexedProcessor.pm
+++ b/lib/perl/lib/Thrift/MultiplexedProcessor.pm
@@ -17,19 +17,19 @@
# under the License.
#
+use 5.10.0;
use strict;
use warnings;
use Thrift;
-use Thrift::Protocol;
-use Thrift::MultiplexedProtocol;
-use Thrift::ProtocolDecorator;
use Thrift::MessageType;
+use Thrift::MultiplexedProtocol;
+use Thrift::Protocol;
+use Thrift::ProtocolDecorator;
package Thrift::StoredMessageProtocol;
use base qw(Thrift::ProtocolDecorator);
-
-use strict;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
@@ -46,7 +46,7 @@
return bless($self,$classname);
}
-sub readMessageBegin
+sub readMessageBegin
{
my $self = shift;
my $name = shift;
@@ -59,13 +59,12 @@
}
package Thrift::MultiplexedProcessor;
-
-use strict;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
my $self = {};
-
+
$self->{serviceProcessorMap} = {};
return bless($self,$classname);
@@ -75,11 +74,11 @@
my $self = shift;
my $serviceName = shift;
my $processor = shift;
-
+
$self->{serviceProcessorMap}->{$serviceName} = $processor;
}
-sub process{
+sub process {
my $self = shift;
my $input = shift;
my $output = shift;
@@ -92,30 +91,29 @@
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!?");
+ if ($mtype ne Thrift::TMessageType::CALL && $mtype ne Thrift::TMessageType::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 " .
+ 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 " .
+ die new Thrift::TException("Service name not found: {$serviceName}. Did you forget " .
"to call registerProcessor()?");
}
-
- #Dispatch processing to the stored processor
+
+ # 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
+1;
diff --git a/lib/perl/lib/Thrift/MultiplexedProtocol.pm b/lib/perl/lib/Thrift/MultiplexedProtocol.pm
index 83a4eaf..903211f 100644
--- a/lib/perl/lib/Thrift/MultiplexedProtocol.pm
+++ b/lib/perl/lib/Thrift/MultiplexedProtocol.pm
@@ -17,26 +17,27 @@
# under the License.
#
+use 5.10.0;
use strict;
use warnings;
+use Thrift;
+use Thrift::MessageType;
use Thrift::Protocol;
use Thrift::ProtocolDecorator;
-use Thrift::MessageType;
package Thrift::MultiplexedProtocol;
use base qw(Thrift::ProtocolDecorator);
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
-use strict;
-
-use constant SEPARATOR => ':';
+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);
@@ -50,18 +51,18 @@
# @param int $type Message type.
# @param int $seqid The sequence id of this message.
#
-sub writeMessageBegin
+sub writeMessageBegin
{
- my $self = shift;
+ my $self = shift;
my ($name, $type, $seqid) = @_;
- if ($type == Thrift::MessageType::CALL || $type == Thrift::MessageType::ONEWAY) {
+ 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);
+ $self->SUPER::writeMessageBegin($name, $type, $seqid);
}
}
-1;
\ No newline at end of file
+1;
diff --git a/lib/perl/lib/Thrift/Protocol.pm b/lib/perl/lib/Thrift/Protocol.pm
index 3e9f0dd..c681f60 100644
--- a/lib/perl/lib/Thrift/Protocol.pm
+++ b/lib/perl/lib/Thrift/Protocol.pm
@@ -17,26 +17,28 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
use Thrift;
+use Thrift::Exception;
+use Thrift::Type;
#
# Protocol exceptions
#
-package TProtocolException;
+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 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;
-
+use constant DEPTH_LIMIT => 6;
sub new {
my $classname = shift;
@@ -50,6 +52,7 @@
# Protocol base class module.
#
package Thrift::Protocol;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
@@ -92,7 +95,7 @@
# Writes a struct header.
#
# @param string $name Struct name
-# @throws TException on write error
+# @throws TProtocolException on write error
# @return int How many bytes written
#
sub writeStructBegin {
@@ -104,7 +107,7 @@
#
# Close a struct.
#
-# @throws TException on write error
+# @throws TProtocolException on write error
# @return int How many bytes written
#
sub writeStructEnd {
@@ -117,7 +120,7 @@
# @param string $name Field name
# @param int $type Field type
# @param int $fid Field id
-# @throws TException on write error
+# @throws TProtocolException on write error
# @return int How many bytes written
#
sub writeFieldBegin {
@@ -332,36 +335,36 @@
my $result;
my $i;
- if($type == TType::BOOL)
+ if($type == Thrift::TType::BOOL)
{
return $self->readBool(\$ref);
}
- elsif($type == TType::BYTE){
+ elsif($type == Thrift::TType::BYTE){
return $self->readByte(\$ref);
}
- elsif($type == TType::I16){
+ elsif($type == Thrift::TType::I16){
return $self->readI16(\$ref);
}
- elsif($type == TType::I32){
+ elsif($type == Thrift::TType::I32){
return $self->readI32(\$ref);
}
- elsif($type == TType::I64){
+ elsif($type == Thrift::TType::I64){
return $self->readI64(\$ref);
}
- elsif($type == TType::DOUBLE){
+ elsif($type == Thrift::TType::DOUBLE){
return $self->readDouble(\$ref);
}
- elsif($type == TType::STRING)
+ elsif($type == Thrift::TType::STRING)
{
return $self->readString(\$ref);
}
- elsif($type == TType::STRUCT)
+ elsif($type == Thrift::TType::STRUCT)
{
$result = $self->readStructBegin(\$ref);
while (1) {
my ($ftype,$fid);
$result += $self->readFieldBegin(\$ref, \$ftype, \$fid);
- if ($ftype == TType::STOP) {
+ if ($ftype == Thrift::TType::STOP) {
last;
}
$result += $self->skip($ftype);
@@ -370,7 +373,7 @@
$result += $self->readStructEnd();
return $result;
}
- elsif($type == TType::MAP)
+ elsif($type == Thrift::TType::MAP)
{
my($keyType,$valType,$size);
$result = $self->readMapBegin(\$keyType, \$valType, \$size);
@@ -381,7 +384,7 @@
$result += $self->readMapEnd();
return $result;
}
- elsif($type == TType::SET)
+ elsif($type == Thrift::TType::SET)
{
my ($elemType,$size);
$result = $self->readSetBegin(\$elemType, \$size);
@@ -391,7 +394,7 @@
$result += $self->readSetEnd();
return $result;
}
- elsif($type == TType::LIST)
+ elsif($type == Thrift::TType::LIST)
{
my ($elemType,$size);
$result = $self->readListBegin(\$elemType, \$size);
@@ -402,7 +405,8 @@
return $result;
}
- die new Thrift::TException("Type $type not recognised --- corrupt data?");
+ die new Thrift::TProtocolException("Type $type not recognized --- corrupt data?",
+ Thrift::TProtocolException::INVALID_DATA);
}
@@ -418,31 +422,31 @@
my $itrans = shift;
my $type = shift;
- if($type == TType::BOOL)
+ if($type == Thrift::TType::BOOL)
{
return $itrans->readAll(1);
}
- elsif($type == TType::BYTE)
+ elsif($type == Thrift::TType::BYTE)
{
return $itrans->readAll(1);
}
- elsif($type == TType::I16)
+ elsif($type == Thrift::TType::I16)
{
return $itrans->readAll(2);
}
- elsif($type == TType::I32)
+ elsif($type == Thrift::TType::I32)
{
return $itrans->readAll(4);
}
- elsif($type == TType::I64)
+ elsif($type == Thrift::TType::I64)
{
return $itrans->readAll(8);
}
- elsif($type == TType::DOUBLE)
+ elsif($type == Thrift::TType::DOUBLE)
{
return $itrans->readAll(8);
}
- elsif( $type == TType::STRING )
+ elsif( $type == Thrift::TType::STRING )
{
my @len = unpack('N', $itrans->readAll(4));
my $len = $len[0];
@@ -451,7 +455,7 @@
}
return 4 + $itrans->readAll($len);
}
- elsif( $type == TType::STRUCT )
+ elsif( $type == Thrift::TType::STRUCT )
{
my $result = 0;
while (1) {
@@ -460,7 +464,7 @@
my $data = $itrans->readAll(1);
my @arr = unpack('c', $data);
$ftype = $arr[0];
- if ($ftype == TType::STOP) {
+ if ($ftype == Thrift::TType::STOP) {
last;
}
# I16 field id
@@ -469,7 +473,7 @@
}
return $result;
}
- elsif($type == TType::MAP)
+ elsif($type == Thrift::TType::MAP)
{
# Ktype
my $data = $itrans->readAll(1);
@@ -493,7 +497,7 @@
}
return $result;
}
- elsif($type == TType::SET || $type == TType::LIST)
+ elsif($type == Thrift::TType::SET || $type == Thrift::TType::LIST)
{
# Vtype
my $data = $itrans->readAll(1);
@@ -513,14 +517,15 @@
return $result;
}
- die new Thrift::TException("Type $type not recognised --- corrupt data?");
+ die new Thrift::TProtocolException("Type $type not recognized --- corrupt data?",
+ Thrift::TProtocolException::INVALID_DATA);
}
#
# Protocol factory creates protocol objects from transports
#
-package TProtocolFactory;
-
+package Thrift::TProtocolFactory;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
diff --git a/lib/perl/lib/Thrift/ProtocolDecorator.pm b/lib/perl/lib/Thrift/ProtocolDecorator.pm
index 8120200..cc5c9da 100644
--- a/lib/perl/lib/Thrift/ProtocolDecorator.pm
+++ b/lib/perl/lib/Thrift/ProtocolDecorator.pm
@@ -17,19 +17,22 @@
# 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);
@@ -45,7 +48,7 @@
sub writeMessageBegin {
my $self = shift;
my ($name, $type, $seqid) = @_;
-
+
return $self->{concreteProtocol}->writeMessageBegin($name, $type, $seqid);
}
@@ -54,7 +57,7 @@
#
sub writeMessageEnd {
my $self = shift;
-
+
return $self->{concreteProtocol}->writeMessageEnd();
}
@@ -79,7 +82,7 @@
# @return int How many bytes written
#
sub writeStructEnd {
- my $self = shift;
+ my $self = shift;
return $self->{concreteProtocol}->writeStructEnd();
}
@@ -101,13 +104,13 @@
}
sub writeFieldEnd {
- my $self = shift;
+ my $self = shift;
return $self->{concreteProtocol}->writeFieldEnd();
}
sub writeFieldStop {
- my $self = shift;
+ my $self = shift;
return $self->{concreteProtocol}->writeFieldStop();
}
@@ -121,7 +124,7 @@
sub writeMapEnd {
my $self = shift;
-
+
return $self->{concreteProtocol}->writeMapEnd();
}
@@ -134,7 +137,7 @@
sub writeListEnd {
my $self = shift;
-
+
return $self->{concreteProtocol}->writeListEnd();
}
@@ -147,7 +150,7 @@
sub writeSetEnd {
my $self = shift;
-
+
return $self->{concreteProtocol}->writeListEnd();
}
@@ -177,7 +180,7 @@
my ($i32) = @_;
return $self->{concreteProtocol}->writeI32($i32);
-
+
}
sub writeI64 {
@@ -221,7 +224,7 @@
#
sub readMessageEnd
{
- my $self = shift;
+ my $self = shift;
return $self->{concreteProtocol}->readMessageEnd();
}
@@ -236,7 +239,7 @@
sub readStructEnd
{
- my $self = shift;
+ my $self = shift;
return $self->{concreteProtocol}->readStructEnd();
}
@@ -251,7 +254,7 @@
sub readFieldEnd
{
- my $self = shift;
+ my $self = shift;
return $self->{concreteProtocol}->readFieldEnd();
}
@@ -266,7 +269,7 @@
sub readMapEnd
{
- my $self = shift;
+ my $self = shift;
return $self->{concreteProtocol}->readMapEnd();
}
@@ -281,7 +284,7 @@
sub readListEnd
{
- my $self = shift;
+ my $self = shift;
return $self->{concreteProtocol}->readListEnd();
}
@@ -296,7 +299,7 @@
sub readSetEnd
{
- my $self = shift;
+ my $self = shift;
return $self->{concreteProtocol}->readSetEnd();
}
diff --git a/lib/perl/lib/Thrift/SSLServerSocket.pm b/lib/perl/lib/Thrift/SSLServerSocket.pm
index a8dfa56..d29671b 100644
--- a/lib/perl/lib/Thrift/SSLServerSocket.pm
+++ b/lib/perl/lib/Thrift/SSLServerSocket.pm
@@ -17,19 +17,19 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
use Thrift;
use Thrift::SSLSocket;
+use Thrift::ServerSocket;
use IO::Socket::SSL;
-use IO::Select;
package Thrift::SSLServerSocket;
-
use base qw( Thrift::ServerSocket );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Constructor.
diff --git a/lib/perl/lib/Thrift/SSLSocket.pm b/lib/perl/lib/Thrift/SSLSocket.pm
index 99a4107..4bdf637 100644
--- a/lib/perl/lib/Thrift/SSLSocket.pm
+++ b/lib/perl/lib/Thrift/SSLSocket.pm
@@ -17,19 +17,18 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
use Thrift;
-use Thrift::Transport;
+use Thrift::Socket;
use IO::Socket::SSL;
-use IO::Select;
package Thrift::SSLSocket;
-
use base qw( Thrift::Socket );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Construction and usage
diff --git a/lib/perl/lib/Thrift/Server.pm b/lib/perl/lib/Thrift/Server.pm
index 5829e67..fc9ca30 100644
--- a/lib/perl/lib/Thrift/Server.pm
+++ b/lib/perl/lib/Thrift/Server.pm
@@ -17,25 +17,31 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
use Thrift;
-use Thrift::BufferedTransport;
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;
@@ -61,7 +67,7 @@
}
else
{
- die "Thrift::Server expects exactly 2, 4, or 6 args";
+ die new Thrift::TException("Thrift::Server expects exactly 2, 4, or 6 args");
}
return bless($self,$classname);
@@ -109,7 +115,7 @@
my $self = shift;
my $e = shift;
- if ($e =~ m/TException/ and exists $e->{message}) {
+ if ($e->isa("Thrift::TException") and exists $e->{message}) {
my $message = $e->{message};
my $code = $e->{code};
my $out = $code . ':' . $message;
@@ -129,14 +135,15 @@
# SimpleServer from the Server base class that handles one connection at a time
#
package Thrift::SimpleServer;
-use base qw( Thrift::Server );
+use parent -norequire, 'Thrift::Server';
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
my $classname = shift;
- my @args = @_;
- my $self = $classname->SUPER::new(@args);
+ my $self = $classname->SUPER::new(@_);
+
return bless($self,$classname);
}
@@ -172,9 +179,9 @@
# ForkingServer that forks a new process for each request
#
package Thrift::ForkingServer;
-use base qw( Thrift::Server );
-
+use parent -norequire, 'Thrift::Server';
use POSIX ":sys_wait_h";
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new
{
@@ -217,7 +224,7 @@
my $pid = fork();
- if ($pid) #parent
+ if ($pid)
{
$self->_parent($pid, $itrans, $otrans);
} else {
@@ -278,7 +285,7 @@
$file->close();
}
}; if($@) {
- if ($@ =~ m/TException/ and exists $@->{message}) {
+ if ($@->isa("Thrift::TException") and exists $@->{message}) {
my $message = $@->{message};
my $code = $@->{code};
my $out = $code . ':' . $message;
diff --git a/lib/perl/lib/Thrift/ServerSocket.pm b/lib/perl/lib/Thrift/ServerSocket.pm
index 89664f6..51f83b4 100644
--- a/lib/perl/lib/Thrift/ServerSocket.pm
+++ b/lib/perl/lib/Thrift/ServerSocket.pm
@@ -17,18 +17,19 @@
# under the License.
#
-require 5.6.0;
+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.
@@ -44,7 +45,7 @@
my $classname = shift;
my $args = shift;
my $self;
-
+
# Support both old-style "port number" construction and newer...
if (ref($args) eq 'HASH') {
$self = $args;
@@ -55,7 +56,7 @@
if (not defined $self->{queue}) {
$self->{queue} = 128;
}
-
+
return bless($self, $classname);
}
@@ -70,7 +71,7 @@
$self->{debugHandler}->($error);
}
- die new Thrift::TException($error);
+ die new Thrift::TTransportException($error, Thrift::TTransportException::NOT_OPEN);
};
$self->{handle} = $sock;
@@ -97,7 +98,7 @@
sub __client
{
- return new Thrift::Socket();
+ return new Thrift::Socket();
}
sub __listen
diff --git a/lib/perl/lib/Thrift/Socket.pm b/lib/perl/lib/Thrift/Socket.pm
index c8e333b..ae248df 100644
--- a/lib/perl/lib/Thrift/Socket.pm
+++ b/lib/perl/lib/Thrift/Socket.pm
@@ -17,19 +17,20 @@
# under the License.
#
-require 5.6.0;
+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
@@ -119,7 +120,7 @@
my $sock = $self->__open() || do {
my $error = ref($self).': Could not connect to '.$self->{host}.':'.$self->{port}.' ('.$!.')';
- die new Thrift::TException($error);
+ die new Thrift::TTransportException($error, Thrift::TTransportException::NOT_OPEN);
};
$self->{handle} = new IO::Select( $sock );
@@ -158,8 +159,8 @@
if (!defined $buf || $buf eq '') {
- die new Thrift::TException(ref($self).': Could not read '.$len.' bytes from '.
- $self->{host}.':'.$self->{port});
+ die new Thrift::TTransportException(ref($self).': Could not read '.$len.' bytes from '.
+ $self->{host}.':'.$self->{port}, Thrift::TTransportException::END_OF_FILE);
} elsif ((my $sz = length($buf)) < $len) {
@@ -190,8 +191,8 @@
if (!defined $buf || $buf eq '') {
- die new TException(ref($self).': Could not read '.$len.' bytes from '.
- $self->{host}.':'.$self->{port});
+ die new Thrift::TTransportException(ref($self).': Could not read '.$len.' bytes from '.
+ $self->{host}.':'.$self->{port}, Thrift::TTransportException::END_OF_FILE);
}
@@ -216,16 +217,16 @@
my @sockets = $self->{handle}->can_write( $self->{sendTimeout} / 1000 );
if(@sockets == 0){
- die new Thrift::TException(ref($self).': timed out writing to bytes from '.
- $self->{host}.':'.$self->{port});
+ die new Thrift::TTransportException(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 new Thrift::TException(ref($self).': Could not write '.length($buf).' bytes '.
- $self->{host}.':'.$self->{host});
+ die new Thrift::TTransportException(ref($self).': Could not write '.length($buf).' bytes '.
+ $self->{host}.':'.$self->{host}, Thrift::TTransportException::END_OF_FILE);
}
@@ -313,8 +314,8 @@
my @sockets = $self->{handle}->can_read( $self->{recvTimeout} / 1000 );
if (@sockets == 0) {
- die new Thrift::TException(ref($self).': timed out reading from '.
- $self->{host}.':'.$self->{port});
+ die new Thrift::TTransportException(ref($self).': timed out reading from '.
+ $self->{host}.':'.$self->{port}, Thrift::TTransportException::TIMED_OUT);
}
return $sockets[0];
diff --git a/lib/perl/lib/Thrift/Transport.pm b/lib/perl/lib/Thrift/Transport.pm
index 5ec6fee..10c8ce2 100644
--- a/lib/perl/lib/Thrift/Transport.pm
+++ b/lib/perl/lib/Thrift/Transport.pm
@@ -17,17 +17,19 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
use Thrift;
+use Thrift::Exception;
#
# Transport exceptions
#
-package TTransportException;
+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;
@@ -35,7 +37,7 @@
use constant TIMED_OUT => 3;
use constant END_OF_FILE => 4;
-sub new{
+sub new {
my $classname = shift;
my $self = $classname->SUPER::new(@_);
@@ -43,6 +45,7 @@
}
package Thrift::Transport;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Whether this transport is open.
@@ -81,8 +84,7 @@
#
sub read
{
- my ($len);
- die("abstract");
+ die "abstract";
}
#
@@ -114,7 +116,6 @@
#
sub write
{
- my ($buf);
die "abstract";
}
@@ -130,6 +131,7 @@
# TransportFactory creates transport objects from transports
#
package Thrift::TransportFactory;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub new {
my $classname = shift;
@@ -156,6 +158,7 @@
# ServerTransport base class module
#
package Thrift::ServerTransport;
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
sub listen
{
diff --git a/lib/perl/lib/Thrift/Type.pm b/lib/perl/lib/Thrift/Type.pm
new file mode 100644
index 0000000..ad8da3b
--- /dev/null
+++ b/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/lib/perl/lib/Thrift/UnixServerSocket.pm b/lib/perl/lib/Thrift/UnixServerSocket.pm
index 3251a00..7b857ce 100644
--- a/lib/perl/lib/Thrift/UnixServerSocket.pm
+++ b/lib/perl/lib/Thrift/UnixServerSocket.pm
@@ -17,19 +17,19 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
use Thrift;
+use Thrift::ServerSocket;
use Thrift::UnixSocket;
use IO::Socket::UNIX;
-use IO::Select;
package Thrift::UnixServerSocket;
-
use base qw( Thrift::ServerSocket );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Constructor.
@@ -58,7 +58,7 @@
sub __client
{
- return new Thrift::UnixSocket();
+ return new Thrift::UnixSocket();
}
sub __listen
@@ -75,7 +75,7 @@
if ($self->{debug}) {
$self->{debugHandler}->($error);
}
- die new Thrift::TException($error);
+ die new Thrift::TTransportException($error, Thrift::TTransportException::NOT_OPEN);
};
return $sock;
diff --git a/lib/perl/lib/Thrift/UnixSocket.pm b/lib/perl/lib/Thrift/UnixSocket.pm
index 15886fb..8b00450 100644
--- a/lib/perl/lib/Thrift/UnixSocket.pm
+++ b/lib/perl/lib/Thrift/UnixSocket.pm
@@ -17,19 +17,18 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
use Thrift;
-use Thrift::Transport;
+use Thrift::Socket;
use IO::Socket::UNIX;
-use IO::Select;
package Thrift::UnixSocket;
-
use base qw( Thrift::Socket );
+use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
#
# Constructor.
@@ -42,7 +41,7 @@
{
my $classname = shift;
my $self = $classname->SUPER::new();
- $self->{path} = shift;
+ $self->{path} = shift;
return bless($self, $classname);
}
@@ -59,7 +58,7 @@
if ($self->{debug}) {
$self->{debugHandler}->($error);
}
- die new Thrift::TException($error);
+ die new Thrift::TTransportException($error, Thrift::TTransportException::NOT_OPEN);
};
return $sock;
diff --git a/lib/perl/test/multiplex.t b/lib/perl/test/multiplex.t
index 76f2706..90a9b4d 100644
--- a/lib/perl/test/multiplex.t
+++ b/lib/perl/test/multiplex.t
@@ -22,15 +22,13 @@
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 Thrift::MessageType;
+use Thrift::MultiplexedProcessor;
+use Thrift::Server;
+use Thrift::Socket;
use BenchmarkService;
use Aggr;
@@ -103,7 +101,7 @@
$aggr_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
- if ($message_type == TMessageType::EXCEPTION) {
+ if ($message_type == Thrift::TMessageType::EXCEPTION) {
die;
}
@@ -116,7 +114,7 @@
$aggr_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
-if ($message_type == TMessageType::EXCEPTION) {
+if ($message_type == Thrift::TMessageType::EXCEPTION) {
die;
}
@@ -132,7 +130,7 @@
$benchmark_protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
- if ($message_type == TMessageType::EXCEPTION) {
+ if ($message_type == Thrift::TMessageType::EXCEPTION) {
die;
}
my $benchmark_result = BenchmarkService_fibonacci_result->new();
diff --git a/lib/perl/test/processor.t b/lib/perl/test/processor.t
index 1d8be73..f833035 100644
--- a/lib/perl/test/processor.t
+++ b/lib/perl/test/processor.t
@@ -22,9 +22,9 @@
use strict;
use warnings;
-use Thrift;
use Thrift::BinaryProtocol;
use Thrift::MemoryBuffer;
+use Thrift::MessageType;
use ThriftTest::ThriftTest;
use ThriftTest::Types;
@@ -72,7 +72,7 @@
$protocol->readMessageBegin(\$function_name, \$message_type, \$sequence_id);
print " $function_name, $message_type, $sequence_id\n";
- if ($message_type == TMessageType::EXCEPTION) {
+ if ($message_type == Thrift::TMessageType::EXCEPTION) {
die;
}
diff --git a/test/perl/TestClient.pl b/test/perl/TestClient.pl
index 483c964..6f3cbc9 100755
--- a/test/perl/TestClient.pl
+++ b/test/perl/TestClient.pl
@@ -19,7 +19,7 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
use Data::Dumper;
diff --git a/test/perl/TestServer.pl b/test/perl/TestServer.pl
index e2835f4..c97067e 100644
--- a/test/perl/TestServer.pl
+++ b/test/perl/TestServer.pl
@@ -19,7 +19,7 @@
# under the License.
#
-require 5.6.0;
+use 5.10.0;
use strict;
use warnings;
use Data::Dumper;