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