--- /dev/null
+=head1 NAME
+
+Arvados -- client library for Arvados services
+
+=head1 SYNOPSIS
+
+ use Arvados;
+ $arv = Arvados->new()->build(apiHost => 'arvados.local');
+
+ my $instances = $arv->{'pipeline_instances'}->{'list'}->execute();
+ print "UUID is ", $instances->{'items'}->[0]->{'uuid'}, "\n";
+
+ $uuid = 'eiv0u-arx5y-2c5ovx43zw90gvh';
+ $instance = $arv->{'pipeline_instances'}->{'get'}->execute('uuid' => $uuid);
+ print "ETag is ", $instance->{'etag'}, "\n";
+
+ $instance->{'active'} = 1;
+ $instance->{'name'} = '';
+ $instance->save();
+ print "ETag is ", $instance->{'etag'}, "\n";
+
+=head1 METHODS
+
+=head2 new()
+
+ my $whc = Arvados->new( %OPTIONS );
+
+Set up a client and retrieve the schema from the server.
+
+=head3 Options
+
+=over
+
+=item apiHost
+
+Hostname of API discovery service. Default: C<arvados.local>
+
+=item apiProtocolScheme
+
+Protocol scheme. Default: C<ARVADOS_API_PROTOCOL_SCHEME> environment
+variable, or C<https>
+
+=item apiToken
+
+Authorization token. Default: C<ARVADOS_API_TOKEN> environment variable
+
+=item apiService
+
+Default C<arvados>
+
+=item apiVersion
+
+Default C<v1>
+
+=back
+
+=cut
+
+package Arvados;
+use JSON;
+use Data::Dumper;
+use IO::Socket::SSL;
+use Carp;
+use Arvados::ResourceAccessor;
+use Arvados::ResourceMethod;
+use Arvados::ResourceProxy;
+use Arvados::ResourceProxyList;
+use Arvados::Request;
+
+sub new
+{
+ my $class = shift;
+ my %self = @_;
+ my $self = \%self;
+ bless ($self, $class);
+ return $self->build(@_);
+}
+
+sub build
+{
+ my $self = shift;
+ $self->{'authToken'} ||= $ENV{'ARVADOS_API_TOKEN'};
+ $self->{'apiHost'} ||= $ENV{'ARVADOS_API_HOST'};
+ $self->{'apiProtocolScheme'} ||= $ENV{'ARVADOS_API_PROTOCOL_SCHEME'};
+
+ $self->{'ua'} = new Arvados::Request;
+
+ my $host = $self->{'apiHost'} || 'arvados';
+ my $service = $self->{'apiService'} || 'arvados';
+ my $version = $self->{'apiVersion'} || 'v1';
+ my $scheme = $self->{'apiProtocolScheme'} || 'https';
+ my $uri = "$scheme://$host/discovery/v1/apis/$service/$version/rest";
+ my $r = $self->new_request;
+ $r->set_uri($uri);
+ $r->set_method("GET");
+ $r->process_request();
+ my $data, $headers;
+ my ($status_number, $status_phrase) = $r->get_status();
+ $data = $r->get_body() if $status_number == 200;
+ $headers = $r->get_headers();
+ if ($data) {
+ my $doc = $self->{'discoveryDocument'} = JSON::decode_json($data);
+ print STDERR Dumper $doc if $ENV{'DEBUG_ARVADOS_API_DISCOVERY'};
+ my $k, $v;
+ while (($k, $v) = each %{$doc->{'resources'}}) {
+ $self->{$k} = Arvados::ResourceAccessor->new($self, $k);
+ }
+ } else {
+ croak "No discovery doc at $uri - $status_number $status_phrase";
+ }
+ $self;
+}
+
+sub new_request
+{
+ my $self = shift;
+ local $ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'};
+ if ($opts{'noVerifyHostname'} || ($host =~ /\.local$/)) {
+ $ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;
+ }
+ Arvados::Request->new();
+}
+
+1;
--- /dev/null
+package Arvados::Request;
+use Data::Dumper;
+use LWP::UserAgent;
+use URI::Escape;
+use Encode;
+use strict;
+@Arvados::HTTP::ISA = qw(LWP::UserAgent);
+
+sub new
+{
+ my $class = shift;
+ my $self = {};
+ bless ($self, $class);
+ return $self->_init(@_);
+}
+
+sub _init
+{
+ my $self = shift;
+ $self->{'ua'} = new LWP::UserAgent(@_);
+ $self->{'ua'}->agent ("libarvados-perl/".$Warehouse::VERSION);
+ $self;
+}
+
+sub set_uri
+{
+ my $self = shift;
+ $self->{'uri'} = shift;
+}
+
+sub process_request
+{
+ my $self = shift;
+ my %req;
+ $req{$self->{'method'}} = $self->{'uri'};
+ $self->{'req'} = new HTTP::Request (%req);
+ $self->{'req'}->header('Authorization' => ('OAuth2 ' . $self->{'authToken'})) if $self->{'authToken'};
+ my %content;
+ my ($p, $v);
+ while (($p, $v) = each %{$self->{'queryParams'}}) {
+ $content{$p} = (ref($v) eq "") ? $v : JSON::encode_json($v);
+ }
+ my $content;
+ while (($p, $v) = each %content) {
+ $content .= '&' unless $content eq '';
+ $content .= uri_escape($p);
+ $content .= '=';
+ $content .= uri_escape($v);
+ }
+ $self->{'req'}->content_type("application/x-www-form-urlencoded; charset='utf8'");
+ $self->{'req'}->content(Encode::encode('utf8', $content));
+ $self->{'res'} = $self->{'ua'}->request ($self->{'req'});
+}
+
+sub get_status
+{
+ my $self = shift;
+ return ($self->{'res'}->code(),
+ $self->{'res'}->message());
+}
+
+sub get_body
+{
+ my $self = shift;
+ return $self->{'res'}->content;
+}
+
+sub set_method
+{
+ my $self = shift;
+ $self->{'method'} = shift;
+}
+
+sub set_query_params
+{
+ my $self = shift;
+ $self->{'queryParams'} = shift;
+}
+
+sub set_auth_token
+{
+ my $self = shift;
+ $self->{'authToken'} = shift;
+}
+
+sub get_headers
+{
+ ""
+}
+
+1;
--- /dev/null
+package Arvados::ResourceAccessor;
+use Carp;
+use Data::Dumper;
+
+sub new
+{
+ my $class = shift;
+ my $self = {};
+ bless ($self, $class);
+
+ $self->{'api'} = shift;
+ $self->{'resourcesName'} = shift;
+ $self->{'methods'} = $self->{'api'}->{'discoveryDocument'}->{'resources'}->{$self->{'resourcesName'}}->{'methods'};
+ my $method_name, $method;
+ while (($method_name, $method) = each %{$self->{'methods'}}) {
+ $self->{$method_name} = Arvados::ResourceMethod->new($self, $method);
+ }
+ $self;
+}
+
+1;
--- /dev/null
+package Arvados::ResourceMethod;
+use Carp;
+use Data::Dumper;
+
+sub new
+{
+ my $class = shift;
+ my $self = {};
+ bless ($self, $class);
+ return $self->_init(@_);
+}
+
+sub _init
+{
+ my $self = shift;
+ $self->{'resourceAccessor'} = shift;
+ $self->{'method'} = shift;
+ return $self;
+}
+
+sub execute
+{
+ my $self = shift;
+ my $method = $self->{'method'};
+
+ my $path = $method->{'path'};
+
+ my %body_params;
+ my %given_params = @_;
+ while (my ($param_name, $param) = each %{$method->{'parameters'}}) {
+ if ($param->{'required'} && !exists $given_params{$param_name}) {
+ croak("Required parameter not supplied: $param_name");
+ }
+ elsif ($param->{'location'} eq 'path') {
+ $path =~ s/{\Q$param_name\E}/$given_params{$param_name}/eg;
+ }
+ elsif (!exists $given_params{$param_name}) {
+ ;
+ }
+ elsif ($param->{'type'} eq 'object') {
+ my %param_value;
+ my ($p, $v);
+ while (($property_name, $property) = each %{$param->{'properties'}}) {
+ if (!exists $given_params{$param_name}->{$property_name}) {
+ ;
+ }
+ elsif ($property->{'type'} eq 'boolean') {
+ $param_value{$property_name} = $given_params{$param_name}->{$property_name} ? JSON::true : JSON::false;
+ }
+ else {
+ $param_value{$property_name} = $given_params{$param_name}->{$property_name};
+ }
+ }
+ $body_params{$param_name} = \%param_value;
+ } elsif ($param->{'type'} eq 'boolean') {
+ $body_params{$param_name} = $given_params{$param_name} ? JSON::true : JSON::false;
+ } else {
+ $body_params{$param_name} = $given_params{$param_name};
+ }
+ }
+ my $r = $self->{'resourceAccessor'}->{'api'}->new_request;
+ $r->set_uri($self->{'resourceAccessor'}->{'api'}->{'discoveryDocument'}->{'baseUrl'} . "/" . $path);
+ $r->set_method($method->{'httpMethod'});
+ $r->set_auth_token($self->{'resourceAccessor'}->{'api'}->{'authToken'});
+ $r->set_query_params(\%body_params) if %body_params;
+ $r->process_request();
+ my $data, $headers;
+ my ($status_number, $status_phrase) = $r->get_status();
+ if ($status_number != 200) {
+ croak("API call failed: $status_number $status_phrase\n". $r->get_body());
+ }
+ $data = $r->get_body();
+ $headers = $r->get_headers();
+ my $result = JSON::decode_json($data);
+ if ($method->{'response'}->{'$ref'} =~ /List$/) {
+ Arvados::ResourceProxyList->new($result, $self->{'resourceAccessor'});
+ } else {
+ Arvados::ResourceProxy->new($result, $self->{'resourceAccessor'});
+ }
+}
+
+1;
--- /dev/null
+package Arvados::ResourceProxy;
+
+sub new
+{
+ my $class = shift;
+ my $self = shift;
+ $self->{'resourceAccessor'} = shift;
+ bless ($self, $class);
+ $self;
+}
+
+sub save
+{
+ my $self = shift;
+ $response = $self->{'resourceAccessor'}->{'update'}->execute('uuid' => $self->{'uuid'}, $self->resource_parameter_name() => $self);
+ foreach my $param (keys %$self) {
+ if (exists $response->{$param}) {
+ $self->{$param} = $response->{$param};
+ }
+ }
+ $self;
+}
+
+sub resource_parameter_name
+{
+ my $self = shift;
+ my $pname = $self->{'resourceAccessor'}->{'resourcesName'};
+ $pname =~ s/s$//; # XXX not a very good singularize()
+ $pname;
+}
+
+1;
--- /dev/null
+package Arvados::ResourceProxyList;
+
+sub new
+{
+ my $class = shift;
+ my $self = {};
+ bless ($self, $class);
+ $self->_init(@_);
+}
+
+sub _init
+{
+ my $self = shift;
+ $self->{'serverResponse'} = shift;
+ $self->{'resourceAccessor'} = shift;
+ $self->{'items'} = [ map { Arvados::ResourceProxy->new($_, $self->{'resourceAccessor'}) } @{$self->{'serverResponse'}->{'items'}} ];
+ $self;
+}
+
+1;