start Perl SDK
authorTom Clegg <tom@clinicalfuture.com>
Thu, 16 May 2013 03:20:49 +0000 (20:20 -0700)
committerTom Clegg <tom@clinicalfuture.com>
Thu, 16 May 2013 03:20:49 +0000 (20:20 -0700)
sdk/perl/lib/Arvados.pm [new file with mode: 0644]
sdk/perl/lib/Arvados/Request.pm [new file with mode: 0644]
sdk/perl/lib/Arvados/ResourceAccessor.pm [new file with mode: 0644]
sdk/perl/lib/Arvados/ResourceMethod.pm [new file with mode: 0644]
sdk/perl/lib/Arvados/ResourceProxy.pm [new file with mode: 0644]
sdk/perl/lib/Arvados/ResourceProxyList.pm [new file with mode: 0644]

diff --git a/sdk/perl/lib/Arvados.pm b/sdk/perl/lib/Arvados.pm
new file mode 100644 (file)
index 0000000..39a49de
--- /dev/null
@@ -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<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;
diff --git a/sdk/perl/lib/Arvados/Request.pm b/sdk/perl/lib/Arvados/Request.pm
new file mode 100644 (file)
index 0000000..4902b75
--- /dev/null
@@ -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 (file)
index 0000000..73600ca
--- /dev/null
@@ -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 (file)
index 0000000..392251f
--- /dev/null
@@ -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 (file)
index 0000000..e6a8776
--- /dev/null
@@ -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 (file)
index 0000000..6bba208
--- /dev/null
@@ -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;