App-Phoebe

 view release on metacpan or  search on metacpan

lib/App/Phoebe/Capsules.pm  view on Meta::CPAN

  } else {
    result($stream, "59", "The titan URL is malformed");
  }
  $stream->close_gracefully();
  return;
}

# We need our own valid_params because we don't check the token but we do check
# the extension
sub valid_params {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $params = shift;
  return unless valid_id($stream, $host, $space, $id, $params);
  # return unless valid_token($stream, $host, $space, $id, $params);
  $params->{mime} = mime_type($id);
  return unless valid_mime_type($stream, $host, $space, $id, $params);
  return unless valid_size($stream, $host, $space, $id, $params);
  return 1;
}

sub save_file {
  my ($stream, $url, $upload, $buffer, $size) = @_;
  my $name = capsule_name($stream);
  my $capsule = $upload->{capsule} || "";
  if (not $name) {
    $log->debug("Missing certificate for capsule upload");
    return result($stream, "60", "Uploading files requires a client certificate");
  } elsif ($name ne $capsule) {
    $log->debug("Wrong certificate for capsule upload: $name vs $capsule");
    return result($stream, "61", "This is not your space: your certificate authorizes you for $name");
  }
  return result($stream, "50", "Titan upload failed")
      unless defined $buffer and defined $size and $upload->{id}
      and $upload->{space} and $upload->{space} eq "capsule";
  my $host = $upload->{host};
  my $dir = capsule_dir($host, $capsule);
  my $id = $upload->{id};
  my $file = $dir . "/" . encode_utf8($id);
  if ($size == 0) {
    return result($stream, "51", "This capsule does not exist") unless -d $dir;
    return result($stream, "51", "This file does not exist") unless -f $file;
    return result($stream, "40", "Cannot delete this file") unless unlink $file;
    $log->info("Deleted $file");
  } else {
    mkdir($dir) unless -d $dir;
    backup($dir, $id);
    write_binary($file, $buffer);
    $log->info("Wrote $file");
    return result($stream, "30", to_url($stream, $host, $capsule_space, $capsule));
  }
}

sub backup {
  my ($dir, $id) = @_;
  my $file = $dir . "/" . encode_utf8($id);
  my $backup_dir = "$dir/backup";
  my $backup_file = $backup_dir . "/" . encode_utf8($id);
  return unless -f $file and (time - (stat($file))[9]) > 600;
  # make a backup if the last edit was more than 10 minutes ago
  mkdir($backup_dir) unless -d $backup_dir;
  write_binary($backup_file, read_binary($file));
}

1;



( run in 1.910 second using v1.01-cache-2.11-cpan-d8267643d1d )