ceph/src/jaegertracing/thrift/lib/perl/lib/Thrift/HttpClient.pm

   1 #
   2 # Licensed to the Apache Software Foundation (ASF) under one
   3 # or more contributor license agreements. See the NOTICE file
   4 # distributed with this work for additional information
   5 # regarding copyright ownership. The ASF licenses this file
   6 # to you under the Apache License, Version 2.0 (the
   7 # "License"); you may not use this file except in compliance
   8 # with the License. You may obtain a copy of the License at
   9 #
  10 #   http://www.apache.org/licenses/LICENSE-2.0
  11 #
  12 # Unless required by applicable law or agreed to in writing,
  13 # software distributed under the License is distributed on an
  14 # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  15 # KIND, either express or implied. See the License for the
  16 # specific language governing permissions and limitations
  17 # under the License.
  18 #
  19
  20 use 5.10.0;
  21 use strict;
  22 use warnings;
  23
  24 use HTTP::Request;
  25 use IO::String;
  26 use LWP::UserAgent;
  27 use Thrift;
  28 use Thrift::Exception;
  29 use Thrift::Transport;
  30
  31 package Thrift::HttpClient;
  32 use base('Thrift::Transport');
  33 use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
  34
  35 sub new
  36 {
  37     my $classname = shift;
  38     my $url       = shift || 'http://localhost:9090';
  39
  40     my $out = IO::String->new;
  41     binmode($out);
  42
  43     my $self = {
  44         url          => $url,
  45         out          => $out,
  46         timeout      => 100,
  47         handle       => undef,
  48         headers      => {},
  49     };
  50
  51     return bless($self,$classname);
  52 }
  53
  54 sub setTimeout
  55 {
  56     my $self    = shift;
  57     my $timeout = shift;
  58
  59     $self->{timeout} = $timeout;
  60 }
  61
  62 sub setRecvTimeout
  63 {
  64     warn 'setRecvTimeout is deprecated - use setTimeout instead';
  65     # note: recvTimeout was never used so we do not need to do anything here
  66 }
  67
  68 sub setSendTimeout
  69 {
  70     my $self    = shift;
  71     my $timeout = shift;
  72
  73     warn 'setSendTimeout is deprecated - use setTimeout instead';
  74
  75     $self->setTimeout($timeout);
  76 }
  77
  78 sub setHeader
  79 {
  80     my $self = shift;
  81     my ($name, $value) = @_;
  82
  83     $self->{headers}->{$name} = $value;
  84 }
  85
  86 #
  87 # Tests whether this is open
  88 #
  89 # @return bool true if the socket is open
  90 #
  91 sub isOpen
  92 {
  93     return 1;
  94 }
  95
  96 sub open {}
  97
  98 #
  99 # Cleans up the buffer.
 100 #
 101 sub close
 102 {
 103     my $self = shift;
 104     if (defined($self->{io})) {
 105         close($self->{io});
 106         $self->{io} = undef;
 107     }
 108 }
 109
 110 #
 111 # Guarantees that the full amount of data is read.
 112 #
 113 # @return string The data, of exact length
 114 # @throws TTransportException if cannot read data
 115 #
 116 sub readAll
 117 {
 118     my $self = shift;
 119     my $len  = shift;
 120
 121     my $buf = $self->read($len);
 122
 123     if (!defined($buf)) {
 124         die Thrift::TTransportException->new("TSocket: Could not read $len bytes from input buffer",
 125                                           Thrift::TTransportException::END_OF_FILE);
 126     }
 127     return $buf;
 128 }
 129
 130 #
 131 # Read and return string
 132 #
 133 sub read
 134 {
 135     my $self = shift;
 136     my $len  = shift;
 137
 138     my $buf;
 139
 140     my $in = $self->{in};
 141
 142     if (!defined($in)) {
 143         die Thrift::TTransportException->new('Response buffer is empty, no request.',
 144                                           Thrift::TTransportException::END_OF_FILE);
 145     }
 146     eval {
 147         my $ret = sysread($in, $buf, $len);
 148         if (! defined($ret)) {
 149             die Thrift::TTransportException->new('No more data available.',
 150                                             Thrift::TTransportException::TIMED_OUT);
 151         }
 152     };
 153     if($@){
 154         die Thrift::TTransportException->new("$@", Thrift::TTransportException::UNKNOWN);
 155     }
 156
 157     return $buf;
 158 }
 159
 160 #
 161 # Write string
 162 #
 163 sub write
 164 {
 165     my $self = shift;
 166     my $buf  = shift;
 167     $self->{out}->print($buf);
 168 }
 169
 170 #
 171 # Flush output (do the actual HTTP/HTTPS request)
 172 #
 173 sub flush
 174 {
 175     my $self = shift;
 176
 177     my $ua = LWP::UserAgent->new(
 178         'timeout' => ($self->{timeout} / 1000),
 179         'agent'   => 'Perl/THttpClient'
 180      );
 181     $ua->default_header('Accept' => 'application/x-thrift');
 182     $ua->default_header('Content-Type' => 'application/x-thrift');
 183     $ua->cookie_jar({}); # hash to remember cookies between redirects
 184
 185     my $out = $self->{out};
 186     $out->setpos(0); # rewind
 187     my $buf = join('', <$out>);
 188
 189     my $request = HTTP::Request->new(POST => $self->{url}, ($self->{headers} || undef), $buf);
 190     my $response = $ua->request($request);
 191     my $content_ref = $response->content_ref;
 192
 193     my $in = IO::String->new($content_ref);
 194     binmode($in);
 195     $self->{in} = $in;
 196     $in->setpos(0); # rewind
 197
 198     # reset write buffer
 199     $out = IO::String->new;
 200     binmode($out);
 201     $self->{out} = $out;
 202 }
 203
 204 1;