From: David Reiss Date: Thu, 8 Nov 2007 01:05:46 +0000 (+0000) Subject: Thrift: Perl HttpClient and fixes. X-Git-Tag: 0.2.0~1145 X-Git-Url: https://source.supwisdom.com/gerrit/gitweb?a=commitdiff_plain;h=c0c88ee8056427f66451e527f791b31f7485b4ca;p=common%2Fthrift.git 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 7ecb9342..e4e011d4 100644 --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -1,3 +1,6 @@ +Igor Afanasyev +-Perl HttpClient and bugfixes + ---------------- Release 20070917 ---------------- @@ -45,11 +48,6 @@ Paul Querna -Autoconf error message fix for libevent detection -clock_gettime implementation for OSX -Andrew Bosworth -- 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 b9bb88de..bb570a26 100644 --- a/lib/perl/lib/Thrift/BinaryProtocol.pm +++ b/lib/perl/lib/Thrift/BinaryProtocol.pm @@ -229,14 +229,22 @@ sub readMessageBegin 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 @@ sub readString 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 856a9432..ecc25f3d 100644 --- a/lib/perl/lib/Thrift/BufferedTransport.pm +++ b/lib/perl/lib/Thrift/BufferedTransport.pm @@ -73,18 +73,6 @@ sub read # 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 @@ sub flush $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 00000000..854149b1 --- /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 +# + +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;