App-Glacier

 view release on metacpan or  search on metacpan

lib/App/Glacier/Command/Get.pm  view on Meta::CPAN

package App::Glacier::Command::Get;
use strict;
use warnings;
use threads;
use threads::shared;
use App::Glacier::Core;
use App::Glacier::Job::FileRetrieval;
use App::Glacier::DateTime;
use App::Glacier::Progress;
use parent qw(App::Glacier::Command);
use Carp;
use Scalar::Util;
use File::Copy;

=head1 NAME

lib/App/Glacier/Command/Get.pm  view on Meta::CPAN

    return if $self->dry_run;

    use Fcntl qw(SEEK_SET);

    my $fd = $self->_open_output($localname);
    my @part_hashes :shared = ();
    my $p = new App::Glacier::Progress($total_parts,
				       prefix => $localname)
	unless $self->{_options}{quiet};
    for (my $i = 0; $i < $njobs; $i++) {
	my ($thr) = threads->create(
	    sub {
		my ($job_idx) = @_;
		# Number of part to start from
		my $part_idx = $job_idx * $job_parts;
		# Offset in file
		my $off = $part_idx * $part_size;
		# Number of retries in case of failure
		my $retries = $self->cf_transfer_param(qw(download retries));
		Scalar::Util::weaken($p);
		for (my $j = 0; $j < $job_parts;

lib/App/Glacier/Command/Get.pm  view on Meta::CPAN

		    seek($fd, $off, SEEK_SET);
		    syswrite($fd, $res);
		    $part_hashes[$part_idx] = $hash;
		    $p->update if $p;
		}
		return 1;
	    }, $i);
    }
    
    $self->debug(2, "waiting for download to finish");
    foreach my $thr (threads->list()) {
	# FIXME: error handling
	$thr->join() or croak "thread $thr failed";
    }
    $p->finish('downloaded') if $p;
    close($fd);
    return $glacier->_tree_hash_from_array_ref(\@part_hashes);
}
    
1;

lib/App/Glacier/Command/Put.pm  view on Meta::CPAN

	$self->abend(EX_FAILURE, "upload failed: ",
		     $self->glacier->last_error_message);
    }
    return $archive_id;
}

sub _upload_multipart {
    my ($self, $vaultname, $localname, $remotename) = @_;
    my $glacier = $self->glacier;
    
    use threads;
    use threads::shared;

    my $archive_size = -s $localname;
    my $part_size =
	$glacier->calculate_multipart_upload_partsize($archive_size);
    
    $self->abend(EX_FAILURE, "$localname is too big for upload")
	if $part_size == 0;

    # Number of parts to upload:
    my $total_parts = int(($archive_size + $part_size - 1) / $part_size);
    
    # Compute number of threads
    my $njobs = $self->{_options}{jobs}
                || $self->cf_transfer_param(qw(upload jobs));

    # Number of parts to upload by each job;
    my $job_parts = int(($total_parts + $njobs - 1) / $njobs);
    
    $self->debug(1,
	 "uploading $localname in chunks of $part_size bytes, in $njobs jobs");
    return if $self->dry_run;
    

lib/App/Glacier/Command/Put.pm  view on Meta::CPAN

    $self->debug(1, "Upload ID: $upload_id");

    use Fcntl qw(SEEK_SET);
    
    my @part_hashes :shared = ();
    my $p = new App::Glacier::Progress($total_parts,
				       prefix => $localname)
	unless $self->{_options}{quiet};
    
    for (my $i = 0; $i < $njobs; $i++) {
	my $thr = threads->create(
	    sub {
		my ($job_idx) = @_;
		# Number of part to start from
		my $part_idx = $job_idx * $job_parts;
		# Offset in file
		my $off = $part_idx * $part_size;
		# Number of retries in case of failure
		my $retries = $self->cf_transfer_param(qw(upload retries));
		
		for (my $j = 0; $j < $job_parts;

lib/App/Glacier/Command/Put.pm  view on Meta::CPAN

		    }
			
		    $part_hashes[$part_idx] = $res;
		    $p->update if $p;		    
		}
		return 1;
	    }, $i);
    }    

    $self->debug(2, "waiting for dowload to finish");
    foreach my $thr (threads->list) {
	# FIXME: better error handling
	$thr->join() or croak "thread $thr failed";
    }
    $p->finish('uploaded') if $p;
    
    # Capture archive id or error code
    $self->debug(2, "finalizing the upload");
    my $archive_id = $glacier->Multipart_upload_complete(
					 $vaultname, $upload_id,
					 \@part_hashes,
					 $archive_size);

lib/App/Glacier/DB/GDBM.pm  view on Meta::CPAN

package App::Glacier::DB::GDBM;
use strict;
use warnings;
use GDBM_File;
use Carp;
use File::Basename;
use File::Path qw(make_path);

# Avoid coredumps in threaded code.
# See https://rt.perl.org/Public/Bug/Display.html?id=61912.
sub CLONE_SKIP { 1 }

sub new {
    my $class = shift;
    local %_ = @_;
    my $file = delete $_{file} // croak "filename is required";
    unless (-f $file) {
	if (defined(my $create = delete $_{create})) {
	    if (ref($create) eq 'CODE') {

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

package App::Glacier::Progress;
use strict;
use warnings;
use Exporter;
use parent qw(Exporter);
use Term::ReadKey;
use POSIX qw(isatty);
use Carp;
use threads;
use threads::shared;

# new(NUMBER)
sub new {
    my ($class, $total, %opts) = @_;
    croak "argument can't be 0" unless $total > 0;
    my $self = bless {
	_total => $total,
	_digits => int(log($total) / log(10) + 1),
	_current => 0,
    }, $class;