view release on metacpan or  search on metacpan

lib/Amazon/S3/Bucket.pm  view on Meta::CPAN

    },
  );

  return $location
    if $location;

  croak $account->errstr
    if $account->_remember_errors($location);

  return;
}

########################################################################
sub last_response {
########################################################################
  my ($self) = @_;

  return $self->account->last_response;
}

########################################################################
sub err {
########################################################################
  my ($self) = @_;

  return $self->account->err;
}

########################################################################
sub errstr {
########################################################################
  my ($self) = @_;

  return $self->account->errstr;
}

########################################################################
sub error {
########################################################################
  my ($self) = @_;

  return $self->account->error;
}

########################################################################
sub _content_sub {
########################################################################
  my ( $filename, $buffer_size ) = @_;

  my $stat = stat $filename;

  my $remaining = $stat->size;
  my $blksize   = $stat->blksize || $buffer_size;

  croak "$filename not a readable file with fixed size"
    if !-r $filename || !$remaining;

  my $fh = IO::File->new( $filename, 'r' )
    or croak "Could not open $filename: $OS_ERROR";

  $fh->binmode;

  return sub {
    my $buffer;

    # upon retries the file is closed and we must reopen it
    if ( !$fh->opened ) {
      $fh = IO::File->new( $filename, 'r' )
        or croak "Could not open $filename: $OS_ERROR";

      $fh->binmode;

      $remaining = $stat->size;
    }

    my $read = $fh->read( $buffer, $blksize );

    if ( !$read ) {
      croak
        "Error while reading upload content $filename ($remaining remaining) $OS_ERROR"
        if $OS_ERROR and $remaining;

      $fh->close # otherwise, we found EOF
        or croak "close of upload content $filename failed: $OS_ERROR";

      $buffer ||= $EMPTY; # LWP expects an empty string on finish, read returns 0
    }

    $remaining -= length $buffer;

    return $buffer;
  };
}

########################################################################
sub _create_multipart_upload_request {
########################################################################
  my ($parts_hr) = @_;

  my @parts;

  foreach my $part_num ( sort { $a <=> $b } keys %{$parts_hr} ) {
    push @parts,
      {
      PartNumber => $part_num,
      ETag       => $parts_hr->{$part_num},
      };
  }

  return create_xml_request(
    { CompleteMultipartUpload => { Part => \@parts } } );
}

1;

__END__

=pod

=head1 NAME

Amazon::S3::Bucket - A container class for a S3 bucket and its contents.

=head1 SYNOPSIS

  use Amazon::S3;
  
  # creates bucket object (no "bucket exists" check)
  my $bucket = $s3->bucket("foo"); 
  
  # create resource with meta data (attributes)