AnyEvent-CouchDB

 view release on metacpan or  search on metacpan

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

    ? '?' . join('&', @buf)
    : '';
};

our $code_to_string = sub {
  ref($_[0])
    ? sprintf 'do { my $CODE1; %s; $CODE1 }',
      Data::Dump::Streamer->new->Data($_[0])->Out
    : $_[0];
  # ^- taken from CouchDB::View::Document ------^
};

sub new {
  my ($class, $name, $uri, $json_encoder) = @_;
  $json_encoder ||= $default_json;
  my $self = bless { name => $name, uri => $uri, json_encoder => $json_encoder } => $class;
  if (my $userinfo = $self->uri->userinfo) {
    my $auth = encode_base64($userinfo, '');
    $self->{http_auth} = "Basic $auth";
  }
  return $self;
}

sub name {
  $_[0]->{name};
}

sub uri {
  $_[0]->{uri};
}

sub json_encoder {
  my ($self, $encoder) = @_;
  if ($encoder) {
    $self->{json_encoder} = $encoder;
  } else {
    $self->{json_encoder};
  }
}

sub json {
  my ( $self, $target ) = @_;
  ref($target) ? $self->json_encoder->encode($target) : $target;
}

sub compact {
  my ( $self, $options ) = @_;
  my ( $cv, $cb ) = cvcb( $options, 202, $self->json_encoder );
  http_request(
    POST    => ( $self->uri . "_compact" ),
    headers => $self->_build_headers($options),
    $cb
  );
  $cv;
}

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} ) {

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

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);
    };
  }
  else {
    $options->{success} = sub {
      my ($resp) = @_;
      $doc->{_id}  = $resp->{id};
      $doc->{_rev} = $resp->{rev};
      $_attachments->($doc);
    };
  }
  my ( $cv, $cb ) = cvcb( $options, 201, $self->json_encoder );
  my ( $method, $uri );
  if ( not defined $doc->{_id} ) {
    $method = 'POST';
    $uri    = $self->uri;
  }
  else {
    $method = 'PUT';
    $uri    = $self->uri . uri_escape_utf8( $doc->{_id} );
  }
  http_request(
    $method => $uri . $query->($options),
    headers => $self->_build_headers($options),
    body    => $self->json($doc),
    $cb
  );
  $cv;
}

sub remove_doc {
  my ( $self, $doc, $options ) = @_;
  die("Document is missing _id!") unless ( defined $doc->{_id} );
  my ( $cv, $cb ) = cvcb( $options, undef, $self->json_encoder );
  http_request(
    DELETE => $self->uri
        . uri_escape_utf8( $doc->{_id} )
        . $query->( { rev => $doc->{_rev} } ),
    headers => $self->_build_headers($options),
    $cb
  );
  $cv;
}

sub attach {
  my ( $self, $doc, $attachment, $options ) = @_;
  my $body < io( $options->{src} );
  my $length = length($body);
  $options->{type} ||= 'text/plain';
  if ( $options->{success} ) {
    my $orig = $options->{success};
    $options->{success} = sub {
      my ($resp) = @_;
      $orig->($resp);
      $doc->{_id}  = $resp->{id};
      $doc->{_rev} = $resp->{rev};
      $doc->{_attachments} ||= {};
      $doc->{_attachments}->{$attachment} = {
        'content_type' => $options->{type},
        'length'       => $length,
        'stub'         => JSON::true,
      };
    };
  }
  else {
    $options->{success} = sub {
      my ($resp) = @_;
      $doc->{_id}  = $resp->{id};
      $doc->{_rev} = $resp->{rev};
      $doc->{_attachments} ||= {};
      $doc->{_attachments}->{$attachment} = {
        'content_type' => $options->{type},
        'length'       => $length,
        'stub'         => JSON::true,
      };
    };
  }
  my ( $cv, $cb ) = cvcb( $options, 201, $self->json_encoder );
  http_request(
    PUT => $self->uri
        . uri_escape_utf8( $doc->{_id} ) . "/"
        . uri_escape_utf8($attachment)
        . $query->( { rev => $doc->{_rev} } ),
    headers => $self->_build_headers($options),
    body    => $body,
    $cb
  );
  $cv;
}

sub open_attachment {
  my ( $self, $doc, $attachment, $options ) = @_;
  my $cv = AnyEvent->condvar;

  # passthrough handler without json encoding
  my $success = sub {
    $options->{success}->(@_) if ($options->{success});
    $cv->send(@_);
  };

  # error handler that croaks with http headers
  my $error = sub {
    my $headers = shift;
    $options->{error}->(@_) if ($options->{error});
    $cv->croak(encode_json $headers);
  };

  my $cb = sub {
    my ($body, $headers) = @_;
    if ($headers->{Status} >= 200 and $headers->{Status} < 400) {
      $success->(@_);
    } else {
      $error->($headers);
    }
  };

  http_request(
    GET => $self->uri
        . uri_escape_utf8( $doc->{_id} ) . "/"
        . uri_escape_utf8($attachment),
    headers => $self->_build_headers($options),
    $cb
  );
  $cv;
}

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

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

sub head {
  my ( $self, $path, $options ) = @_;
  my ( $cv, undef ) = cvcb( $options, undef, $self->json_encoder );
  my $headers = $self->_build_headers($options);
  my $uri     = $self->uri . "$path" . $query->($options);
  http_request(
    HEAD    => $uri,
    headers => $headers,
    sub { $cv->send( $_[1] ); }
  );
  $cv;
}

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

sub post {
  my ( $self, $path, $options ) = @_;
  my ( $cv, $cb ) = cvcb( $options, undef, $self->json_encoder );
  my $headers = $self->_build_headers($options);
  my $uri     = $self->uri . "$path";
  http_request(
    POST    => $uri,
    headers => $headers,
    body    => $query->($options),
    $cb
  );
  $cv;
}

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

sub put {
  my ( $self, $path, $options ) = @_;
  my ( $cv, $cb ) = cvcb( $options, undef, $self->json_encoder );
  my $headers = $self->_build_headers($options);
  my $uri     = $self->uri . "$path";
  http_request(
    PUT     => $uri,
    headers => $headers,
    body    => $query->($options),
    $cb
  );
  $cv;
}


__END__

=head1 NAME

AnyEvent::CouchDB::Database - an object representing a CouchDB database

=head1 SYNOPSIS

  use AnyEvent::CouchDB;
  $db = couchdb('bavl');
  my $map = 'function(doc){
    if(doc.type == "Phrase"){ emit(null, doc) }
  }';
  my $phrases = $db->query($map)->recv;
  my $recordings = $db->view('recordings/all')->recv;

=head1 DESCRIPTION

Objects of this class represent a single CouchDB database.  This object is used
create and drop databases as well as operate on the documents within the database.

=head1 API

=head2 General

=head3 $db = AnyEvent::CouchDB::Database->new($name, $uri)

This method takes a name and a URI, and constructs an object representing a
CouchDB database.  The name should be conservative in the characters it uses,
because it needs to be both URI friendly and portable across filesystems.
Also, the URI that you pass in should contain a trailing slash.

=head3 $db->name

This method returns the name of the database.

=head3 $db->uri

This method returns the base URI of the database.

=head3 $db->json_encoder([ $json_encoder ])

This method is a mutator for setting a custom JSON encoder.  You should
pass in an object that responds to C<encode> and C<decode>.  Instances of
L<JSON> and L<JSON::XS> are good candidates.

=head2 Options

All the methods that accept an optional hashref of options can set an "headers"
key, wich will be added to all the requests. So you can add basic
authentication to your requests if needed: