File Coverage

blib/lib/TSVRPC/Client.pm
Criterion Covered Total %
statement 35 38 92.1
branch 5 12 41.6
condition 2 5 40.0
subroutine 8 8 100.0
pod 2 2 100.0
total 52 65 80.0


line stmt bran cond sub pod time code
1             package TSVRPC::Client;
2 6     6   24 use strict;
  6         8  
  6         173  
3 6     6   20 use warnings;
  6         7  
  6         109  
4 6     6   79 use 5.008001;
  6         44  
  6         232  
5             our $VERSION = '0.16';
6 6     6   1795 use TSVRPC::Parser;
  6         11  
  6         278  
7 6     6   1789 use TSVRPC::Util;
  6         10  
  6         141  
8 6     6   3374 use Furl::HTTP qw/HEADERS_NONE/;
  6         100571  
  6         1874  
9              
10             sub new {
11 1     1 1 2 my $class = shift;
12 1 50       5 my %args = @_==1 ? %{$_[0]} : @_;
  0         0  
13              
14 1 50       4 my $base = $args{base} or Carp::croak("missing argument named 'base' for rpc base url");
15 1 50       6 $base .= '/' unless $base =~ m{/$};
16              
17 1 50       4 my $timeout = exists( $args{timeout} ) ? $args{timeout} : 1;
18              
19 1   33     6 my $agent = $args{agent} || "$class/$VERSION";
20              
21 1         8 my $furl = Furl::HTTP->new(
22             timeout => $timeout,
23             useragent => $agent,
24             header_format => HEADERS_NONE,
25             );
26              
27 1         45 return bless {furl => $furl, base => $base}, $class;
28             }
29              
30             sub call {
31 1     1 1 2 my ( $self, $method, $args, $req_encoding ) = @_;
32 1   50     12 $req_encoding ||= 'B'; # default encoding is base64. because base64 is very fast.
33 1         4 my $content = TSVRPC::Parser::encode_tsvrpc($args, $req_encoding);
34 1         4 my $furl = $self->{furl};
35 1         3 my %special_headers = ('content-type' => undef);
36 1         10 my ( $minor_version, $code, $msg, $headers, $body ) = $furl->request(
37             url => $self->{base} . $method,
38             headers => [
39             "Content-Type" => "text/tab-separated-values; colenc=$req_encoding",
40             "Content-Length" => length($content),
41             ],
42             method => 'POST',
43             content => $content,
44             special_headers => \%special_headers,
45             );
46 1         681 my $decoded_body;
47 1 50       4 if (my $content_type = $special_headers{'content-type'}) {
48 0         0 my $res_encoding = TSVRPC::Util::parse_content_type( $content_type );
49 0 0       0 $decoded_body = defined($res_encoding) ? TSVRPC::Parser::decode_tsvrpc( $body, $res_encoding ) : undef;
50             }
51 1         5 return ($code, $decoded_body, $msg);
52             }
53              
54             1;
55             __END__