Thrift: Perl HttpClient and fixes.
Summary:
Also updated the CONTRIBUTORS file. Sorry, Boz.
Reviewed By: mcslee
Revert Plan: ok
Other Notes:
Submitted by Igor Afanasyev.
Reviewed by Jake Luciani.
git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@665327 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/CONTRIBUTORS b/CONTRIBUTORS
index 7ecb934..e4e011d 100644
--- a/CONTRIBUTORS
+++ b/CONTRIBUTORS
@@ -1,3 +1,6 @@
+Igor Afanasyev <afan@evernote.com>
+-Perl HttpClient and bugfixes
+
----------------
Release 20070917
----------------
@@ -45,11 +48,6 @@
-Autoconf error message fix for libevent detection
-clock_gettime implementation for OSX
-Andrew Bosworth <bosworth@post.harvard.edu>
-- ReadWriteMutex
-- Mutex memory leak fix
-- added callback to redirect logging
-
----------------
Release 20070401
----------------
diff --git a/lib/perl/lib/Thrift/BinaryProtocol.pm b/lib/perl/lib/Thrift/BinaryProtocol.pm
index b9bb88d..bb570a2 100644
--- a/lib/perl/lib/Thrift/BinaryProtocol.pm
+++ b/lib/perl/lib/Thrift/BinaryProtocol.pm
@@ -229,14 +229,22 @@
my $version = 0;
my $result = $self->readI32(\$version);
- if ($version & VERSION_MASK != VERSION_1) {
- die new Thrift::TException('Missing version identifier')
- }
- $$type = $version & 0x000000ff;
- return
- $result +
- $self->readString($name) +
+ if (($version & VERSION_MASK) > 0) {
+ if (($version & VERSION_MASK) != VERSION_1) {
+ die new Thrift::TException('Missing version identifier')
+ }
+ $$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
@@ -436,6 +444,21 @@
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
#
diff --git a/lib/perl/lib/Thrift/BufferedTransport.pm b/lib/perl/lib/Thrift/BufferedTransport.pm
index 856a943..ecc25f3 100644
--- a/lib/perl/lib/Thrift/BufferedTransport.pm
+++ b/lib/perl/lib/Thrift/BufferedTransport.pm
@@ -73,18 +73,6 @@
# Methinks Perl is already buffering these for us
return $self->{transport}->read($len);
-
- if (length($self->{rBuf}) >= $len) {
- $ret = substr($self->{rBuf}, 0, $len);
- $self->{rBuf} = substr($self->rBuf_, $len);
- return $ret;
- }
-
- $self->{rBuf} .= $self->{transport}->read($self->{rBufSize});
- my $give = min(length($self->{rBuf}), $len);
- $ret = substr($self->{rBuf}, 0, $give);
- $self->{rBuf} = substr($self->{rBuf}, $give);
- return $ret;
}
sub write
@@ -107,6 +95,7 @@
$self->{transport}->write($self->{wBuf});
$self->{wBuf} = '';
}
+ $self->{transport}->flush();
}
diff --git a/lib/perl/lib/Thrift/HttpClient.pm b/lib/perl/lib/Thrift/HttpClient.pm
new file mode 100644
index 0000000..854149b
--- /dev/null
+++ b/lib/perl/lib/Thrift/HttpClient.pm
@@ -0,0 +1,193 @@
+#
+# Copyright (c) 2006- Facebook
+# Distributed under the Thrift Software License
+#
+# See accompanying file LICENSE or visit the Thrift site at:
+# http://developers.facebook.com/thrift/
+#
+# package - thrift.transport.http
+# based on socket transport implementation and java version of HttpClient
+# author - Igor Afanasyev <igor.afanasyev@gmail.com>
+#
+
+require 5.6.0;
+use strict;
+use warnings;
+
+use Thrift;
+use Thrift::Transport;
+
+use HTTP::Request;
+use LWP::UserAgent;
+use IO::String;
+
+package Thrift::HttpClient;
+
+use base('Thrift::Transport');
+
+sub new
+{
+ my $classname = shift;
+ my $url = shift || 'http://localhost:9090';
+ my $debugHandler = shift;
+
+ my $out = IO::String->new;
+ binmode($out);
+
+ my $self = {
+ url => $url,
+ out => $out,
+ debugHandler => $debugHandler,
+ debug => 0,
+ sendTimeout => 100,
+ recvTimeout => 750,
+ handle => undef,
+ };
+
+ return bless($self,$classname);
+}
+
+sub setSendTimeout
+{
+ my $self = shift;
+ my $timeout = shift;
+
+ $self->{sendTimeout} = $timeout;
+}
+
+sub setRecvTimeout
+{
+ my $self = shift;
+ my $timeout = shift;
+
+ $self->{recvTimeout} = $timeout;
+}
+
+
+#
+#Sets debugging output on or off
+#
+# @param bool $debug
+#
+sub setDebug
+{
+ my $self = shift;
+ my $debug = shift;
+
+ $self->{debug} = $debug;
+}
+
+#
+# Tests whether this is open
+#
+# @return bool true if the socket is open
+#
+sub isOpen
+{
+ 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 new Thrift::TException('TSocket: Could not read '.$len.' bytes from input buffer');
+ }
+ return $buf;
+}
+
+#
+# Read and return string
+#
+sub read
+{
+ my $self = shift;
+ my $len = shift;
+
+ my $buf;
+
+ my $in = $self->{in};
+
+ if (!defined($in)) {
+ die new Thrift::TException("Response buffer is empty, no request.");
+ }
+ eval {
+ my $ret = sysread($in, $buf, $len);
+ if (! defined($ret)) {
+ die new Thrift::TException("No more data available.");
+ }
+ }; if($@){
+ die new Thrift::TException($@);
+ }
+
+ 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->{sendTimeout},
+ '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 = new HTTP::Request(POST => $self->{url}, 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;