view release on metacpan or  search on metacpan

lib/Kubernetes/REST.pm  view on Meta::CPAN

    my $class = $self->expand_class($short_class);
    my $path = $self->_build_path($class, %args);

    my %params;
    $params{labelSelector} = $label_selector if defined $label_selector;
    $params{fieldSelector} = $field_selector if defined $field_selector;

    my $response = %params
        ? $self->_request('GET', $path, undef, parameters => \%params)
        : $self->_request('GET', $path);
    $self->_check_response($response, "list $short_class");

    return $self->_inflate_list($class, $response);
}

sub get {
    my ($self, $short_class, @rest) = @_;


    # Support: get('Kind', 'name'), get('Kind', 'name', namespace => 'ns'),
    #          get('Kind', name => 'name'), get('Kind', name => 'name', namespace => 'ns')
    my %args;
    if (@rest == 1) {
        $args{name} = $rest[0];
    } elsif (@rest >= 2 && $rest[0] !~ /^(name|namespace)$/) {
        # First arg is name, rest are key=value pairs
        $args{name} = shift @rest;
        %args = (%args, @rest);
    } elsif (@rest % 2 == 0) {
        %args = @rest;
    } else {
        croak "Invalid arguments to get()";
    }

    my $class = $self->expand_class($short_class);
    croak "name required for get" unless $args{name};

    my $path = $self->_build_path($class, %args);
    my $response = $self->_request('GET', $path);
    $self->_check_response($response, "get $short_class");

    return $self->_inflate_object($class, $response);
}

sub create {
    my ($self, $object) = @_;


    my $class = ref($object);
    my $namespace = $object->can('metadata') && $object->metadata
        ? $object->metadata->namespace
        : undef;

    my $path = $self->_build_path($class, namespace => $namespace);
    my $response = $self->_request('POST', $path, $object->TO_JSON);
    $self->_check_response($response, "create " . ref($object));

    return $self->_inflate_object($class, $response);
}

sub update {
    my ($self, $object) = @_;


    my $class = ref($object);
    my $metadata = $object->metadata or croak "object must have metadata";
    my $name = $metadata->name or croak "object must have metadata.name";
    my $namespace = $metadata->namespace;

    my $path = $self->_build_path($class, name => $name, namespace => $namespace);
    my $response = $self->_request('PUT', $path, $object->TO_JSON);
    $self->_check_response($response, "update " . ref($object));

    return $self->_inflate_object($class, $response);
}

my %PATCH_TYPES = (
    strategic => 'application/strategic-merge-patch+json',
    merge     => 'application/merge-patch+json',
    json      => 'application/json-patch+json',
);

# Shared argument unpacking for patch() and patch_status(): accepts either a
# blessed object or a class plus name, in both the shorthand
# (patch('Pod', 'name', ...)) and the fully keyed (patch('Pod', name => ...))
# call form. $label only appears in croak messages, $default_type is the patch
# strategy used when the caller does not pass one.
sub _unpack_patch_args {
    my ($self, $label, $default_type, $class_or_object, @rest) = @_;

    my ($class, $name, $namespace, $patch, $patch_type);

    if (ref($class_or_object) && blessed($class_or_object)) {
        # Object passed: patch($object, patch => {...})
        my $object = $class_or_object;
        $class = ref($object);
        my $metadata = $object->metadata or croak "object must have metadata";
        $name = $metadata->name or croak "object must have metadata.name";
        $namespace = $metadata->namespace;
        my %args = @rest;
        $patch = $args{patch} // croak "$label requires 'patch' parameter";
        $patch_type = $args{type} // $default_type;
    } else {
        # Class + name: patch('Pod', 'name', namespace => 'ns', patch => {...})
        my %args;
        if (@rest >= 1 && !ref($rest[0]) && $rest[0] !~ /^(name|namespace|patch|type)$/) {
            $args{name} = shift @rest;
            %args = (%args, @rest);
        } elsif (@rest % 2 == 0) {
            %args = @rest;
        } else {
            croak "Invalid arguments to $label()";
        }

        $class = $self->expand_class($class_or_object);
        $name = $args{name} or croak "name required for $label";
        $namespace = $args{namespace};
        $patch = $args{patch} // croak "$label requires 'patch' parameter";
        $patch_type = $args{type} // $default_type;
    }

    my $content_type = $PATCH_TYPES{$patch_type}
        // croak "Unknown patch type '$patch_type' (use: strategic, merge, json)";

    return ($class, $name, $namespace, $patch, $content_type);
}

sub patch {
    my ($self, $class_or_object, @rest) = @_;


    my ($class, $name, $namespace, $patch, $content_type)
        = $self->_unpack_patch_args('patch', 'strategic', $class_or_object, @rest);

    my $path = $self->_build_path($class, name => $name, namespace => $namespace);
    my $response = $self->_request('PATCH', $path, $patch,
        content_type => $content_type);
    $self->_check_response($response, "patch $class");

    return $self->_inflate_object($class, $response);
}

sub patch_status {
    my ($self, $class_or_object, @rest) = @_;


    my ($class, $name, $namespace, $patch, $content_type)
        = $self->_unpack_patch_args('patch_status', 'merge', $class_or_object, @rest);

    my $path = $self->_build_path($class,
        name        => $name,
        namespace   => $namespace,
        subresource => 'status',
    );
    my $response = $self->_request('PATCH', $path, $patch,
        content_type => $content_type);
    $self->_check_response($response, "patch_status $class");

    return $self->_inflate_object($class, $response);
}

sub update_status {
    my ($self, $object) = @_;


    my $class = ref($object);
    my $metadata = $object->metadata or croak "object must have metadata";
    my $name = $metadata->name or croak "object must have metadata.name";
    my $namespace = $metadata->namespace;

    my $path = $self->_build_path($class,
        name        => $name,
        namespace   => $namespace,
        subresource => 'status',
    );
    my $response = $self->_request('PUT', $path, $object->TO_JSON);
    $self->_check_response($response, "update_status " . ref($object));

    return $self->_inflate_object($class, $response);
}

sub delete {
    my ($self, $class_or_object, @rest) = @_;


    my ($class, $name, $namespace);

    if (ref($class_or_object)) {
        # Object passed
        my $object = $class_or_object;
        $class = ref($object);
        my $metadata = $object->metadata or croak "object must have metadata";
        $name = $metadata->name or croak "object must have metadata.name";
        $namespace = $metadata->namespace;
    } else {
        # Support: delete('Kind', 'name'), delete('Kind', 'name', namespace => 'ns'),
        #          delete('Kind', name => 'name'), delete('Kind', name => 'name', namespace => 'ns')
        my %args;
        if (@rest == 1) {
            $args{name} = $rest[0];
        } elsif (@rest >= 2 && $rest[0] !~ /^(name|namespace)$/) {
            # First arg is name, rest are key=value pairs
            $args{name} = shift @rest;
            %args = (%args, @rest);
        } elsif (@rest % 2 == 0) {
            %args = @rest;
        } else {
            croak "Invalid arguments to delete()";
        }

        $class = $self->expand_class($class_or_object);
        $name = $args{name} or croak "name required for delete";
        $namespace = $args{namespace};
    }

    my $path = $self->_build_path($class, name => $name, namespace => $namespace);
    my $response = $self->_request('DELETE', $path);
    $self->_check_response($response, "delete $class");

    return 1;
}