view release on metacpan or  search on metacpan

lib/AnyEvent/CouchDB/Database.pm  view on Meta::CPAN

}

sub create {
  my ( $self, $options ) = @_;
  my ( $cv, $cb ) = cvcb( $options, 201, $self->json_encoder );
  http_request(
    PUT     => $self->uri,
    headers => $self->_build_headers($options),
    $cb
  );
  $cv;
}

sub drop {
  my ( $self, $options ) = @_;
  my ( $cv, $cb ) = cvcb( $options, undef, $self->json_encoder );
  http_request(
    DELETE  => $self->uri,
    headers => $self->_build_headers($options),
    $cb
  );
  $cv;
}

sub info {
  my ( $self, $options ) = @_;
  my ( $cv, $cb ) = cvcb( $options, undef, $self->json_encoder );
  http_request(
    GET     => $self->uri,
    headers => $self->_build_headers($options),
    $cb
  );
  $cv;
}

sub all_docs {
  my ( $self, $options ) = @_;
  my ( $cv, $cb ) = cvcb( $options, undef, $self->json_encoder );
  http_request(
    GET     => $self->uri . '_all_docs' . $query->($options),
    headers => $self->_build_headers($options),
    $cb
  );
  $cv;
}

sub all_docs_by_seq {
  my ( $self, $options ) = @_;
  my ( $cv, $cb ) = cvcb( $options, undef, $self->json_encoder );
  http_request(
    GET     => $self->uri . '_all_docs_by_seq' . $query->($options),
    headers => $self->_build_headers($options),
    $cb
  );
  $cv;
}

sub open_doc {
  my ( $self, $doc_id, $options ) = @_;
  if ( not defined $doc_id ) {
    AnyEvent::CouchDB::Exception::UndefinedDocument->throw(
      "An undefined id was passed to open_doc()."
    );
  }
  my ( $cv, $cb ) = cvcb( $options, undef, $self->json_encoder );
  my $id = uri_escape_utf8($doc_id);
  if ( $id =~ qr{^_design%2F} ) {
    $id =~ s{%2F}{/}g;
  }
  http_request(
    GET     => $self->uri . $id . $query->($options),
    headers => $self->_build_headers($options),
    $cb
  );
  $cv;
}

sub open_docs {
  my ( $self, $doc_ids, $options ) = @_;
  my ( $cv, $cb ) = cvcb( $options, undef, $self->json_encoder );
  $options ||= {};
  $options->{'include_docs'} = 'true';
  http_request(
    POST    => $self->uri . '_all_docs' . $query->($options),
    headers => $self->_build_headers($options),
    body    => $self->json( { "keys" => $doc_ids } ),
    $cb
  );
  $cv;
}

sub save_doc {
  my ( $self, $doc, $options ) = @_;

  # create attachment stubs for new inlined attachments
  my $_attachments = sub {
    my ( $doc ) = @_;
    my $_a = $doc->{_attachments};
    return unless defined $_a;
    my $revpos = $doc->{_rev};
    $revpos =~ s/-.*$//;
    for my $key (keys %$_a) {
      if ( exists($_a->{$key}{data}) ) {
        my $file = $_a->{$key};
        $file->{length} = length(decode_base64($file->{data}));
        $file->{revpos} = $revpos;
        $file->{stub}   = JSON::true();
        delete $file->{data};
      }
    }
  };

  if ( $options->{success} ) {
    my $orig = $options->{success};
    $options->{success} = sub {
      my ($resp) = @_;
      $orig->($resp);
      $doc->{_id}  = $resp->{id};
      $doc->{_rev} = $resp->{rev};
      $_attachments->($doc);
    };