view release on metacpan or  search on metacpan

lib/Brackup/Target/Riak.pm  view on Meta::CPAN

    my $n_fails = 0;
    while ($n_fails < 5) {
        $obj = $sub->();
        last if $ok->($obj);

        $n_fails++;
        warn "Error $op ... will do retry \#$n_fails in 5 seconds ...\n";
        sleep 5;
    }

    return $obj;
}

sub _load {
    my ($self, $type, $key) = @_;

    my $bucket = $self->{bucket}->{$type} or die "Invalid type '$type'";
    my $content_type = $self->{content_type}->{$type};

    my $obj = $self->_retry("loading $type $key", sub { $bucket->get($key) });

    return unless $obj->exists;
    return unless $obj->content_type eq $content_type;

    return $obj;
}

sub has_chunk {
    my ($self, $chunk) = @_;
    my $dig = $chunk->backup_digest;   # "sha1:sdfsdf" format scalar

    eval { $self->_load(chunk => $dig) } or return 0;

    return 1;
}

sub load_chunk {
    my ($self, $dig) = @_;

    my $obj = $self->_load(chunk => $dig) or return;

    return \ $obj->data;
}

sub _store {
    my ($self, $type, $key, $data) = @_;

    my $bucket = $self->{bucket}->{$type} or die "Invalid type '$type'";
    my $content_type = $self->{content_type}->{$type};

    my $sub = sub {
        my $obj = $bucket->new_object($key, $data,
            content_type  => $content_type,
        );
        $obj->store;
    };

    my $obj = $self->_retry("storing $type $key", $sub);

    unless ($obj->exists) {
        warn "Error uploading chunk again: " . $obj->status . "\n";
        return 0;
    }
    return 1;
}

sub store_chunk {
    my ($self, $chunk) = @_;
    my $dig = $chunk->backup_digest;
    my $fh = $chunk->chunkref;
    my $chunkref = do { local $/; <$fh> };

    return $self->_store(chunk => $dig, $chunkref);
}

sub delete_chunk {
    my ($self, $dig) = @_;

    my $obj = $self->_load(chunk => $dig) or return;

    $obj->delete;
}

# returns a list of names of all chunks
sub chunks {
    my $self = shift;

    my $chunks = $self->_retry("loading chunks", 
        sub { $self->{bucket}->{chunk}->get_keys({stream => 1}) },
        sub { my $chunks = shift; $chunks && ref $chunks eq 'ARRAY' },
    );

    return unless $chunks;
    return @$chunks;
}

sub store_backup_meta {
    my ($self, $name, $fh) = @_;
    my $content = do { local $/; <$fh> };

    return $self->_store(backup => $name, $content);
}

sub backups {
    my $self = shift;

    my $backups = $self->_retry("loading backups", 
        sub { $self->{bucket}->{backup}->get_keys({stream => 1}) },
        sub { my $backups = shift; $backups && ref $backups eq 'ARRAY' },
    );

    my @ret = ();
    foreach my $backup (@$backups) {
        # Riak has no explicit mtime/size metadata
        my @elements = split /-/, $backup;
        push @ret, Brackup::TargetBackupStatInfo->new($self, $backup,
                                                      time => $elements[$#elements],
                                                      size => 0);
    }

    return @ret;