Permalink
Browse files

Merge branch 'nom'

  • Loading branch information...
2 parents c67d3c3 + a0f2512 commit f4d99ab4fc6869133a8463c56fa47f4dcc347e42 @bbkr bbkr committed Dec 22, 2011
View
@@ -1,6 +1,6 @@
{
"name" : "MongoDB",
- "version" : "0.1",
+ "version" : "0.3",
"description" : "MongoDB driver",
"author" : "Pawel Pabian",
"authority" : "bbkr",
@@ -7,17 +7,21 @@
objects = {
/* Begin PBXFileReference section */
+ 8128962714A27D3900BDC0AC /* update.t */ = {isa = PBXFileReference; lastKnownFileType = text; path = update.t; sourceTree = "<group>"; xcLanguageSpecificationIdentifier = xcode.lang.perl; };
+ 8128962A14A29B0E00BDC0AC /* remove.t */ = {isa = PBXFileReference; lastKnownFileType = text; path = remove.t; sourceTree = "<group>"; xcLanguageSpecificationIdentifier = xcode.lang.perl; };
+ 8128962B14A336DA00BDC0AC /* find.t */ = {isa = PBXFileReference; lastKnownFileType = text; path = find.t; sourceTree = "<group>"; xcLanguageSpecificationIdentifier = xcode.lang.perl; };
+ 8128962C14A34B6F00BDC0AC /* changelog.txt */ = {isa = PBXFileReference; lastKnownFileType = text; path = changelog.txt; sourceTree = "<group>"; };
81322EC71441DCD900D0AF15 /* logo_32x32.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; path = logo_32x32.png; sourceTree = "<group>"; };
81322EC81441DCD900D0AF15 /* META.info */ = {isa = PBXFileReference; lastKnownFileType = text; path = META.info; sourceTree = "<group>"; };
+ 81619C7014601C4700315881 /* Protocol.pm */ = {isa = PBXFileReference; lastKnownFileType = text.script.perl; path = Protocol.pm; sourceTree = "<group>"; };
+ 816DD7FD1486CD8100491105 /* insert.t */ = {isa = PBXFileReference; lastKnownFileType = text; path = insert.t; sourceTree = "<group>"; xcLanguageSpecificationIdentifier = xcode.lang.perl; };
81C247041416C8BA000A420F /* README */ = {isa = PBXFileReference; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
81C247071416C8F9000A420F /* Collection.pm */ = {isa = PBXFileReference; lastKnownFileType = text.script.perl; path = Collection.pm; sourceTree = "<group>"; };
81C247081416C8F9000A420F /* Connection.pm */ = {isa = PBXFileReference; lastKnownFileType = text.script.perl; path = Connection.pm; sourceTree = "<group>"; };
81C247091416C8F9000A420F /* Cursor.pm */ = {isa = PBXFileReference; lastKnownFileType = text.script.perl; path = Cursor.pm; sourceTree = "<group>"; };
81C2470A1416C8F9000A420F /* DataBase.pm */ = {isa = PBXFileReference; lastKnownFileType = text.script.perl; path = DataBase.pm; sourceTree = "<group>"; };
81C2470B1416C8F9000A420F /* Wire.pm */ = {isa = PBXFileReference; lastKnownFileType = text.script.perl; path = Wire.pm; sourceTree = "<group>"; };
81C2470C1416C8F9000A420F /* MongoDB.pm */ = {isa = PBXFileReference; lastKnownFileType = text.script.perl; path = MongoDB.pm; sourceTree = "<group>"; };
- 81C2470E1416C90A000A420F /* load.t */ = {isa = PBXFileReference; lastKnownFileType = text; path = load.t; sourceTree = "<group>"; };
- 81C247101416C90A000A420F /* wire.t */ = {isa = PBXFileReference; lastKnownFileType = text; path = wire.t; sourceTree = "<group>"; };
/* End PBXFileReference section */
/* Begin PBXGroup section */
@@ -32,6 +36,7 @@
81C246FB1416C6B8000A420F = {
isa = PBXGroup;
children = (
+ 8128962C14A34B6F00BDC0AC /* changelog.txt */,
81322EC61441DCD900D0AF15 /* logotype */,
81322EC81441DCD900D0AF15 /* META.info */,
81C2470D1416C90A000A420F /* t */,
@@ -52,6 +57,7 @@
81C247061416C8F9000A420F /* MongoDB */ = {
isa = PBXGroup;
children = (
+ 81619C7014601C4700315881 /* Protocol.pm */,
81C247071416C8F9000A420F /* Collection.pm */,
81C247081416C8F9000A420F /* Connection.pm */,
81C247091416C8F9000A420F /* Cursor.pm */,
@@ -64,8 +70,10 @@
81C2470D1416C90A000A420F /* t */ = {
isa = PBXGroup;
children = (
- 81C2470E1416C90A000A420F /* load.t */,
- 81C247101416C90A000A420F /* wire.t */,
+ 816DD7FD1486CD8100491105 /* insert.t */,
+ 8128962714A27D3900BDC0AC /* update.t */,
+ 8128962A14A29B0E00BDC0AC /* remove.t */,
+ 8128962B14A336DA00BDC0AC /* find.t */,
);
path = t;
sourceTree = "<group>";
View
48 README
@@ -20,15 +20,13 @@ Let's see what it can do...
use MongoDB;
my $connection = MongoDB::Connection.new( );
- my $database = $connection.database( 'test' );
+ my $database = $connection.database( 'test' );
my $collection = $database.collection( 'perl_users' );
my $cursor;
- my %document;
-
#### insert documents into collection ####
- %document = {
+ my %document1 = {
'name' => 'Paweł Pabian',
'nick' => 'bbkr',
'versions' => [ 5, 6 ],
@@ -38,21 +36,20 @@ Let's see what it can do...
},
'IRC' => True,
};
- $collection.insert( %document );
- %document = {
+ my %document2 = {
'name' => 'Andrzej Cholewiusz',
'nick' => 'andee',
'versions' => [ 5 ],
'IRC' => False,
};
- $collection.insert( %document );
+ $collection.insert( %document1, %document2 );
#### find documents in collection ####
# find everything
- $cursor = $collection.find( );
+ my $cursor = $collection.find( );
while $cursor.fetch( ) -> %document {
%document.perl.say;
}
@@ -71,36 +68,47 @@ Let's see what it can do...
$collection.update( { 'nick' => 'andee' }, { '$push' => { 'versions' => 6 } } );
- #### delete documents from collection ####
+ #### remove documents from collection ####
+
+ # remove specific documents
+ $collection.remove( { 'nick' => 'bbkr' } );
+
+ # or remove all documents
+ $collection.remove( );
+
- # delete specific documents
- $collection.delete( { 'nick' => 'bbkr' } );
+FLAGS
- # or delete all documents
- $collection.delete( );
+Flags are boolean values, false by default.
+They can be used anywhere and in any order in methods.
+
+ remove( { 'nick' => 'bbkr' }, :single_remove );
+ remove( :single_remove, { 'nick' => 'bbkr' } ); # same
+
+Currently supported
+ insert - :continue_on_errror
+ find - :no_cursor_timeout
+ update - :upsert, :multi_update
+ remove - :single_remove
FEATURE ROADMAP
List of things you may expect in nearest future.
* find_one( ) - syntactic sugar for selecting without cursor
-* update_one( ) - update only first matching record
-* update( ) - with upsert
* error handler
* database authentication
-* kill( ) - for cursor to abandon remaining data
* drop database or collection
* more stuff from http://www.mongodb.org/display/DOCS/Mongo+Driver+Requirements
KNOWN LIMITATIONS
-* lack of Num or Rat support
- this is directly related to not yet specified pack/unpack in Perl6
* big integers (int64)
- those are not yet implemented in Rakudo
-* speed
+* lack of Num or Rat support,
+ this is directly related to not yet specified pack/unpack in Perl6
+* speed,
protocol correctness and clear code are priorities for now
View
@@ -0,0 +1,12 @@
+0.3
+
+* Basic added to methods (upsert, multi_update, single_remove,...)
+* Kill support for cursor.
+
+0.2
+
+* Adapted to Rakudo NOM 2011.09+.
+
+0.1
+
+* Basic Proof-of-concept working on Rakudo 2011.07.
View
@@ -1,8 +1,8 @@
-class MongoDB;
+module MongoDB:ver<0.3>;
-use MongoDB::Connection;
use MongoDB::Wire;
-our $wire = MongoDB::Wire.new;
-
-method ^wire ( ::T ) { return $wire };
+use MongoDB::Connection;
+use MongoDB::DataBase;
+use MongoDB::Collection;
+use MongoDB::Cursor;
View
@@ -1,35 +1,62 @@
-class MongoDB::Collection;
-
+use MongoDB::Protocol;
use MongoDB::Cursor;
-has MongoDB::DataBase $.database is rw;
+class MongoDB::Collection does MongoDB::Protocol;
+
+has $.database is rw;
has Str $.name is rw;
-submethod BUILD ( MongoDB::DataBase $database, Str $name ) {
+submethod BUILD ( :$database, Str :$name ) {
$.database = $database;
# TODO validate name
$.name = $name;
}
-method insert ( *@documents ) {
- MongoDB.wire.OP_INSERT( self, 0, ||@documents );
+method insert (
+ *@documents where { +@documents and [&&]@documents>>.isa( Hash ) },
+ Bool :$continue_on_error = False
+) {
+
+ my $flags = +$continue_on_error;
+
+ self.wire.OP_INSERT( self, $flags, @documents );
}
-method find ( %query = { } ) {
+method find (
+ %query = { },
+ Int :$number_to_skip = 0, Int :$number_to_return = 0,
+ Bool :$no_cursor_timeout = False
+) {
+
+ my $flags = +$no_cursor_timeout +< 4;
+ my $OP_REPLY = self.wire.OP_QUERY( self, $flags, $number_to_skip, $number_to_return, %query );
+
return MongoDB::Cursor.new(
collection => self,
- query => %query,
+ OP_REPLY => $OP_REPLY,
);
}
-method update ( %selector, %update ) {
- MongoDB.wire.OP_UPDATE( self, %selector, %update );
-}
+method update (
+ %selector, %update,
+ Bool :$upsert = False, Bool :$multi_update = False
+) {
+
+ my $flags = +$upsert
+ + +$multi_update +< 1;
-method delete ( %selector = { } ) {
- MongoDB.wire.OP_DELETE( self, %selector );
+ self.wire.OP_UPDATE( self, $flags, %selector, %update );
}
+method remove (
+ %selector = { },
+ Bool :$single_remove = False
+) {
+
+ my $flags = +$single_remove;
+
+ self.wire.OP_DELETE( self, $flags, %selector );
+}
View
@@ -1,10 +1,11 @@
-class MongoDB::Connection;
-
+use MongoDB::Protocol;
use MongoDB::DataBase;
+class MongoDB::Connection does MongoDB::Protocol;
+
has IO::Socket::INET $!sock;
-submethod BUILD ( Str $host = 'localhost', Int $port = 27017 ) {
+submethod BUILD ( Str :$host = 'localhost', Int :$port = 27017 ) {
$!sock = IO::Socket::INET.new( host => $host, port => $port );
}
@@ -19,15 +20,15 @@ method database ( Str $name ) {
method send ( Buf $b, Bool $has_response ) {
- $!sock.send( $b.unpack( 'A*' ) );
+ $!sock.send( [~]$b.list>>.chr );
- if $has_response {
+ # some calls do not expect response
+ return unless $has_response;
- # obtain int32 response length
- my $l = $!sock.recv( 4 ).encode;
- my $r = $!sock.recv( $l.unpack( 'V' ) - 4 ).encode;
+ # check response size
+ my $l = $!sock.read( 4 );
+ my $w = self.wire._int32( $l.list ) - 4;
- # receive remaining response bytes from socket
- return Buf.new( $l.contents.list, $r.contents.list );
- }
+ # receive remaining response bytes from socket
+ return $l ~ $!sock.read( $w );
}
View
@@ -1,41 +1,51 @@
-class MongoDB::Cursor;
+use MongoDB::Protocol;
-has MongoDB::Collection $.collection is rw;
+class MongoDB::Cursor does MongoDB::Protocol;
-has %.query is rw;
+has $.collection is rw;
# int64 (8 byte buffer)
has Buf $.id is rw;
# batch of documents in last response
-has @!documents is rw;
+has @.documents is rw;
-submethod BUILD ( MongoDB::Collection $collection, %query ) {
+submethod BUILD ( :$collection, :%OP_REPLY ) {
$.collection = $collection;
- %.query = %query;
-
- MongoDB.wire.OP_QUERY( self );
+ # assign cursorID
+ $.id = %OP_REPLY{ 'cursor_id' };
+
+ # assign documents
+ @.documents = %OP_REPLY{ 'documents' }.list;
}
method fetch ( ) {
# there are no more documents in last response batch
# but there is next batch to fetch from database
- if not @!documents and [+]$!id.contents {
- MongoDB.wire.OP_GETMORE( self );
+ if not @.documents and [+]$.id.list {
+
+ # request next batch of documents
+ my %OP_REPLY = self.wire.OP_GETMORE( self );
+
+ # assign cursorID,
+ # it may change to "0" if there are no more documents to fetch
+ $.id = %OP_REPLY{ 'cursor_id' };
+
+ # assign documents
+ @.documents = %OP_REPLY{ 'documents' }.list;
}
- return @!documents.shift;
+ return @.documents.shift;
}
-method _feed ( %OP_REPLY ) {
+method kill ( ) {
- # assign cursorID
- # buffer of 0x00 x 8 means there are no more documents to fetch
- $.id = %OP_REPLY{ 'cursor_id' };
-
- # assign documents
- @!documents = %OP_REPLY{ 'documents' }.list;
+ # invalidate cursor on database
+ self.wire.OP_KILL_CURSORS( self );
+
+ # invalidate cursor id
+ $.id = Buf.new( 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 );
}
View
@@ -1,11 +1,11 @@
-class MongoDB::DataBase;
-
use MongoDB::Collection;
-has MongoDB::Connection $.connection is rw;
+class MongoDB::DataBase;
+
+has $.connection is rw;
has Str $.name is rw;
-submethod BUILD ( MongoDB::Connection $connection, Str $name ) {
+submethod BUILD ( :$connection, Str :$name ) {
$.connection = $connection;
Oops, something went wrong.

0 comments on commit f4d99ab

Please sign in to comment.