16470: Fixes deprecation warning.
[arvados.git] / sdk / perl / lib / Arvados.pm
1 # Copyright (C) The Arvados Authors. All rights reserved.
2 #
3 # SPDX-License-Identifier: Apache-2.0
4
5 =head1 NAME
6
7 Arvados -- client library for Arvados services
8
9 =head1 SYNOPSIS
10
11   use Arvados;
12   $arv = Arvados->new(apiHost => 'arvados.local');
13
14   my $instances = $arv->{'pipeline_instances'}->{'list'}->execute();
15   print "UUID is ", $instances->{'items'}->[0]->{'uuid'}, "\n";
16
17   $uuid = 'eiv0u-arx5y-2c5ovx43zw90gvh';
18   $instance = $arv->{'pipeline_instances'}->{'get'}->execute('uuid' => $uuid);
19   print "ETag is ", $instance->{'etag'}, "\n";
20
21   $instance->{'active'} = 1;
22   $instance->{'name'} = '';
23   $instance->save();
24   print "ETag is ", $instance->{'etag'}, "\n";
25
26 =head1 METHODS
27
28 =head2 new()
29
30  my $whc = Arvados->new( %OPTIONS );
31
32 Set up a client and retrieve the schema from the server.
33
34 =head3 Options
35
36 =over
37
38 =item apiHost
39
40 Hostname of API discovery service. Default: C<ARVADOS_API_HOST>
41 environment variable, or C<arvados>
42
43 =item apiProtocolScheme
44
45 Protocol scheme. Default: C<ARVADOS_API_PROTOCOL_SCHEME> environment
46 variable, or C<https>
47
48 =item authToken
49
50 Authorization token. Default: C<ARVADOS_API_TOKEN> environment variable
51
52 =item apiService
53
54 Default C<arvados>
55
56 =item apiVersion
57
58 Default C<v1>
59
60 =back
61
62 =cut
63
64 package Arvados;
65
66 use Net::SSL (); # From Crypt-SSLeay
67 BEGIN {
68   $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL"; # Force use of Net::SSL
69 }
70
71 use JSON;
72 use Carp;
73 use Arvados::ResourceAccessor;
74 use Arvados::ResourceMethod;
75 use Arvados::ResourceProxy;
76 use Arvados::ResourceProxyList;
77 use Arvados::Request;
78 use Data::Dumper;
79
80 $Arvados::VERSION = 0.1;
81
82 sub new
83 {
84     my $class = shift;
85     my %self = @_;
86     my $self = \%self;
87     bless ($self, $class);
88     return $self->build(@_);
89 }
90
91 sub build
92 {
93     my $self = shift;
94
95     $config = load_config_file("$ENV{HOME}/.config/arvados/settings.conf");
96
97     $self->{'authToken'} ||=
98         $ENV{ARVADOS_API_TOKEN} || $config->{ARVADOS_API_TOKEN};
99
100     $self->{'apiHost'} ||=
101         $ENV{ARVADOS_API_HOST} || $config->{ARVADOS_API_HOST};
102
103     $self->{'noVerifyHostname'} ||=
104         $ENV{ARVADOS_API_HOST_INSECURE};
105
106     $self->{'apiProtocolScheme'} ||=
107         $ENV{ARVADOS_API_PROTOCOL_SCHEME} ||
108         $config->{ARVADOS_API_PROTOCOL_SCHEME};
109
110     $self->{'ua'} = new Arvados::Request;
111
112     my $host = $self->{'apiHost'} || 'arvados';
113     my $service = $self->{'apiService'} || 'arvados';
114     my $version = $self->{'apiVersion'} || 'v1';
115     my $scheme = $self->{'apiProtocolScheme'} || 'https';
116     my $uri = "$scheme://$host/discovery/v1/apis/$service/$version/rest";
117     my $r = $self->new_request;
118     $r->set_uri($uri);
119     $r->set_method("GET");
120     $r->process_request();
121     my $data, $headers;
122     my ($status_number, $status_phrase) = $r->get_status();
123     $data = $r->get_body() if $status_number == 200;
124     $headers = $r->get_headers();
125     if ($data) {
126         my $doc = $self->{'discoveryDocument'} = JSON::decode_json($data);
127         print STDERR Dumper $doc if $ENV{'DEBUG_ARVADOS_API_DISCOVERY'};
128         my $k, $v;
129         while (($k, $v) = each %{$doc->{'resources'}}) {
130             $self->{$k} = Arvados::ResourceAccessor->new($self, $k);
131         }
132     } else {
133         croak "No discovery doc at $uri - $status_number $status_phrase";
134     }
135     $self;
136 }
137
138 sub new_request
139 {
140     my $self = shift;
141     local $ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'};
142     if ($self->{'noVerifyHostname'} || ($host =~ /\.local$/)) {
143         $ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;
144     }
145     Arvados::Request->new();
146 }
147
148 sub load_config_file ($)
149 {
150     my $config_file = shift;
151     my %config;
152
153     if (open (CONF, $config_file)) {
154         while (<CONF>) {
155             next if /^\s*#/ || /^\s*$/;  # skip comments and blank lines
156             chomp;
157             my ($key, $val) = split /\s*=\s*/, $_, 2;
158             $config{$key} = $val;
159         }
160     }
161     close CONF;
162     return \%config;
163 }
164
165 1;