view release on metacpan or  search on metacpan

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

	$argref,
	optmap => {
	    'jobs|j=i' => 'jobs',
	    'quiet|q' => 'quiet',
	    'rename|r' => 'rename'
	}, %opts);
}

sub run {
    my $self = shift;
    if ($self->{_options}{rename}) {
	$self->abend(EX_USAGE, "exactly three arguments expected")
	    unless $self->command_line == 3;
	my ($vaultname, $localname, $remotename) = $self->command_line;
	$self->_upload($vaultname, $localname, $remotename);
    } else {
	my @argv = $self->command_line;
	$self->abend(EX_USAGE, "too few arguments") if @argv < 2;
	my $vaultname = shift @argv;
	my @failed_uploads;
	foreach my $filename (@argv) {
	    eval {
		$self->_upload($vaultname, $filename);
	    };
	    if ($@) {
		if ($@ =~ /^__UPLOAD_FAILED__/) {
		    push @failed_uploads, $filename;
		    next
		}
		die $@;
	    }
	}
	if (@failed_uploads) {
	    if (@failed_uploads == @argv) {
		exit(EX_FAILURE);
	    } else {
		$self->error("the following files failed to upload: "
			     . join(', ', @failed_uploads));
		exit(EX_UNAVAILABLE);
	    }
	}
    }
}

sub abend {
    my ($self, $code, @msg) = @_;
    $self->error(@msg);
    if ($self->{_options}{multiple}) {
	die "__UPLOAD_FAILED__";
    } else {
	exit $code;
    }
}

sub _upload {
    my ($self, $vaultname, $localname, $remotename) = @_;

    $remotename = basename($localname) unless defined($remotename);

    my $st = stat($localname)
	or $self->abend(EX_NOINPUT, "can't stat \"$localname\": $!");
    unless (S_ISREG($st->mode)) {
	$self->abend(EX_NOPERM, "\"$localname\" is not a regular file");
    }
    my $size = $st->size;
    if ($size == 0) {
	$self->abend(EX_NOPERM, "\"$localname\": file has zero size");
    }
    
    my $dir = $self->directory($vaultname);
    my $id = ($size < $self->cf_transfer_param(qw(upload single-part-size)))
	       ? $self->_upload_simple($vaultname, $localname, $remotename)
               : $self->_upload_multipart($vaultname, $localname, $remotename);
    return if $self->dry_run;
    $self->debug(1, "ID $id\n");
    $dir->add_version($remotename, { ArchiveId => $id,
				     Size => $size,
				     CreationDate => new App::Glacier::DateTime,
				     ArchiveDescription => $remotename });
}

sub _upload_simple {
    my ($self, $vaultname, $localname, $remotename) = @_;

    $self->debug(1, "uploading $localname in single part");
    return if $self->dry_run;

    my $p = new App::Glacier::Progress(1,
				       prefix => $localname,
				       show_none => 1)
	unless $self->{_options}{quiet};
    my $archive_id = $self->glacier->Upload_archive($vaultname, $localname,
						    $remotename);	
    $p->finish('uploaded') if $p;
    
    if ($self->glacier->lasterr) {
	$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}