File Coverage

blib/lib/Net/OpenStack/Swift.pm

Criterion	Covered	Total	%
statement	65	302	21.5
branch	6	66	9.0
condition	0	5	0.0
subroutine	13	28	46.4
pod	14	15	93.3
total	98	416	23.5

package Net::OpenStack::Swift;
use Carp;
use Mouse;
use Mouse::Util::TypeConstraints;
use JSON;
use Path::Tiny;
use Data::Validator;
use Net::OpenStack::Swift::Util qw/uri_escape uri_unescape debugf/;
use Net::OpenStack::Swift::InnerKeystone;
use namespace::clean -except => 'meta';
our $VERSION = "0.12";


subtype 'Path' => as 'Path::Tiny';
coerce  'Path' => from 'Str' => via { Path::Tiny->new($_) };


has auth_version => (is => 'rw', required => 1, default => sub { $ENV{OS_AUTH_VERSION} || "2.0"});
has auth_url     => (is => 'rw', required => 1, default => sub { $ENV{OS_AUTH_URL}    || '' });
has user         => (is => 'rw', required => 1, default => sub { $ENV{OS_USERNAME}    || '' });
has password     => (is => 'rw', required => 1, default => sub { $ENV{OS_PASSWORD}    || '' });
has tenant_name  => (is => 'rw', required => 1, default => sub { $ENV{OS_TENANT_NAME} || '' });
has storage_url  => (is => 'rw');
has token        => (is => 'rw');
has agent_options => (is => 'rw', isa => 'HashRef', default => sub{+{ timeout => 10 }});
has agent => (
    is      => 'rw',
    lazy    => 1,
    default => sub {
        my $self = shift;
        my $furl_options = +{
            timeout => $self->agent_options->{timeout} || 10
        };
        $furl_options->{agent} ||= $self->agent_options->{user_agent};
        return Furl->new(%{$furl_options});
    },
);

sub _request {
    my $self = shift;
    my $args = shift;

    my $res = $self->agent->request(
        method          => $args->{method},
        url             => $args->{url},
        special_headers => $args->{special_headers},
        headers         => $args->{header},
        write_code      => $args->{write_code},
        write_file      => $args->{write_file},
        content         => $args->{content},
    );
    return $res;
}

sub auth_keystone {
    my $self = shift;
    (my $load_version = $self->auth_version) =~ s/\./_/;
    my $ksclient = "Net::OpenStack::Swift::InnerKeystone::V${load_version}"->new(
        auth_url => $self->auth_url,
        user     => $self->user,
        password => $self->password,
        tenant_name => $self->tenant_name,
    );
    $ksclient->agent($self->agent);
    my $auth_token = $ksclient->auth();
    my $endpoint = $ksclient->service_catalog_url_for(service_type=>'object-store', endpoint_type=>'publicURL');
    croak "Not found endpoint type 'object-store'" unless $endpoint;
    $self->token($auth_token);
    $self->storage_url($endpoint);
    return 1;
}

sub get_auth {
    my $self = shift;
    $self->auth_keystone();
    return ($self->storage_url, $self->token);
}

sub get_account {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        marker         => { isa => 'Str', default => undef },
        limit          => { isa => 'Int', default => undef },
        prefix         => { isa => 'Str', default => undef },
        end_marker     => { isa => 'Str', default => undef },
    );
    my $args = $rule->validate(@_);

    # make query strings
    my @qs = ('format=json');
    if ($args->{marker}) {
        push @qs, sprintf "marker=%s", uri_escape($args->{marker});
    }
    if ($args->{limit}) {
        push @qs, sprintf("limit=%d", $args->{limit});
    }
    if ($args->{prefix}) {
        push @qs, sprintf("prefix=%s", uri_escape($args->{prefix}));
    }
    if ($args->{end_marker}) {
        push @qs, sprintf("end_marker=%s", uri_escape($args->{end_marker}));
    }

    my $request_header = ['X-Auth-Token' => $args->{token}];
    my $request_url    = sprintf "%s?%s", $args->{url}, join('&', @qs);
    debugf("get_account() request header %s", $request_header);
    debugf("get_account() request url: %s",   $request_url);

    my $res = $self->_request({
        method => 'GET', url => $request_url, header => $request_header
    });

    croak "Account GET failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("get_account() response headers %s", \@headers);
    debugf("get_account() response body %s",    $res->content);
    my %headers = @headers;
    return (\%headers, from_json($res->content));
}

sub head_account {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
    );
    my $args = $rule->validate(@_);

    my $request_header = ['X-Auth-Token' => $args->{token}];
    debugf("head_account() request header %s", $request_header);
    debugf("head_account() request url: %s",   $args->{url});

    my $res = $self->_request({
        method => 'HEAD', url => $args->{url}, header => $request_header
    });

    croak "Account HEAD failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("head_account() response headers %s", \@headers);
    debugf("head_account() response body %s",    $res->content);
    my %headers = @headers;
    return \%headers;
}

sub post_account {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        headers        => { isa => 'HashRef'},
    );
    my $args = $rule->validate(@_);
    my $request_header = ['X-Auth-Token' => $args->{token}];
    my @additional_headers = %{ $args->{headers} };
    push @{$request_header}, @additional_headers;
    my $request_url = $args->{url};
    debugf("post_account() request header %s", $request_header);
    debugf("post_account() request url: %s",   $request_url);

    my $res = $self->_request({
        method => 'POST', url => $request_url, header => $request_header
    });

    croak "Account POST failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("post_account() response headers %s", \@headers);
    debugf("post_account() response body %s",    $res->content);
    my %headers = @headers;
    return \%headers;
}

sub get_container {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
        marker         => { isa => 'Str', default => '', coerce => 1 },
        limit          => { isa => 'Int', default => 0,  coerce => 1 },
        prefix         => { isa => 'Str', default => '', coerce => 1 },
        delimiter      => { isa => 'Str', default => '', coerce => 1 },
        end_marker     => { isa => 'Str', default => '', coerce => 1 },
        full_listing   => { isa => 'Bool', default => 0, coerce => 1 },
    );
    my $args = $rule->validate(@_);

    if ($args->{full_listing}) {
        my @full_containers = ();
        my ($rv_h, $rv_c) = __PACKAGE__->new->get_container(
            url            => $args->{url},
            token          => $args->{token},
            container_name => $args->{container_name},
            marker         => $args->{marker},
            limit          => $args->{limit},
            prefix         => $args->{prefix},
            delimiter      => $args->{delimiter},
            end_marker     => $args->{end_marker},
        );
		my $total_count = int $rv_h->{'x-container-object-count'};
        my $last_n      = scalar @{$rv_c};
        if (scalar @{$rv_c}) {
            push @full_containers, @{$rv_c};
        }
		until ($total_count == scalar @full_containers) {
            # find marker
			my $marker;
			unless ($args->{delimiter}) {
				$marker = $full_containers[scalar(@full_containers) - 1]->{name};
			}
			else {
				if (exists $full_containers[scalar(@full_containers) - 1]->{name}) {
					$marker = $full_containers[scalar(@full_containers) - 1]->{name};
				}
				else {
					$marker = $full_containers[scalar(@full_containers) - 1]->{subdir};
				}
			}
            #
			my ($rv_h2, $rv_c2) = __PACKAGE__->new->get_container(
				url            => $args->{url},
				token          => $args->{token},
				container_name => $args->{container_name},
				marker         => $marker,
				limit          => $args->{limit},
				prefix         => $args->{prefix},
				delimiter      => $args->{delimiter},
				end_marker     => $args->{end_marker},
			);
			if (scalar @{$rv_c2}) {
				push @full_containers, @{$rv_c2};
			}
			else {
				last;
			}
		}
    	return ($rv_h, \@full_containers);
    }

    # make query strings
    my @qs = ('format=json');
    if ($args->{marker}) {
        push @qs, sprintf "marker=%s", uri_escape($args->{marker});
    }
    if ($args->{limit}) {
        push @qs, sprintf("limit=%d", $args->{limit});
    }
    if ($args->{prefix}) {
        push @qs, sprintf("prefix=%s", uri_escape($args->{prefix}));
    }
    if ($args->{delimiter}) {
        push @qs, sprintf("delimiter=%s", uri_escape($args->{delimiter}));
    }
    if ($args->{end_marker}) {
        push @qs, sprintf("end_marker=%s", uri_escape($args->{end_marker}));
    }

    my $request_header = ['X-Auth-Token' => $args->{token}];
    my $request_url    = sprintf "%s/%s?%s", $args->{url}, uri_escape($args->{container_name}->stringify), join('&', @qs);
    debugf("get_container() request header %s", $request_header);
    debugf("get_container() request url: %s",   $request_url);

    my $res = $self->_request({
        method => 'GET', url => $request_url, header => $request_header
    });

    croak "Container GET failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("get_container() response headers %s", \@headers);
    debugf("get_container() response body %s",    $res->content);
    my %headers = @headers;
    return (\%headers, from_json($res->content));
}

sub head_container {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
    );
    my $args = $rule->validate(@_);

    my $request_header = ['X-Auth-Token' => $args->{token}];
    my $request_url    = sprintf "%s/%s", $args->{url}, uri_escape($args->{container_name}->stringify);
    debugf("head_container() request header %s", $request_header);
    debugf("head_container() request url: %s",   $args->{url});

    my $res = $self->_request({
        method => 'HEAD', url => $request_url, header => $request_header
    });

    croak "Container HEAD failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("head_container() response headers %s", \@headers);
    debugf("head_container() response body %s",    $res->content);
    my %headers = @headers;
    return \%headers;
}

sub put_container {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
        content_length => { isa => 'Int', default => sub { 0 } },
        content_type   => { isa => 'Str', default => 'application/directory'},
    );
    my $args = $rule->validate(@_);

    my $request_header = [
        'X-Auth-Token' => $args->{token},
        'Content-Length' => $args->{content_length},
        'Content-Type'   => $args->{content_type},
    ];

    my $request_url    = sprintf "%s/%s", $args->{url}, uri_escape($args->{container_name}->stringify);
    debugf("put_account() request header %s", $request_header);
    debugf("put_account() request url: %s",   $request_url);

    my $res = $self->_request({
        method => 'PUT', url => $request_url, header => $request_header
    });

    croak "Container PUT failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("put_container() response headers %s", \@headers);
    debugf("put_container() response body %s",    $res->content);
    my %headers = @headers;
    return \%headers;
}

sub post_container {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
        headers        => { isa => 'HashRef'},
    );
    my $args = $rule->validate(@_);

    my $request_header = ['X-Auth-Token' => $args->{token}];
    unless (exists $args->{headers}->{'Content-Length'} || exists($args->{headers}->{'content-length'})) {
        $args->{headers}->{'Content-Length'} = 0;
    }
    my @additional_headers = %{ $args->{headers} };
    push @{$request_header}, @additional_headers;
    my $request_url    = sprintf "%s/%s", $args->{url}, uri_escape($args->{container_name}->stringify);
    debugf("post_container() request header %s", $request_header);
    debugf("post_container() request url: %s",   $request_url);

    my $res = $self->_request({
        method => 'POST', url => $request_url, header => $request_header
    });

    croak "Container POST failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("post_container() response headers %s", \@headers);
    debugf("post_container() response body %s",    $res->content);
    my %headers = @headers;
    return \%headers;
}

sub delete_container {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
    );
    my $args = $rule->validate(@_);

    # corecing nested path
    #$args->{container_name} = path($args->{container_name})->stringify;

    my $request_header = ['X-Auth-Token' => $args->{token}];
    my $request_url = sprintf "%s/%s", $args->{url}, uri_escape($args->{container_name}->stringify);
    debugf("delete_container() request header %s", $request_header);
    debugf("delete_container() request url: %s", $request_url);

    my $res = $self->_request({
        method => 'DELETE', url => $request_url, header => $request_header,
        content => []
    });

    croak "Container DELETE failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("delete_container() response headers %s", \@headers);
    debugf("delete_container() response body %s",    $res->content);
    my %headers = @headers;
    return \%headers;
}

sub get_object {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url },
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
        object_name    => { isa => 'Str'},
        write_file     => { isa => 'FileHandle', xor => [qw(write_code)] },
        write_code     => { isa => 'CodeRef' },
    );
    my $args = $rule->validate(@_);

    my $request_header = ['X-Auth-Token' => $args->{token}];
    my $request_url    = sprintf "%s/%s/%s", $args->{url},
        uri_escape($args->{container_name}->stringify),
        uri_escape($args->{object_name});
    my %special_headers = ('Content-Length' => undef);
    debugf("get_object() request header %s", $request_header);
    debugf("get_object() request special headers: %s", $request_url);
    debugf("get_object() request url: %s", $request_url);

    my $request_params = {
        method => 'GET', url => $request_url, header => $request_header,
        special_headers => \%special_headers,
        write_code      => undef,
        write_file      => undef,
    };
    if (exists $args->{write_code}) {
        $request_params->{write_code} = $args->{write_code};
    }
    if (exists $args->{write_file}) {
        $request_params->{write_file} = $args->{write_file};
    }
    my $res = $self->_request($request_params);

    croak "Object GET failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("get_object() response headers %s", \@headers);
    debugf("get_object() response body length %s byte", length($res->content || 0));
    my %headers = @headers;
    my $etag = $headers{etag};
    $etag =~ s/^\s*(.*?)\s*$/$1/; # delete spaces
    return $etag;
}

sub head_object {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
        object_name    => { isa => 'Str'},
    );
    my $args = $rule->validate(@_);

    my $request_header = ['X-Auth-Token' => $args->{token}];
    my $request_url    = sprintf "%s/%s/%s", $args->{url},
        uri_escape($args->{container_name}->stringify),
        uri_escape($args->{object_name});
    debugf("head_object() request header %s", $request_header);
    debugf("head_object() request url: %s", $request_url);

    my $res = $self->_request({
        method => 'HEAD', url => $request_url, header => $request_header,
        content => []
    });

    croak "Object HEAD failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("head_object() response headers %s", \@headers);
    debugf("head_object() response body %s",    $res->content);
    my %headers = @headers;
    return \%headers;
}

sub put_object {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
        object_name    => { isa => 'Str'},
        content        => { isa => 'Str|FileHandle'},
        content_length => { isa => 'Int', default => sub { 0 } },
        content_type   => { isa => 'Str', default => ''},
        etag           => { isa => 'Str', default => undef },
        query_string   => { isa => 'Str', default => sub {''} },
    );
    my $args = $rule->validate(@_);

    my $request_header = [
        'X-Auth-Token'   => $args->{token},
        'Content-Length' => $args->{content_length},
        'Content-Type'   => $args->{content_type},
    ];
    if ($args->{etag}) {
        push @{$request_header}, ('ETag' => $args->{etag});
    }

    my $request_url = sprintf "%s/%s/%s", $args->{url},
        uri_escape($args->{container_name}->stringify),
        uri_escape($args->{object_name});
    if ($args->{query_string}) {
        $request_url .= '?'.$args->{query_string};
    }
    debugf("put_object() request header %s", $request_header);
    debugf("put_object() request url: %s", $request_url);

    my $res = $self->_request({
        method => 'PUT', url => $request_url, header => $request_header, content => $args->{content}
    });

    croak "Object PUT failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("put_object() response headers %s", \@headers);
    debugf("put_object() response body %s",    $res->content);
    my %headers = @headers;
    my $etag = $headers{etag};
    $etag =~ s/^\s*(.*?)\s*$/$1/; # delete spaces
    return $etag;
}

sub post_object {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
        object_name    => { isa => 'Str'},
        headers        => { isa => 'HashRef'},
    );
    my $args = $rule->validate(@_);

    my $request_header = ['X-Auth-Token' => $args->{token}];
    my @additional_headers = %{ $args->{headers} };
    push @{$request_header}, @additional_headers;
    my $request_url    = sprintf "%s/%s/%s", $args->{url},
        uri_escape($args->{container_name}->stringify),
        uri_escape($args->{object_name});
    debugf("post_object() request header %s", $request_header);
    debugf("post_object() request url: %s",   $request_url);

    my $res = $self->_request({
        method => 'POST', url => $request_url, header => $request_header
    });

    croak "Object POST failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("post_object() response headers %s", \@headers);
    debugf("post_object() response body %s",    $res->content);
    my %headers = @headers;
    return \%headers;
}

sub delete_object {
    my $self = shift;
    my $rule = Data::Validator->new(
        url            => { isa => 'Str', default => $self->storage_url},
        token          => { isa => 'Str', default => $self->token },
        container_name => { isa => 'Path', coerce => 1 },
        object_name    => { isa => 'Str'},
    );
    my $args = $rule->validate(@_);

    my $request_header = ['X-Auth-Token' => $args->{token}];
    my $request_url = sprintf "%s/%s/%s", $args->{url},
        uri_escape($args->{container_name}->stringify),
        uri_escape($args->{object_name});
    debugf("delete_object() request header %s", $request_header);
    debugf("delete_object() request url: %s", $request_url);

    my $res = $self->_request({
        method => 'DELETE', url => $request_url, header => $request_header,
        content => []
    });

    croak "Object DELETE failed: ".$res->status_line unless $res->is_success;
    my @headers = $res->headers->flatten();
    debugf("delete_object() response headers %s", \@headers);
    debugf("delete_object() response body %s",    $res->content);
    my %headers = @headers;
    return \%headers;
}

1;
__END__