sdk/perl/lib/Arvados/Request.pm

   1 # Copyright (C) The Arvados Authors. All rights reserved.
   2 #
   3 # SPDX-License-Identifier: Apache-2.0
   4
   5 package Arvados::Request;
   6 use Data::Dumper;
   7 use LWP::UserAgent;
   8 use URI::Escape;
   9 use Encode;
  10 use strict;
  11 @Arvados::HTTP::ISA = qw(LWP::UserAgent);
  12
  13 sub new
  14 {
  15     my $class = shift;
  16     my $self = {};
  17     bless ($self, $class);
  18     return $self->_init(@_);
  19 }
  20
  21 sub _init
  22 {
  23     my $self = shift;
  24     $self->{'ua'} = new LWP::UserAgent(@_);
  25     $self->{'ua'}->agent ("libarvados-perl/".$Arvados::VERSION);
  26     $self;
  27 }
  28
  29 sub set_uri
  30 {
  31     my $self = shift;
  32     $self->{'uri'} = shift;
  33 }
  34
  35 sub process_request
  36 {
  37     my $self = shift;
  38     my %req;
  39     my %content;
  40     my $method = $self->{'method'};
  41     if ($method eq 'GET' || $method eq 'HEAD') {
  42         $content{'_method'} = $method;
  43         $method = 'POST';
  44     }
  45     $req{$method} = $self->{'uri'};
  46     $self->{'req'} = new HTTP::Request (%req);
  47     $self->{'req'}->header('Authorization' => ('OAuth2 ' . $self->{'authToken'})) if $self->{'authToken'};
  48     $self->{'req'}->header('Accept' => 'application/json');
  49
  50     # allow_nonref lets us encode JSON::true and JSON::false, see #12078
  51     my $json = JSON->new->allow_nonref;
  52     my ($p, $v);
  53     while (($p, $v) = each %{$self->{'queryParams'}}) {
  54         $content{$p} = (ref($v) eq "") ? $v : $json->encode($v);
  55     }
  56     my $content;
  57     while (($p, $v) = each %content) {
  58         $content .= '&' unless $content eq '';
  59         $content .= uri_escape($p);
  60         $content .= '=';
  61         $content .= uri_escape($v);
  62     }
  63     $self->{'req'}->content_type("application/x-www-form-urlencoded; charset='utf8'");
  64     $self->{'req'}->content(Encode::encode('utf8', $content));
  65     $self->{'res'} = $self->{'ua'}->request ($self->{'req'});
  66 }
  67
  68 sub get_status
  69 {
  70     my $self = shift;
  71     return ($self->{'res'}->code(),
  72             $self->{'res'}->message());
  73 }
  74
  75 sub get_body
  76 {
  77     my $self = shift;
  78     return $self->{'res'}->content;
  79 }
  80
  81 sub set_method
  82 {
  83     my $self = shift;
  84     $self->{'method'} = shift;
  85 }
  86
  87 sub set_query_params
  88 {
  89     my $self = shift;
  90     $self->{'queryParams'} = shift;
  91 }
  92
  93 sub set_auth_token
  94 {
  95     my $self = shift;
  96     $self->{'authToken'} = shift;
  97 }
  98
  99 sub get_headers
 100 {
 101     ""
 102 }
 103
 104 1;