From 686f881614885a6566a566105539934ead80466f Mon Sep 17 00:00:00 2001 From: Tom Clegg Date: Tue, 8 Nov 2022 14:45:55 -0500 Subject: [PATCH] 19712: Remove perl sdk. Arvados-DCO-1.1-Signed-off-by: Tom Clegg --- .gitignore | 4 - .../centos7/Dockerfile | 2 +- build/run-build-packages-one-target.sh | 1 - build/run-build-packages.sh | 5 - build/run-library.sh | 34 ---- build/run-tests.sh | 22 +-- doc/_config.yml | 3 - doc/sdk/perl/example.html.textile.liquid | 77 -------- doc/sdk/perl/index.html.textile.liquid | 66 ------- lib/install/deps.go | 9 +- sdk/perl/.gitignore | 1 - sdk/perl/Makefile.PL | 18 -- sdk/perl/lib/Arvados.pm | 165 ------------------ sdk/perl/lib/Arvados/Request.pm | 104 ----------- sdk/perl/lib/Arvados/ResourceAccessor.pm | 25 --- sdk/perl/lib/Arvados/ResourceMethod.pm | 124 ------------- sdk/perl/lib/Arvados/ResourceProxy.pm | 61 ------- sdk/perl/lib/Arvados/ResourceProxyList.pm | 24 --- 18 files changed, 5 insertions(+), 740 deletions(-) delete mode 100644 doc/sdk/perl/example.html.textile.liquid delete mode 100644 doc/sdk/perl/index.html.textile.liquid delete mode 100644 sdk/perl/.gitignore delete mode 100644 sdk/perl/Makefile.PL delete mode 100644 sdk/perl/lib/Arvados.pm delete mode 100644 sdk/perl/lib/Arvados/Request.pm delete mode 100644 sdk/perl/lib/Arvados/ResourceAccessor.pm delete mode 100644 sdk/perl/lib/Arvados/ResourceMethod.pm delete mode 100644 sdk/perl/lib/Arvados/ResourceProxy.pm delete mode 100644 sdk/perl/lib/Arvados/ResourceProxyList.pm diff --git a/.gitignore b/.gitignore index 07482bde73..c156018036 100644 --- a/.gitignore +++ b/.gitignore @@ -14,10 +14,6 @@ doc/.site doc/sdk/python/arvados doc/sdk/R/arvados doc/sdk/java-v2/javadoc -sdk/perl/MYMETA.* -sdk/perl/Makefile -sdk/perl/blib -sdk/perl/pm_to_blib */vendor */*/vendor sdk/java/target diff --git a/build/package-build-dockerfiles/centos7/Dockerfile b/build/package-build-dockerfiles/centos7/Dockerfile index 5bae5f434c..f0ae5df3f7 100644 --- a/build/package-build-dockerfiles/centos7/Dockerfile +++ b/build/package-build-dockerfiles/centos7/Dockerfile @@ -32,7 +32,7 @@ ENV DEBIAN_FRONTEND noninteractive SHELL ["/bin/bash", "-c"] # Install dependencies. -RUN yum -q -y install make automake gcc gcc-c++ libyaml-devel patch readline-devel zlib-devel libffi-devel openssl-devel bzip2 libtool bison sqlite-devel rpm-build git perl-ExtUtils-MakeMaker libattr-devel nss-devel libcurl-devel which tar unzip scl-utils centos-release-scl postgresql-devel fuse-devel xz-libs git wget pam-devel +RUN yum -q -y install make automake gcc gcc-c++ libyaml-devel patch readline-devel zlib-devel libffi-devel openssl-devel bzip2 libtool bison sqlite-devel rpm-build git libattr-devel nss-devel libcurl-devel which tar unzip scl-utils centos-release-scl postgresql-devel fuse-devel xz-libs git wget pam-devel # Install RVM ADD generated/mpapis.asc /tmp/ diff --git a/build/run-build-packages-one-target.sh b/build/run-build-packages-one-target.sh index 7d9b5b6a37..905af1cbc6 100755 --- a/build/run-build-packages-one-target.sh +++ b/build/run-build-packages-one-target.sh @@ -232,7 +232,6 @@ if test -z "$packages" ; then keep-rsync keep-block-check keep-web - libarvados-perl libpam-arvados-go python3-cwltest python3-arvados-fuse diff --git a/build/run-build-packages.sh b/build/run-build-packages.sh index d4240d4f26..aded25b592 100755 --- a/build/run-build-packages.sh +++ b/build/run-build-packages.sh @@ -207,11 +207,6 @@ fi # Required due to CVE-2022-24765 git config --global --add safe.directory /arvados -# Perl packages -debug_echo -e "\nPerl packages\n" - -handle_libarvados_perl - # Ruby gems debug_echo -e "\nRuby gems\n" diff --git a/build/run-library.sh b/build/run-library.sh index 47c5e2a39a..c2466faac0 100755 --- a/build/run-library.sh +++ b/build/run-library.sh @@ -696,40 +696,6 @@ handle_arvados_src () { ) } -# Usage: handle_libarvados_perl -handle_libarvados_perl () { - if [[ -n "$ONLY_BUILD" ]] && [[ "$ONLY_BUILD" != "libarvados-perl" ]] ; then - debug_echo -e "Skipping build of libarvados-perl package." - return 0 - fi - # The perl sdk subdirectory is so old that it has no tag in its history, - # which causes version_at_commit.sh to fail. Just rebuild it every time. - cd "$WORKSPACE" - libarvados_perl_version="$(version_from_git)" - cd "$WORKSPACE/sdk/perl" - - cd $WORKSPACE/packages/$TARGET - test_package_presence libarvados-perl "$libarvados_perl_version" - - if [[ "$?" == "0" ]]; then - cd "$WORKSPACE/sdk/perl" - - if [[ -e Makefile ]]; then - make realclean >"$STDOUT_IF_DEBUG" - fi - find -maxdepth 1 \( -name 'MANIFEST*' -or -name "libarvados-perl*.$FORMAT" \) \ - -delete - rm -rf install - - perl Makefile.PL INSTALL_BASE=install >"$STDOUT_IF_DEBUG" && \ - make install INSTALLDIRS=perl >"$STDOUT_IF_DEBUG" && \ - fpm_build "$WORKSPACE/sdk/perl" install/lib/=/usr/share libarvados-perl \ - dir "$libarvados_perl_version" install/man/=/usr/share/man \ - "$WORKSPACE/apache-2.0.txt=/usr/share/doc/libarvados-perl/apache-2.0.txt" && \ - mv --no-clobber libarvados-perl*.$FORMAT "$WORKSPACE/packages/$TARGET/" - fi -} - # Build python packages with a virtualenv built-in # Usage: fpm_build_virtualenv arvados-python-client sdk/python [deb|rpm] [amd64|arm64] fpm_build_virtualenv () { diff --git a/build/run-tests.sh b/build/run-tests.sh index d60ff38102..a5c7277580 100755 --- a/build/run-tests.sh +++ b/build/run-tests.sh @@ -150,7 +150,6 @@ VENVDIR= VENV3DIR= PYTHONPATH= GEMHOME= -PERLINSTALLBASE= R_LIBS= export LANG=en_US.UTF-8 @@ -232,14 +231,6 @@ sanity_checks() { echo -n 'nginx: ' PATH="$PATH:/sbin:/usr/sbin:/usr/local/sbin" nginx -v \ || fatal "No nginx. Try: apt-get install nginx" - echo -n 'perl: ' - perl -v | grep version \ - || fatal "No perl. Try: apt-get install perl" - for mod in ExtUtils::MakeMaker JSON LWP Net::SSL; do - echo -n "perl $mod: " - perl -e "use $mod; print \"\$$mod::VERSION\\n\"" \ - || fatal "No $mod. Try: apt-get install perl-modules libcrypt-ssleay-perl libjson-perl libwww-perl" - done echo -n 'gitolite: ' which gitolite \ || fatal "No gitolite. Try: apt-get install gitolite3" @@ -621,7 +612,7 @@ initialize() { fi # Set up temporary install dirs (unless existing dirs were supplied) - for tmpdir in VENV3DIR GOPATH GEMHOME PERLINSTALLBASE R_LIBS + for tmpdir in VENV3DIR GOPATH GEMHOME R_LIBS do if [[ -z "${!tmpdir}" ]]; then eval "$tmpdir"="$temp/$tmpdir" @@ -633,9 +624,6 @@ initialize() { rm -vf "${WORKSPACE}/tmp/*.log" - export PERLINSTALLBASE - export PERL5LIB="$PERLINSTALLBASE/lib/perl5${PERL5LIB:+:$PERL5LIB}" - export R_LIBS export GOPATH @@ -928,12 +916,6 @@ install_sdk/R() { fi } -install_sdk/perl() { - cd "$WORKSPACE/sdk/perl" \ - && perl Makefile.PL INSTALL_BASE="$PERLINSTALLBASE" \ - && make install INSTALLDIRS=perl -} - install_sdk/cli() { install_gem arvados-cli sdk/cli } @@ -1097,7 +1079,6 @@ install_deps() { do_install env do_install cmd/arvados-server go do_install sdk/cli - do_install sdk/perl do_install sdk/python pip "${VENV3DIR}/bin/" do_install sdk/ruby do_install services/api @@ -1110,7 +1091,6 @@ install_all() { do_install doc do_install sdk/ruby do_install sdk/R - do_install sdk/perl do_install sdk/cli do_install services/login-sync for p in "${pythonstuff[@]}" diff --git a/doc/_config.yml b/doc/_config.yml index aac4256b17..35ec483887 100644 --- a/doc/_config.yml +++ b/doc/_config.yml @@ -103,9 +103,6 @@ navbar: - sdk/java-v2/index.html.textile.liquid - sdk/java-v2/example.html.textile.liquid - sdk/java-v2/javadoc.html.textile.liquid - - Perl: - - sdk/perl/index.html.textile.liquid - - sdk/perl/example.html.textile.liquid api: - Concepts: - api/index.html.textile.liquid diff --git a/doc/sdk/perl/example.html.textile.liquid b/doc/sdk/perl/example.html.textile.liquid deleted file mode 100644 index b51cfe4cb5..0000000000 --- a/doc/sdk/perl/example.html.textile.liquid +++ /dev/null @@ -1,77 +0,0 @@ ---- -layout: default -navsection: sdk -navmenu: Perl -title: "Examples" -... -{% comment %} -Copyright (C) The Arvados Authors. All rights reserved. - -SPDX-License-Identifier: CC-BY-SA-3.0 -{% endcomment %} - -h2. Initialize SDK - -Set up an API client user agent: - -{% codeblock as perl %} -use Arvados; -my $arv = Arvados->new('apiVersion' => 'v1'); -{% endcodeblock %} - -The SDK retrieves the list of API methods from the server at run time. Therefore, the set of available methods is determined by the server version rather than the SDK version. - -h2. create - -Create an object: - -{% codeblock as perl %} -my $test_link = $arv->{'links'}->{'create'}->execute('link' => { 'link_class' => 'test', 'name' => 'test' }); -{% endcodeblock %} - -h2. delete - -{% codeblock as perl %} -my $some_user = $arv->{'collections'}->{'get'}->execute('uuid' => $collection_uuid); -{% endcodeblock %} - -h2. get - -Retrieve an object by ID: - -{% codeblock as perl %} -my $some_user = $arv->{'users'}->{'get'}->execute('uuid' => $current_user_uuid); -{% endcodeblock %} - -Get the UUID of an object that was retrieved using the SDK: - -{% codeblock as perl %} -my $current_user_uuid = $current_user->{'uuid'} -{% endcodeblock %} - -h2. list - -Get a list of objects: - -{% codeblock as perl %} -my $repos = $arv->{'repositories'}->{'list'}->execute; -print ("UUID of first repo returned is ", $repos->{'items'}->[0], "\n"); -{% endcodeblock %} - -h2. update - -Update an object: - -{% codeblock as perl %} -my $test_link = $arv->{'links'}->{'update'}->execute( - 'uuid' => $test_link->{'uuid'}, - 'link' => { 'properties' => { 'foo' => 'bar' } }); -{% endcodeblock %} - -h2. Get current user - -Get the User object for the current user: - -{% codeblock as perl %} -my $current_user = $arv->{'users'}->{'current'}->execute; -{% endcodeblock %} diff --git a/doc/sdk/perl/index.html.textile.liquid b/doc/sdk/perl/index.html.textile.liquid deleted file mode 100644 index ba01352a42..0000000000 --- a/doc/sdk/perl/index.html.textile.liquid +++ /dev/null @@ -1,66 +0,0 @@ ---- -layout: default -navsection: sdk -navmenu: Perl -title: "Installation" -... -{% comment %} -Copyright (C) The Arvados Authors. All rights reserved. - -SPDX-License-Identifier: CC-BY-SA-3.0 -{% endcomment %} - -The Perl SDK provides a generic set of wrappers so you can make API calls easily. - -This is a legacy SDK. It is no longer used or maintained regularly. - -h3. Installation - -h4. Option 1: Install from distribution packages - -First, "add the appropriate package repository for your distribution":{{ site.baseurl }}/install/install-manual-prerequisites.html#repos. - -On Debian-based systems: - - -
~$ sudo apt-get install libjson-perl libio-socket-ssl-perl libwww-perl libipc-system-simple-perl libarvados-perl
-
- - -On Red Hat-based systems: - - -
~$ sudo yum install perl-ExtUtils-MakeMaker perl-JSON perl-IO-Socket-SSL perl-Crypt-SSLeay perl-WWW-Curl libarvados-perl
-
- - -h4. Option 2: Install from source - -First, install dependencies from your distribution. Refer to the package lists above, but don't install @libarvados-perl@. - -Then run the following: - - -
~$ git clone https://github.com/arvados/arvados.git
-~$ cd arvados/sdk/perl
-~$ perl Makefile.PL
-~$ sudo make install
-
- - -h3. Test installation - -If the SDK is installed, @perl -MArvados -e ''@ should produce no errors. - -If your @ARVADOS_API_HOST@ and @ARVADOS_API_TOKEN@ environment variables are set up correctly (see "api-tokens":{{site.baseurl}}/user/reference/api-tokens.html for details), the following test script should work: - - -
~$ perl <<'EOF'
-use Arvados;
-my $arv = Arvados->new('apiVersion' => 'v1');
-my $me = $arv->{'users'}->{'current'}->execute;
-print ("arvados.v1.users.current.full_name = '", $me->{'full_name'}, "'\n");
-EOF
-arvados.v1.users.current.full_name = 'Your Name'
-
- diff --git a/lib/install/deps.go b/lib/install/deps.go index e02c3743e7..06b07ec6da 100644 --- a/lib/install/deps.go +++ b/lib/install/deps.go @@ -155,17 +155,14 @@ func (inst *installCommand) RunCommand(prog string, args []string, stdin io.Read "default-jre-headless", "gettext", "libattr1-dev", - "libcrypt-ssleay-perl", "libfuse-dev", "libgbm1", // cypress / workbench2 tests "libgnutls28-dev", - "libjson-perl", "libpam-dev", "libpcre3-dev", "libpq-dev", "libreadline-dev", "libssl-dev", - "libwww-perl", "libxml2-dev", "libxslt1-dev", "linkchecker", @@ -206,11 +203,11 @@ func (inst *installCommand) RunCommand(prog string, args []string, stdin io.Read } switch { case osv.Debian && osv.Major >= 11: - pkgs = append(pkgs, "g++", "libcurl4", "libcurl4-openssl-dev", "perl-modules-5.32") + pkgs = append(pkgs, "g++", "libcurl4", "libcurl4-openssl-dev") case osv.Debian && osv.Major >= 10: - pkgs = append(pkgs, "g++", "libcurl4", "libcurl4-openssl-dev", "perl-modules") + pkgs = append(pkgs, "g++", "libcurl4", "libcurl4-openssl-dev") case osv.Debian || osv.Ubuntu: - pkgs = append(pkgs, "g++", "libcurl3", "libcurl3-openssl-dev", "perl-modules") + pkgs = append(pkgs, "g++", "libcurl3", "libcurl3-openssl-dev") case osv.Centos: pkgs = append(pkgs, "gcc", "gcc-c++", "libcurl-devel", "postgresql-devel") } diff --git a/sdk/perl/.gitignore b/sdk/perl/.gitignore deleted file mode 100644 index 7c32f55981..0000000000 --- a/sdk/perl/.gitignore +++ /dev/null @@ -1 +0,0 @@ -install diff --git a/sdk/perl/Makefile.PL b/sdk/perl/Makefile.PL deleted file mode 100644 index ec903f36ed..0000000000 --- a/sdk/perl/Makefile.PL +++ /dev/null @@ -1,18 +0,0 @@ -#! /usr/bin/perl -# Copyright (C) The Arvados Authors. All rights reserved. -# -# SPDX-License-Identifier: Apache-2.0 - -use strict; - -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'Arvados', - VERSION_FROM => 'lib/Arvados.pm', - PREREQ_PM => { - 'JSON' => 0, - 'LWP' => 0, - 'Net::SSL' => 0, - }, -); diff --git a/sdk/perl/lib/Arvados.pm b/sdk/perl/lib/Arvados.pm deleted file mode 100644 index 9eb04b4ab2..0000000000 --- a/sdk/perl/lib/Arvados.pm +++ /dev/null @@ -1,165 +0,0 @@ -# Copyright (C) The Arvados Authors. All rights reserved. -# -# SPDX-License-Identifier: Apache-2.0 - -=head1 NAME - -Arvados -- client library for Arvados services - -=head1 SYNOPSIS - - use Arvados; - $arv = Arvados->new(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 -environment variable, or C - -=item apiProtocolScheme - -Protocol scheme. Default: C environment -variable, or C - -=item authToken - -Authorization token. Default: C environment variable - -=item apiService - -Default C - -=item apiVersion - -Default C - -=back - -=cut - -package Arvados; - -use Net::SSL (); # From Crypt-SSLeay -BEGIN { - $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL"; # Force use of Net::SSL -} - -use JSON; -use Carp; -use Arvados::ResourceAccessor; -use Arvados::ResourceMethod; -use Arvados::ResourceProxy; -use Arvados::ResourceProxyList; -use Arvados::Request; -use Data::Dumper; - -$Arvados::VERSION = 0.1; - -sub new -{ - my $class = shift; - my %self = @_; - my $self = \%self; - bless ($self, $class); - return $self->build(@_); -} - -sub build -{ - my $self = shift; - - $config = load_config_file("$ENV{HOME}/.config/arvados/settings.conf"); - - $self->{'authToken'} ||= - $ENV{ARVADOS_API_TOKEN} || $config->{ARVADOS_API_TOKEN}; - - $self->{'apiHost'} ||= - $ENV{ARVADOS_API_HOST} || $config->{ARVADOS_API_HOST}; - - $self->{'noVerifyHostname'} ||= - $ENV{ARVADOS_API_HOST_INSECURE}; - - $self->{'apiProtocolScheme'} ||= - $ENV{ARVADOS_API_PROTOCOL_SCHEME} || - $config->{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 ($self->{'noVerifyHostname'} || ($host =~ /\.local$/)) { - $ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0; - } - Arvados::Request->new(); -} - -sub load_config_file ($) -{ - my $config_file = shift; - my %config; - - if (open (CONF, $config_file)) { - while () { - next if /^\s*#/ || /^\s*$/; # skip comments and blank lines - chomp; - my ($key, $val) = split /\s*=\s*/, $_, 2; - $config{$key} = $val; - } - } - close CONF; - return \%config; -} - -1; diff --git a/sdk/perl/lib/Arvados/Request.pm b/sdk/perl/lib/Arvados/Request.pm deleted file mode 100644 index 4523f7d6b3..0000000000 --- a/sdk/perl/lib/Arvados/Request.pm +++ /dev/null @@ -1,104 +0,0 @@ -# Copyright (C) The Arvados Authors. All rights reserved. -# -# SPDX-License-Identifier: Apache-2.0 - -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/".$Arvados::VERSION); - $self; -} - -sub set_uri -{ - my $self = shift; - $self->{'uri'} = shift; -} - -sub process_request -{ - my $self = shift; - my %req; - my %content; - my $method = $self->{'method'}; - if ($method eq 'GET' || $method eq 'HEAD') { - $content{'_method'} = $method; - $method = 'POST'; - } - $req{$method} = $self->{'uri'}; - $self->{'req'} = new HTTP::Request (%req); - $self->{'req'}->header('Authorization' => ('OAuth2 ' . $self->{'authToken'})) if $self->{'authToken'}; - $self->{'req'}->header('Accept' => 'application/json'); - - # allow_nonref lets us encode JSON::true and JSON::false, see #12078 - my $json = JSON->new->allow_nonref; - my ($p, $v); - while (($p, $v) = each %{$self->{'queryParams'}}) { - $content{$p} = (ref($v) eq "") ? $v : $json->encode($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 deleted file mode 100644 index 8b235fc863..0000000000 --- a/sdk/perl/lib/Arvados/ResourceAccessor.pm +++ /dev/null @@ -1,25 +0,0 @@ -# Copyright (C) The Arvados Authors. All rights reserved. -# -# SPDX-License-Identifier: Apache-2.0 - -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 deleted file mode 100644 index d7e86ffdd8..0000000000 --- a/sdk/perl/lib/Arvados/ResourceMethod.pm +++ /dev/null @@ -1,124 +0,0 @@ -# Copyright (C) The Arvados Authors. All rights reserved. -# -# SPDX-License-Identifier: Apache-2.0 - -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 = @_; - my %extra_params = %given_params; - my %method_params = %{$method->{'parameters'}}; - if ($method->{'request'}->{'properties'}) { - while (my ($prop_name, $prop_value) = - each %{$method->{'request'}->{'properties'}}) { - if (ref($prop_value) eq 'HASH' && $prop_value->{'$ref'}) { - $method_params{$prop_name} = { 'type' => 'object' }; - } - } - } - while (my ($param_name, $param) = each %method_params) { - delete $extra_params{$param_name}; - 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); - if (exists $param->{'properties'}) { - while (my ($property_name, $property) = - each %{$param->{'properties'}}) { - # if the discovery doc specifies object structure, - # convert to true/false depending on supplied type - if (!exists $given_params{$param_name}->{$property_name}) { - ; - } - elsif (!defined $given_params{$param_name}->{$property_name}) { - $param_value{$property_name} = JSON::null; - } - 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}; - } - } - } - else { - while (my ($property_name, $property) = - each %{$given_params{$param_name}}) { - if (ref $property eq '' || $property eq undef) { - $param_value{$property_name} = $property; - } - elsif (ref $property eq 'HASH') { - $param_value{$property_name} = {}; - while (my ($k, $v) = each %$property) { - $param_value{$property_name}->{$k} = $v; - } - } - } - } - $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}; - } - } - if (%extra_params) { - croak("Unsupported parameter(s) passed to API call /$path: \"" . join('", "', keys %extra_params) . '"'); - } - my $r = $self->{'resourceAccessor'}->{'api'}->new_request; - my $base_uri = $self->{'resourceAccessor'}->{'api'}->{'discoveryDocument'}->{'baseUrl'}; - $base_uri =~ s:/$::; - $r->set_uri($base_uri . "/" . $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 /$path 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 deleted file mode 100644 index d3be46812e..0000000000 --- a/sdk/perl/lib/Arvados/ResourceProxy.pm +++ /dev/null @@ -1,61 +0,0 @@ -# Copyright (C) The Arvados Authors. All rights reserved. -# -# SPDX-License-Identifier: Apache-2.0 - -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 update_attributes -{ - my $self = shift; - my %updates = @_; - $response = $self->{'resourceAccessor'}->{'update'}->execute('uuid' => $self->{'uuid'}, $self->resource_parameter_name() => \%updates); - foreach my $param (keys %updates) { - if (exists $response->{$param}) { - $self->{$param} = $response->{$param}; - } - } - $self; -} - -sub reload -{ - my $self = shift; - $response = $self->{'resourceAccessor'}->{'get'}->execute('uuid' => $self->{'uuid'}); - 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 deleted file mode 100644 index 7d8e1874aa..0000000000 --- a/sdk/perl/lib/Arvados/ResourceProxyList.pm +++ /dev/null @@ -1,24 +0,0 @@ -# Copyright (C) The Arvados Authors. All rights reserved. -# -# SPDX-License-Identifier: Apache-2.0 - -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