Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

first checkin

  • Loading branch information...
commit 02b7739a02407b44e6a41d755b8ae90c5fd000be 0 parents
John Beppu authored
6 .gitignore
@@ -0,0 +1,6 @@
+Makefile
+*.~
+*.bak
+*.sw?
+blib
+pm_to_blib
8 MANIFEST.SKIP
@@ -0,0 +1,8 @@
+^\.git
+^MANIFEST\.bak$
+^Makefile$
+\..*\.swp$
+pm_to_blib
+~$
+\bblib\b
+\b\.xvpics\b
34 Makefile.PL
@@ -0,0 +1,34 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile (
+ NAME => 'AnyEvent::CouchDB',
+ AUTHOR => 'John BEPPU <beppu@cpan.org>',
+ LICENSE => 'mit',
+ VERSION_FROM => 'lib/AnyEvent/CouchDB.pm',
+ ABSTRACT_FROM => 'lib/AnyEvent/CouchDB.pm',
+ EXE_FILES => [ ],
+ PREREQ_PM => {
+ 'AnyEvent::HTTP' => 0,
+ 'CouchDB::View' => 0,
+ 'JSON::XS' => 0,
+ },
+ depend => { distmeta => 'metamunge' }
+);
+
+sub MY::libscan {
+ my $self = shift;
+ $_ = shift;
+ # $self appears to be a blessed hashref that contains
+ # all the attributes/value pairs passed to WriteMakeFile()
+ # plus some other MakeMaker-related info.
+ return 0 if /\.sw.$/ || /~$/;
+ return $_;
+}
+
+sub MY::postamble {q{
+metamunge :
+ $(NOECHO) $(ECHO) 'no_index:' >> $(DISTVNAME)/META.yml
+ $(NOECHO) $(ECHO) ' directory:' >> $(DISTVNAME)/META.yml
+ $(NOECHO) $(ECHO) ' - eg' >> $(DISTVNAME)/META.yml
+ $(NOECHO) $(ECHO) ' - t' >> $(DISTVNAME)/META.yml
+}}
121 lib/AnyEvent/CouchDB.pm
@@ -0,0 +1,121 @@
+package AnyEvent::CouchDB;
+
+use strict;
+use warnings;
+our $VERSION = '0.99';
+
+use JSON::XS;
+use AnyEvent::HTTP;
+use AnyEvent::CouchDB::DB;
+use URI::Escape;
+
+# TODO - add error handling
+# TODO - let user configure success and error if they so desire
+my $cvcb = sub {
+ my $options = shift;
+ my $cv = AnyEvent->condvar;
+ my $cb = sub { $cv->send(decode_json($_[0])) };
+ ($cv, $cb);
+};
+
+sub new {
+ my ($class, $url) = @_;
+ $url ||= 'http://localhost:5984';
+ bless { url => $url } => $class;
+}
+
+sub all_dbs {
+ my ($self, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ http_get $self->{url}.'/_all_dbs', $cb;
+ $cv;
+}
+
+sub db {
+ my ($self, $name) = @_;
+ my $uri = $self->{url} . "/" . uri_escape($name) . "/";
+ AnyEvent::CouchDB::DB->new($name, $uri);
+}
+
+sub info {
+ my ($self, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ http_get $self->{url}.'/', $cb;
+ $cv;
+}
+
+sub replicate {
+ my ($self, $source, $target, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ my $body = encode_json({ source => $source, target => $target });
+ http_request(
+ POST => $self->{url}.'/_replicate',
+ headers => { 'Content-Type' => 'application/json' },
+ body => $body,
+ $cb
+ );
+ $cv;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+AnyEvent::CouchDB - a non-blocking CouchDB client based on jquery.couch.js
+
+=head1 SYNOPSIS
+
+ my $couch = AnyEvent::CouchDB->new('http://localhost:5984/');
+ my $db = $couch->db('database');
+
+=head1 DESCRIPTION
+
+=head1 API
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+John BEPPU E<lt>beppu@cpan.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 John BEPPU E<lt>beppu@cpan.orgE<gt>.
+
+=head2 The "MIT" License
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+
+=cut
+
+# Local Variables: ***
+# mode: cperl ***
+# indent-tabs-mode: nil ***
+# cperl-close-paren-offset: -2 ***
+# cperl-continued-statement-offset: 2 ***
+# cperl-indent-level: 2 ***
+# cperl-indent-parens-as-block: t ***
+# cperl-tab-always-indent: nil ***
+# End: ***
+# vim:tabstop=8 softtabstop=2 shiftwidth=2 shiftround expandtab
155 lib/AnyEvent/CouchDB/DB.pm
@@ -0,0 +1,155 @@
+package AnyEvent::CouchDB::DB;
+
+use strict;
+use warnings;
+use JSON::XS;
+use AnyEvent::HTTP;
+use CouchDB::View::Document;
+use URI::Escape;
+
+# TODO - add error handling similar to what's in jquery.couch.js
+# TODO - (but make it appropriate to perl)
+my $cvcb = sub {
+ my $cv = AnyEvent->condvar;
+ my $cb = sub {
+ my $data;
+ eval {
+ $data = decode_json($_[0]);
+ };
+ if ($@) {
+ $cv->croak($@, $_[0], encode_json($_[1]));
+ } else {
+ $cv->send($data);
+ }
+ };
+ ($cv, $cb);
+};
+
+# TODO - encode cgi params that couchdb expects
+my $encode = sub { "?" };
+
+sub new {
+ my ($class, $name, $uri) = @_;
+ bless { name => $name, uri => $uri } => $class;
+}
+
+sub name {
+ $_[0]->{name};
+}
+
+sub uri {
+ $_[0]->{uri};
+}
+
+sub compact {
+ my ($self, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ http_request(
+ POST => ($self->uri . "_compact"),
+ headers => { 'Content-Type' => 'application/json' },
+ $cb
+ );
+ $cv;
+}
+
+sub create {
+ my ($self, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ http_request(
+ PUT => $self->uri,
+ headers => { 'Content-Type' => 'application/json' },
+ $cb
+ );
+ $cv;
+}
+
+sub drop {
+ my ($self, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ http_request(
+ DELETE => $self->uri,
+ $cb
+ );
+ $cv;
+}
+
+sub info {
+ my ($self, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ http_get($self->uri, $cb);
+ $cv;
+}
+
+sub all_docs {
+ my ($self, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ http_get($self->uri."_all_docs".$encode->($options), $cb);
+ $cv;
+}
+
+sub open_doc {
+ my ($self, $doc_id, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ http_get($self->uri.uri_escape($doc_id).$encode->($options), $cb);
+ $cv;
+}
+
+sub save_doc {
+ my ($self, $doc, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ my ($method, $uri);
+ if (defined $doc->{_id}) {
+ $method = 'POST';
+ $uri = $self->uri;
+ } else {
+ $method = 'PUT';
+ $uri = $self->uri.uri_escape($doc->{_id});
+ }
+ http_request(
+ $method => $uri.$encode->($options),
+ headers => { 'Content-Type' => 'application/json' },
+ $cb
+ );
+ $cv;
+}
+
+sub remove_doc {
+ my ($self, $doc, $options) = @_;
+ die("Document is missing _id!") unless (defined $doc->{_id});
+ my ($cv, $cb) = $cvcb->($options);
+ http_request(
+ DELETE => $self->uri.uri_escape($doc->{_id}).$encode->({ rev => $doc->{_rev} }),
+ $cb
+ );
+ $cv;
+}
+
+sub query {
+ my ($self, $map_fun, $reduce_fun, $language, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ $language ||= 'javascript';
+ # TODO - support perl based map and reduce functions via CouchDB::View
+ my $body = {
+ language => $language,
+ map => $map_fun,
+ };
+ if ($reduce_fun) {
+ $body->{reduce} = $reduce_fun;
+ }
+ http_request(
+ POST => $self->uri.'_temp_view'.$encode->($options),
+ headers => { 'Content-Type' => 'application/json' },
+ body => encode_json($body),
+ $cb
+ );
+ $cv;
+}
+
+sub view {
+ my ($self, $name, $options) = @_;
+ my ($cv, $cb) = $cvcb->($options);
+ http_get($self->uri."_view/".$name.$encode->($options), $cb);
+ $cv;
+}
+
+1;
3  t/00_basic.t
@@ -0,0 +1,3 @@
+use Test::More qw(no_plan);
+
+BEGIN { use_ok('AnyEvent::CouchDB') }
Please sign in to comment.
Something went wrong with that request. Please try again.