From 380b40be6a008c627083c81a1eb684a78c64aa93 Mon Sep 17 00:00:00 2001 From: Tom Clegg Date: Wed, 15 May 2013 20:20:49 -0700 Subject: [PATCH] start Perl SDK --- sdk/perl/lib/Arvados.pm | 124 ++++++++++++++++++++++ sdk/perl/lib/Arvados/Request.pm | 91 ++++++++++++++++ sdk/perl/lib/Arvados/ResourceAccessor.pm | 21 ++++ sdk/perl/lib/Arvados/ResourceMethod.pm | 82 ++++++++++++++ sdk/perl/lib/Arvados/ResourceProxy.pm | 32 ++++++ sdk/perl/lib/Arvados/ResourceProxyList.pm | 20 ++++ 6 files changed, 370 insertions(+) create mode 100644 sdk/perl/lib/Arvados.pm create mode 100644 sdk/perl/lib/Arvados/Request.pm create mode 100644 sdk/perl/lib/Arvados/ResourceAccessor.pm create mode 100644 sdk/perl/lib/Arvados/ResourceMethod.pm create mode 100644 sdk/perl/lib/Arvados/ResourceProxy.pm create mode 100644 sdk/perl/lib/Arvados/ResourceProxyList.pm diff --git a/sdk/perl/lib/Arvados.pm b/sdk/perl/lib/Arvados.pm new file mode 100644 index 0000000000..39a49dea88 --- /dev/null +++ b/sdk/perl/lib/Arvados.pm @@ -0,0 +1,124 @@ +=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 + +=item apiProtocolScheme + +Protocol scheme. Default: C environment +variable, or C + +=item apiToken + +Authorization token. Default: C environment variable + +=item apiService + +Default C + +=item apiVersion + +Default C + +=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; diff --git a/sdk/perl/lib/Arvados/Request.pm b/sdk/perl/lib/Arvados/Request.pm new file mode 100644 index 0000000000..4902b75c37 --- /dev/null +++ b/sdk/perl/lib/Arvados/Request.pm @@ -0,0 +1,91 @@ +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; diff --git a/sdk/perl/lib/Arvados/ResourceAccessor.pm b/sdk/perl/lib/Arvados/ResourceAccessor.pm new file mode 100644 index 0000000000..73600ca844 --- /dev/null +++ b/sdk/perl/lib/Arvados/ResourceAccessor.pm @@ -0,0 +1,21 @@ +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; diff --git a/sdk/perl/lib/Arvados/ResourceMethod.pm b/sdk/perl/lib/Arvados/ResourceMethod.pm new file mode 100644 index 0000000000..392251f48f --- /dev/null +++ b/sdk/perl/lib/Arvados/ResourceMethod.pm @@ -0,0 +1,82 @@ +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; diff --git a/sdk/perl/lib/Arvados/ResourceProxy.pm b/sdk/perl/lib/Arvados/ResourceProxy.pm new file mode 100644 index 0000000000..e6a87764a2 --- /dev/null +++ b/sdk/perl/lib/Arvados/ResourceProxy.pm @@ -0,0 +1,32 @@ +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; diff --git a/sdk/perl/lib/Arvados/ResourceProxyList.pm b/sdk/perl/lib/Arvados/ResourceProxyList.pm new file mode 100644 index 0000000000..6bba20878e --- /dev/null +++ b/sdk/perl/lib/Arvados/ResourceProxyList.pm @@ -0,0 +1,20 @@ +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; -- 2.30.2