view release on metacpan or  search on metacpan

lib/App/Glacier/Directory.pm  view on Meta::CPAN

sub add_version {
    my ($self, $file_name, $val) = @_;
    my $rec = $self->retrieve($file_name);
    my $i;
    if ($rec) {
	my $t = $val->{CreationDate}->epoch;
	for ($i = 0; $i <= $#{$rec}; $i++) {
	    last if $t >= $rec->[$i]{CreationDate}->epoch;
	}
	splice(@{$rec}, $i, 0, $val);
    } else {
	$i = 0;
	$rec = [ $val ];
    }
    $self->SUPER::store($file_name, $rec);
    return $i + 1;
}

sub delete_version {
    my ($self, $file_name, $ver) = @_;
    $ver--;
    my $rec = $self->retrieve($file_name);
    if ($rec && $ver <= $#{$rec}) {
	splice(@{$rec}, $ver, 1);
	if (@{$rec}) {
	    $self->SUPER::store($file_name, $rec);
	} else {
	    $self->delete($file_name);
	}
    } else {
	++$ver;
	croak "can't remove $file_name;$ver: no such version";
    }
}

sub tempname {
    my ($self, $namelen) = @_;
    $namelen = 10 unless defined $namelen; 
    my @alphabet =
	split //,
	      '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
    my @name;

    for (my $i = 0; $i < $namelen; $i++) {
	push @name, rand($#alphabet);
    }
    my @orig = @name;
    my $s;
    while ($self->has($s = 'TMP_'.join('', map { $alphabet[$_] } @name))) {
	for (my $i = 0; ; $i++) {
	    die "all permutations exhausted" if ($i > $namelen);
	    $name[$i] = ($name[$i] + 1) % @alphabet;
	    last if $name[$i] != $orig[$i];
	}
    }
    return $s;
}

use constant {
    DIR_UPTODATE => 0,  # Directory is up to date
    DIR_PENDING  => 1,  # Directory is empty, needs synchronization
    DIR_OUTDATED => 2   # Directory needs update
};

sub status {
    my ($self) = @_;
    
    if (defined($self->last_sync_time)) {
	my $dsc = timestamp_deserialize($self->glacier->Describe_vault($self->vault));
	unless ($dsc
		&& $dsc->{LastInventoryDate}->epoch < $self->last_sync_time) {
	    return DIR_OUTDATED;
	}
    } else {
	return DIR_PENDING;
    }
    return DIR_UPTODATE;
}

1;