Net-XIPCloud

 view release on metacpan or  search on metacpan

XIPCloud.pm  view on Meta::CPAN

  # default values for API and version
  $self->{api_url} = 'https://auth.storage.santa-clara.internapcloud.net:443/';
  $self->{api_version} = 'v1.0';

  # stash remaining arguments in object
  foreach my $el (keys %args) {
    $self->{$el} = $args{$el};
  }
  return $self;
}

=head2 connect()

Connects to XIPCloud using the username and password provids in the new() call.

Method returns 1 for success and undef for failure.

=cut

sub connect() {
  my $self = shift;
  my $status = undef;

  # prepare authentication headers
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(GET => $self->{api_url}.$self->{api_version});
  $req->header( 'X-AUTH-USER' => $self->{username} );
  $req->header( 'X-AUTH-KEY' => $self->{password} );

  # dispatch request
  my $res = $ua->request($req);

  # persist state on connect
  if ($res->is_success) {
    $status = 1;
    $self->{connected} = 1;
    $self->{storage_token} = $res->header( 'x-storage-token' );
    $self->{storage_url} = $res->header( 'x-storage-url' );
    $self->{cdn_url} = $res->header( 'x-cdn-management-url' );
    $self->{debug} && print "connected: token [".$self->{storage_token}."] url [".$self->{storage_url}."] cdn [".$self->{cdn_url}."]\n";
  }

  # fail
  else {
    $self->{debug} && print "connection failed\n";
  }

  return $status;
}

=head2 ls([CONTAINER])

Depending on the calling arguments, this method returns the list of containers or list
of objects within a single container as an array reference.

Limit and marker values may be provided (see API documentation) for pagination.

=cut

sub ls() {
  my $self = shift;
  my $container = shift;
  my $limit = shift;
  my $marker = shift;
  my $list = [];
  my $path = undef;

  # make sure we have an active connection
  return undef unless ($self->{connected});

  # prepare LWP object for connection
  my $ua = LWP::UserAgent->new;
  my $requrl = $self->{storage_url};

  # let caller specify a pseudo path
  if ($container =~ /\//) {
    split('/',$container); 
    $container = shift;
    $path = join('/',@_);
  }

  # we don't necessarily need a container
  # ls() without one lists all the containers
  if ($container) {
    $requrl.='/'.$container;
  }

  # handle special flags
  if ($limit || $marker || $path) {
    $requrl.="?limit=$limit&marker=$marker&path=$path";
  }

  # prepare the request object
  my $req = HTTP::Request->new(GET => $requrl);
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );

  # dispatch request
  my $res = $ua->request($req);

  # stuff return values into our result set
  if ($res->is_success) {
    my @raw = split("\n",$res->content);
    foreach (@raw) {
      next if /^$/;
      push @$list, $_;
    }

    $self->{debug} && print "ls: success - got [".scalar(@$list)."] elements\n";
  }

  # failed
  else {
    undef $list;
    $self->{debug} && print "ls: failed\n";
  }

  return $list;
}

=head2 file("somecontainer","someobject")

This call returns metadata about a specific object.

=cut

sub file() {
  my $self = shift;
  my $container = shift;
  my $object = shift;
  my $status = undef;
  my $path = undef;

  # let file() be called with one or two arguments
  if ($object) {
    $container.='/'.$object;
  }

  # handle pseudo paths
  if ($container =~ /\//) {
    split('/',$container);
    $container = shift;
    $path = join('/',@_);
  }

  # ensure we have enough information to proceed
  return undef unless ($self->{connected} && $container && $path);

  # prepare the LWP request
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(HEAD => $self->{storage_url}.'/'.$container.'/'.$path);
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );

  # dispatch request
  my $res = $ua->request($req);

  # grab subset of returned fields
  # TODO: should be extended to handle all x- fields
  if ($res->is_success) {
    $status->{size} = $res->header("content-length");
    $status->{mtime} = $res->header("last-modified");
    $status->{md5sum} = $res->header("etag");
    $status->{type} = $res->header("content-type");

    $self->{debug} && print "file: success [$container/$path]\n";
  }

  # fail
  else {
    $self->{debug} && print "file: failed [$container/$path]\n";
  }

  return $status;
}

=head2 cp("fromcontainer","fromobject",'tocontainer","toobject");

Copy the contents of one object to another

=cut

sub cp() {
  my $self = shift;
  my $scontainer = shift;
  my $sobject = shift;
  my $dcontainer = shift;
  my $dobject = shift;
  my $status = undef;

  # ensure we have enough information to continue
  return undef unless ($self->{connected} && $scontainer && $sobject && $dcontainer && $dobject);

  # hold onto the content-type of the source object for later
  # we'll need it to create the destination object
  my $src = $self->file($scontainer,$sobject);
  return undef unless (ref $src eq 'HASH');
  my $type = $src->{type};

  # prepare the copy request
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(COPY => $self->{storage_url}.'/'.$scontainer.'/'.$sobject);
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );
  $req->header( 'Destination' => $dcontainer.'/'.$dobject);
  $req->header( 'Content-type' => $type);

  # dispatch the request
  my $res = $ua->request($req);

  # success
  if ($res->is_success) {
    $status = 1;
    $self->{debug} && print "cp: success [$scontainer/$sobject]=>[$dcontainer/$dobject]\n";
  }

  # failed
  else {
    $self->{debug} && print "cp: failed [$scontainer/$sobject]=>[$dcontainer/$dobject]\n";
  }
  return $status;
}

=head2 mv("fromcontainer","fromobject",'tocontainer","toobject");

Rename an object, clobbering any existing object

=cut

sub mv() {
  my $self = shift;
  my $scontainer = shift;
  my $sobject = shift;
  my $dcontainer = shift;
  my $dobject = shift;
  my $status = undef;

  # ensure we have enough information to continue
  return undef unless ($self->{connected} && $scontainer && $sobject && $dcontainer && $dobject);

  # exit on moving an objec to itself - bad idea with copy/delete method
  return if ( ($scontainer eq $dcontainer) && ($sobject eq $dobject));

  # get the source object's content-type and save it for later
  my $src = $self->file($scontainer,$sobject);
  return undef unless (ref $src eq 'HASH');
  my $type = $src->{type};

  # prepare the LWP request
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(COPY => $self->{storage_url}.'/'.$scontainer.'/'.$sobject);
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );
  $req->header( 'Destination' => $dcontainer.'/'.$dobject);
  $req->header( 'Content-type' => $type);

  # dispatch request
  my $res = $ua->request($req);

  # copy was successful
  if ($res->is_success) {

    # delete the old object
    if ( $self->rm($scontainer,$sobject) ) {
      $status = 1;
      $self->{debug} && print "mv: success [$scontainer/$sobject]=>[$dcontainer/$dobject]\n";
    }

    # WAT? delete of old object failed!
    else {
      $self->{debug} && print "mv: failed [$scontainer/$sobject]=>[$dcontainer/$dobject]\n";
    }
  }

  # copy failed
  else {
    $self->{debug} && print "mv: failed [$scontainer/$sobject]=>[$dcontainer/$dobject]\n";
  }
  return $status;
}

=head2 mkdir("somecontainer")

This method creates a new container. It returns 1 for success and undef for failure.

=cut

sub mkdir() {
  my $self = shift;
  my $container = shift;
  my $status = undef;

XIPCloud.pm  view on Meta::CPAN

    $self->{debug} && print "mkdir: failed [$container]\n";
  }

  return $status;
}

=head2 rmdir("somecontainer")

This method removes a container and its contents. It returns 1 for success and undef for failure.

=cut

sub rmdir() {
  my $self = shift;
  my $container = shift;
  my $status = undef;
  my $path = undef;

  # ensure we have enough information to continue
  return undef unless ($self->{connected} && $container);

  # handle pseudo paths
  if ($container =~ /\//) {
    split('/',$container); 
    $container = shift;
    $path = join('/',@_);
  }

  # TODO - handle recursive deletion of pseudo-folder objects
  # wish there was a way to do this with the api

  # prepare LWP request
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(DELETE => $self->{storage_url}.'/'.$container);
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );
  $req->header( 'Content-Length' => '0' );

  # dispatch request
  my $res = $ua->request($req);

  # success
  if ($res->is_success) {
    $status = 1;
    $self->{debug} && print "rmdir: success [$container]\n";   
  }

  # failed
  else {
    $self->{debug} && print "rmdir: failed [$container]\n";
  }
  return $status;
}

=head2 du([CONTAINER])

Depending on calling arguments, this method returns account or container-level statistics as 
a hash reference.

=cut

sub du() {
  my $self = shift;
  my $container = shift;
  my $status = undef;

  # ensure we have enough information to continue
  return undef unless ($self->{connected});

  # prepare LWP reques
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(HEAD => $self->{storage_url}.($container?'/'.$container:''));
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );

  # dispatch request
  my $res = $ua->request($req);

  # success
  if ($res->is_success) {

    # return fields appropriate for container
    if ($container) {
      $status->{bytes} = $res->header('x-container-bytes-used');
      $status->{objects} = $res->header('x-container-object-count');
    }

    # return global statistics
    else {
      $status->{bytes} = $res->header('x-account-bytes-used');
      $status->{objects} = $res->header('x-account-object-count');
      $status->{containers} = $res->header('x-account-container-count');
    }

    $self->{debug} && print "du: success\n";
  }

  # failed
  else{
    $self->{debug} && print "du: failed\n";
  }
  return $status;
}

=head2 get_value("somecontainer","someobject")

This method returns a scalar value, containing the body of the requested object.

=cut

sub get_value() {
  my $self = shift;
  my $container = shift;
  my $object = shift;
  my $data = undef;

  # ensure we have enough information to continue
  return undef unless ($self->{connected} && $container && $object);

  # prepare the LWP object
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(GET => $self->{storage_url}.'/'.$container.'/'.$object);
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );

XIPCloud.pm  view on Meta::CPAN

  # faled
  else {
    $self->{debug} && print "put_file: failed for [$container/$object]\n";
  }
  return $status;
}

=head2 get_fhstream("somecontainer","someobject",*FILE)

This method takes a container, object and open file handle as arguments.
It retrieves the object in chunks, which it writes to *FILE as they are received.

=cut

sub get_fhstream() {
  my $self = shift;
  my $container = shift;
  my $object = shift;
  local (*OUT) = shift;
  my $status = undef;

  # ensure we have enough information to continue
  return undef unless ($self->{connected} && $container && $object && *OUT);

  # make sure the file handle we were passed is open
  return undef unless ( (O_WRONLY | O_RDWR) & fcntl (OUT, F_GETFL, my $slush));

  # prepare the LWP request
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(GET => $self->{storage_url}.'/'.$container.'/'.$object);
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );

  # create our custom handler for reading
  my $res = $ua->request($req,
    sub {
      my ($chunk,$res) = @_;
      print OUT $chunk;
    }
  );

  # success
  if ($res->is_success) {
    $status = 1;

    $self->{debug} && print "get_fhstream: success for [$container/$object]\n";
  }

  # failed
  else {
    $self->{debug} && print "get_fhstream: failed for [$container/$object]\n";
  }
  return $status;
}

=head2 rm("somecontainer","someobject")

This method removes an object.

=cut

sub rm() {
  my $self = shift;
  my $container = shift;
  my $object = shift;
  my $status = undef;

  # ensure we have enough information to continue
  return undef unless ($self->{connected} && $container && $object);

  # prepare the LWP object
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(DELETE => $self->{storage_url}.'/'.$container.'/'.$object);
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );
  $req->header( 'Content-Length' => '0' );

  # dispatch the request
  my $res = $ua->request($req);

  # success
  if ($res->is_success) {
    $status = 1;
    $self->{debug} && print "rm: success for [$container/$object]\n";
  }

  # failed
  else {
    $self->{debug} && print "rm: failed for [$container/$object]\n";
  }
  return $status;
}

=head2 create_manifest("somecontainer","someobject")

This method creates a manifest for large-object support

=cut

sub create_manifest() {
  my $self = shift;
  my $container = shift;
  my $object = shift;
  my $status = undef;
  my $content_type = 'application/octet-stream';
  my $data;

  # ensure we have enough information to continue
  return undef unless ($self->{connected} && $container && $object);

  # prepare the LWP request
  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(PUT => $self->{storage_url}.'/'.$container.'/'.$object);
  $req->header( 'X-STORAGE-TOKEN' => $self->{storage_token} );
  $req->header( 'Content-type' => $content_type);

  # point the manifest header to ourselves
  # segments will be further along our path:
  # somecontainer/manifest            <- manifest
  # somecontainer/manifest/segment1   <- segment
  # somecontainer/manifest/segment2   <- segment
  $req->header( 'X-Object-Manifest' => $container.'/'.$object);
  $req->header( 'Content-Length' => '0' );