Net::Mosso::CloudFiles::Object - Represent a Cloud Files object

  # To create a new object
  my $xxx = $container->object( name => 'XXX' );
  $xxx->put('this is the value');

  # To create a new object with the contents of a local file
  my $yyy = $container->object( name => 'YYY', content_type => 'text/plain' );
  $yyy->put_filename('README');

  # To fetch an object:
  my $xxx2 = $container->object( name => 'XXX' );
  my $value = $xxx2->get;
  say 'has name ' . $xxx2->name;
  say 'has md5 ' . $xxx2->etag;
  say 'has size ' . $xxx2->size;
  say 'has content type ' . $xxx2->content_type;
  say 'has last_modified ' . $xxx2->last_modified;

  # To download an object to a local file
  $yyy->get_filename('README.downloaded');

  say 'has name ' . $object->name;

  $object->head;

 

  my $value = $object->get;

  my $value = $object->get(1);

  $object->get_filename('README.downloaded');

  $object->get_filename('README.downloaded',1);

  $object->delete;

  my $xxx = $container->object( name => 'XXX' );
  $xxx->put('this is the value');

  my $yyy = $container->object( name => 'YYY', content_type => 'text/plain' );
  $yyy->put_filename('README');

  say 'has md5 ' . $object->etag;

  say 'has size ' . $object->size;

  say 'has content type ' . $object->content_type;

  say 'has last_modified ' . $object->last_modified;

package Net::Mosso::CloudFiles::Object;
use Moose;
use MooseX::StrictConstructor;
use Moose::Util::TypeConstraints;
use Digest::MD5 qw(md5_hex);
use Digest::MD5::File qw(file_md5_hex);
use File::stat;

subtype 'Net::Mosso::CloudFiles::DateTime' => as class_type('DateTime');
coerce 'Net::Mosso::CloudFiles::DateTime'  => from 'Str' =>
    via { DateTime::Format::HTTP->parse_datetime($_) };

type 'Net::Mosso::CloudFiles::Etag' => where { $_ =~ /^[a-z0-9]{32}$/ };

has 'cloudfiles' =>
    ( is => 'ro', isa => 'Net::Mosso::CloudFiles', required => 1 );
has 'container' =>
    ( is => 'ro', isa => 'Net::Mosso::CloudFiles::Container', required => 1 );
has 'name' => ( is => 'ro', isa => 'Str', required => 1 );
has 'etag' => ( is => 'rw', isa => 'Net::Mosso::CloudFiles::Etag' );
has 'size' => ( is => 'rw', isa => 'Int' );
has 'content_type' =>
    ( is => 'rw', isa => 'Str', default => 'binary/octet-stream' );
has 'last_modified' =>
    ( is => 'rw', isa => 'Net::Mosso::CloudFiles::DateTime', coerce => 1 );

has 'cache_value' => (
    is        => 'rw',
    isa       => 'Bool',
    required  => 1,
    default   => 0
);

has 'always_check_etag' => (
    is        => 'rw',
    isa       => 'Bool',
    required  => 1,
    default   => 1
);


has 'object_metadata' => (
    is        => 'rw',
    isa       => 'HashRef',
    required  => 0,
    default   => sub  {
        return {};
    }  
);

has 'value' => (
    is        => 'rw',
    required  => 0,
    default   => undef,
);

has 'local_filename' => (
    is        => 'rw',
    isa       => 'Str',
    required  => 0
);




__PACKAGE__->meta->make_immutable;

sub _url {
    my ($self) = @_;
    my $url
        = $self->cloudfiles->storage_url . '/'
        . $self->container->name . '/'
        . $self->name;
    utf8::downgrade($url);
    return $url;
}

sub head {
    my $self    = shift;
    my $request = HTTP::Request->new( 'HEAD', $self->_url,
        [ 'X-Auth-Token' => $self->cloudfiles->token ] );
    my $response = $self->cloudfiles->_request($request);
    confess 'Object ' . $self->name . ' not found' if $response->code == 404;
    confess 'Unknown error' if $response->code != 204;
    $self->_set_attributes_from_response($response);
    return $response->content;
}

sub get {
    my ($self, $force_retrieval) = @_;
    
    if (!$force_retrieval && $self->cache_value() && defined($self->value()) ) {
        return $self->value();
    } else {
        my $request = HTTP::Request->new( 'GET', $self->_url,
            [ 'X-Auth-Token' => $self->cloudfiles->token ] );
        my $response = $self->cloudfiles->_request($request);
        confess 'Object ' . $self->name . ' not found' if $response->code == 404;
        confess 'Unknown error' if $response->code != 200;
        confess 'Data corruption error'
            if $response->header('ETag') ne md5_hex( $response->content );
        $self->_set_attributes_from_response($response);
        if ($self->cache_value()) {
            $self->value($response->content);
        }
        return $response->content();
    }
}

sub get_filename {
    my ( $self, $filename, $force_retrieval ) = @_;
    
    ## if we aren't forcing retrieval, and we are caching values, and we have a local_filename
    ## defined and it matches the filename we were just given, and the local_filename actually
    ## exists on the filesystem... then we can think about using the cached value.
    
    if (!$force_retrieval && $self->cache_value() && defined($self->local_filename()) &&
         $self->local_filename() eq $filename && -e $self->local_filename() ) {
            
        ## in order to do this, we have to at least verify that the file we have matches
        ## the file on cloud-files.  Best way to do that is to load the metadata and 
        ## compare the etags.
        $self->head();
        if ($self->etag() eq file_md5_hex($filename)) {
            ## our local data matches what's in the cloud, we don't have to re-download
            return $self->local_filename();
        }
    }
    
    ## if we are here, we have to download the file.
    my $request = HTTP::Request->new( 'GET', $self->_url,
        [ 'X-Auth-Token' => $self->cloudfiles->token ] );
    my $response = $self->cloudfiles->_request( $request, $filename );

    confess 'Object ' . $self->name . ' not found' if $response->code == 404;
    confess 'Unknown error' if $response->code != 200;
    confess 'Data corruption error' unless $self->_validate_local_file( $filename,  
                                                                        $response->header('Content-Length'),  
                                                                        $response->header('ETag') );
    $self->_set_attributes_from_response($response);
    my $last_modified = $self->last_modified->epoch;

    # make sure the file has the same last modification time
    utime $last_modified, $last_modified, $filename;
    if ($self->cache_value()) {
        $self->local_filename($filename);
    }
    return $filename;
}



sub delete {
    my $self    = shift;
    my $request = HTTP::Request->new( 'DELETE', $self->_url,
        [ 'X-Auth-Token' => $self->cloudfiles->token ] );
    my $response = $self->cloudfiles->_request($request);
    confess 'Object ' . $self->name . ' not found' if $response->code == 404;
    confess 'Unknown error' if $response->code != 204;
}

sub put {
    my ( $self, $value ) = @_;
    my $name    = $self->name;
    my $md5_hex    = md5_hex($value);
    my $size    = length($value);

    my $request = HTTP::Request->new(
        'PUT',
        $self->_url,
        $self->_prepare_headers($md5_hex, $size),
        $value
    );
    my $response = $self->cloudfiles->_request($request);
    
    if ($response->code == 204) {
        ## since the value was set successfully, we can set all our instance data appropriately.
        
        $self->etag($md5_hex);
        $self->size($size);
        if ($self->cache_value) {
            $self->value($value);
        }
        return;
    }
    confess 'Missing Content-Length or Content-Type header'
        if $response->code == 412;
    confess 'Data corruption error' if $response->code == 422;
    confess 'Data corruption error' if $response->header('ETag') ne $md5_hex;
    confess 'Unknown error'         if $response->code != 201;
}

sub put_filename {
    my ( $self, $filename ) = @_;
    my $name = $self->name;

    my $md5_hex = file_md5_hex($filename);
    my $stat    = stat($filename) || confess("No $filename: $!");
    my $size    = $stat->size;

    my $request = HTTP::Request->new(
        'PUT',
        $self->_url,
        $self->_prepare_headers($md5_hex, $size),
        $self->_content_sub($filename),
    );
    my $response = $self->cloudfiles->_request($request);
    
    if ($response->code == 204) {
        $self->etag($md5_hex);
        $self->size($size);
        if ($self->cache_value) {
            $self->local_filename($filename);
        }
    }
    
    confess 'Missing Content-Length or Content-Type header'
        if $response->code == 412;
    confess 'Data corruption error' if $response->code == 422;
    confess 'Data corruption error' if $response->header('ETag') ne $md5_hex;
    confess 'Unknown error'         if $response->code != 201;
}

sub _prepare_headers {
    my ($self, $etag, $size) = @_;
    my $headers = HTTP::Headers->new();
    
    $headers->header('X-Auth-Token' => $self->cloudfiles->token );
    $headers->header('Content-length' => $size );
    $headers->header('ETag' => $etag );
    $headers->header('Content-Type' => $self->content_type);
    
    my $header_field;
    foreach my $key (keys %{$self->object_metadata}) {
        $header_field = 'X-Object-Meta-' . $key;
        # make _'s -'s for header sending.
        $header_field =~ s/_/-/g;
        
        $headers->header($header_field => $self->object_metadata->{$key});
    }
    return $headers;
}


sub _content_sub {
    my $self      = shift;
    my $filename  = shift;
    my $stat      = stat($filename);
    my $remaining = $stat->size;
    my $blksize   = $stat->blksize || 4096;

    confess "$filename not a readable file with fixed size"
        unless -r $filename and ( -f _ || $remaining );
    my $fh = IO::File->new( $filename, 'r' )
        or confess "Could not open $filename: $!";
    $fh->binmode;

    return sub {
        my $buffer;

        # upon retries the file is closed and we must reopen it
        unless ( $fh->opened ) {
            $fh = IO::File->new( $filename, 'r' )
                or confess "Could not open $filename: $!";
            $fh->binmode;
            $remaining = $stat->size;
        }

        # warn "read remaining $remaining";
        unless ( my $read = $fh->read( $buffer, $blksize ) ) {

#                       warn "read $read buffer $buffer remaining $remaining";
            confess
                "Error while reading upload content $filename ($remaining remaining) $!"
                if $! and $remaining;

            # otherwise, we found EOF
            $fh->close
                or confess "close of upload content $filename failed: $!";
            $buffer ||= ''
                ;    # LWP expects an emptry string on finish, read returns 0
        }
        $remaining -= length($buffer);
        return $buffer;
    };
}

sub _set_attributes_from_response {
    my ( $self, $response ) = @_;
    
    $self->etag( $response->header('ETag') );
    $self->size( $response->header('Content-Length') );
    $self->content_type( $response->header('Content-Type') );
    $self->last_modified( $response->header('Last-Modified') );
    my $metadata = {};
    foreach my $headername ($response->headers->header_field_names) {
        if ($headername =~ /^x-object-meta-(.*)/i) {
            my $key = $1;
            ## undo our _ to - translation
            $key =~ s/-/_/g;
            $metadata->{lc($key)} = $response->header($headername);
        }
    }
    $self->object_metadata($metadata);
}

sub _validate_local_file {
    my ($self, $localfile, $size, $md5) = @_;
    
    my $stat = stat($localfile);
    my $localsize = $stat->size;
    
    # first check size, if they are different, we don't need to bother with 
    # an expensive md5 calculation on the whole file.
    if ($size != $localsize ) {
        return 0;
    }
    
    if ($self->always_check_etag && ($md5 ne file_md5_hex($localfile))) {
        return 0;
    }
    return 1;
}

1;

__END__