view release on metacpan or  search on metacpan

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

=head1 NAME

glacier put - upload file to a vault

=head1 SYNOPSIS

B<glacier put>
[B<-q>]
[B<-j> I<NJOBS>]
[B<--jobs=>I<NJOBS>]
[B<--quiet>]    
I<VAULT>
I<FILE> [I<FILE>...]

B<glacier put> 
{ B<-r> | B<--rename> }
[B<-q>]
[B<-j> I<NJOBS>]
[B<--jobs=>I<NJOBS>]
[B<--quiet>]    
I<VAULT>
I<FILE> I<REMOTENAME>    


=head1 DESCRIPTION

Uploads I<FILE>s to I<VAULT>.  With B<--rename> option, uploads single
I<FILE> and assings I<REMOTENAME> to the copy in the vault.

=head1 OPTION

=over 4

=item B<-q>, B<--quiet>

Don't display progress meter during multi-part uploads.

=item B<-j>, B<--jobs=>I<N>

Sets the number of concurrent jobs for multiple-part uploads.
The default is configured by the B<transfer.upload.jobs> configuration
statement.  If absent, the B<transfer.jobs> statement is used.  The
default value is 16.    

=item B<-r>, B<--rename>

Uploads single file with a different remote name.  Exactly three arguments are
expected: the name of the vault, the name of the local file to upload and the
name to assign to the remote copy.

=back    

=head1 SEE ALSO

B<glacier>(1).
    
=cut    

sub new {
    my ($class, $argref, %opts) = @_;
    $class->SUPER::new(
	$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)