Permalink
Browse files

Basic flags support and kill for cursor.

  • Loading branch information...
1 parent 32d665b commit f0570aee208e7944e2a57d5eccf7bedd05ca8b23 @bbkr bbkr committed Dec 22, 2011
Showing with 326 additions and 52 deletions.
  1. +1 −1 META.info
  2. +10 −4 MongoDB Perl6 driver.xcodeproj/project.pbxproj
  3. +26 −18 README
  4. +12 −0 changelog.txt
  5. +1 −1 lib/MongoDB.pm
  6. +35 −9 lib/MongoDB/Collection.pm
  7. +11 −9 lib/MongoDB/Cursor.pm
  8. +37 −10 lib/MongoDB/Wire.pm
  9. +69 −0 t/find.t
  10. +40 −0 t/insert.t
  11. +38 −0 t/remove.t
  12. +46 −0 t/update.t
View
2 META.info
@@ -1,6 +1,6 @@
{
"name" : "MongoDB",
- "version" : "0.2",
+ "version" : "0.3",
"description" : "MongoDB driver",
"author" : "Pawel Pabian",
"authority" : "bbkr",
View
14 MongoDB Perl6 driver.xcodeproj/project.pbxproj
@@ -7,18 +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 */
@@ -33,6 +36,7 @@
81C246FB1416C6B8000A420F = {
isa = PBXGroup;
children = (
+ 8128962C14A34B6F00BDC0AC /* changelog.txt */,
81322EC61441DCD900D0AF15 /* logotype */,
81322EC81441DCD900D0AF15 /* META.info */,
81C2470D1416C90A000A420F /* t */,
@@ -66,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
44 README
@@ -5,11 +5,8 @@ This is working MongoDB driver at early stage of development.
VERSION
-This version should be used with BSON 0.2.
-
-Version 0.2 is compatible with Rakudo 2011.09+,
-and will be merged into main branch after Star release.
-
+This module is compatible with Rakudo 2011.09+
+and requires BSON 0.2+.
SYNOPSIS
@@ -19,7 +16,7 @@ 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;
@@ -67,36 +64,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
12 changelog.txt
@@ -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
2 lib/MongoDB.pm
@@ -1,4 +1,4 @@
-module MongoDB;
+module MongoDB:ver<0.3>;
use MongoDB::Wire;
View
44 lib/MongoDB/Collection.pm
@@ -14,23 +14,49 @@ submethod BUILD ( :$database, Str :$name ) {
$.name = $name;
}
-method insert ( *@documents ) {
- self.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 ) {
- self.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 = { } ) {
- self.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
20 lib/MongoDB/Cursor.pm
@@ -4,23 +4,16 @@ class MongoDB::Cursor does MongoDB::Protocol;
has $.collection is rw;
-has %.query is rw;
-
# int64 (8 byte buffer)
has Buf $.id is rw;
# batch of documents in last response
has @.documents is rw;
-submethod BUILD ( :$collection, :%query ) {
+submethod BUILD ( :$collection, :%OP_REPLY ) {
$.collection = $collection;
- %.query = %query;
-
- # request first batch of documents
- my %OP_REPLY = self.wire.OP_QUERY( self );
-
# assign cursorID
$.id = %OP_REPLY{ 'cursor_id' };
@@ -37,7 +30,8 @@ method fetch ( ) {
# request next batch of documents
my %OP_REPLY = self.wire.OP_GETMORE( self );
- # assign cursorID
+ # assign cursorID,
+ # it may change to "0" if there are no more documents to fetch
$.id = %OP_REPLY{ 'cursor_id' };
# assign documents
@@ -47,3 +41,11 @@ method fetch ( ) {
return @.documents.shift;
}
+method kill ( ) {
+
+ # 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
47 lib/MongoDB/Wire.pm
@@ -105,31 +105,31 @@ method OP_INSERT ( $collection, Int $flags, *@documents ) {
$collection.database.connection.send( $msg_header ~ $OP_INSERT, False );
}
-method OP_QUERY ( $cursor ) {
+method OP_QUERY ( $collection, $flags, $number_to_skip, $number_to_return, %query ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPQUERY
my Buf $OP_QUERY =
# int32 flags
# bit vector of query options
- self._int32( 0 )
+ self._int32( $flags )
# cstring fullCollectionName
# "dbname.collectionname"
- ~ self._cstring( join '.', $cursor.collection.database.name, $cursor.collection.name )
+ ~ self._cstring( join '.', $collection.database.name, $collection.name )
# int32 numberToSkip
# number of documents to skip
- ~ self._int32( 0 )
+ ~ self._int32( $number_to_skip )
# int32 numberToReturn
# number of documents to return
# in the first OP_REPLY batch
- ~ self._int32( 0 )
+ ~ self._int32( $number_to_return )
# document query
# query object
- ~ self._document( $cursor.query );
+ ~ self._document( %query );
# TODO
# [ document returnFieldSelector; ]
@@ -140,7 +140,7 @@ method OP_QUERY ( $cursor ) {
my Buf $msg_header = self._msg_header( $OP_QUERY.elems, 'OP_QUERY' );
# send message and wait for response
- my Buf $OP_REPLY = $cursor.collection.database.connection.send( $msg_header ~ $OP_QUERY, True );
+ my Buf $OP_REPLY = $collection.database.connection.send( $msg_header ~ $OP_QUERY, True );
# parse response
my %OP_REPLY = self.OP_REPLY( $OP_REPLY );
@@ -199,7 +199,34 @@ method OP_GETMORE ( $cursor ) {
return %OP_REPLY;
}
-method OP_UPDATE ( $collection, %selector, %update, Int $flags = 2 ) {
+method OP_KILL_CURSORS ( *@cursors ) {
+ # http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPKILLCURSORS
+
+ my Buf $OP_KILL_CURSORS =
+
+ # int32 ZERO
+ # 0 - reserved for future use
+ self._int32( 0 )
+
+ # int32 numberOfCursorIDs
+ # number of cursorIDs in message
+ ~ self._int32( +@cursors );
+
+ # int64* cursorIDs
+ # sequence of cursorIDs to close
+ for @cursors -> $cursor {
+ $OP_KILL_CURSORS ~= $cursor.id;
+ }
+
+ # MsgHeader header
+ # standard message header
+ my Buf $msg_header = self._msg_header( $OP_KILL_CURSORS.elems, 'OP_KILL_CURSORS' );
+
+ # send message without waiting for response
+ @cursors[0].collection.database.connection.send( $msg_header ~ $OP_KILL_CURSORS, False );
+}
+
+method OP_UPDATE ( $collection, Int $flags, %selector, %update ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPUPDATE
my Buf $OP_UPDATE =
@@ -232,7 +259,7 @@ method OP_UPDATE ( $collection, %selector, %update, Int $flags = 2 ) {
$collection.database.connection.send( $msg_header ~ $OP_UPDATE, False );
}
-method OP_DELETE ( $collection, %selector, Int $flags = 0 ) {
+method OP_DELETE ( $collection, Int $flags, %selector ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPDELETE
my Buf $OP_DELETE =
@@ -296,7 +323,7 @@ method OP_REPLY ( Buf $b ) {
);
- # extract documents in message
+ # extract documents from message
for ^%OP_REPLY{ 'number_returned' } {
my %document = self._document( $a );
%OP_REPLY{ 'documents' }.push( { %document } );
View
69 t/find.t
@@ -0,0 +1,69 @@
+BEGIN { @*INC.unshift( 'lib' ) }
+
+use Test;
+use MongoDB;
+
+plan( 9 );
+
+my $connection = MongoDB::Connection.new;
+my $database = $connection.database( 'test' );
+my $collection = $database.collection( 'perl6_driver' );
+
+# TODO replace with drop when available
+$collection.remove( );
+
+my (@documents, $cursor);
+
+# feed test data
+@documents.push( { 'foo' => $_} ) for ^128;
+$collection.insert( @documents );
+
+lives_ok {
+ $cursor = $collection.find( )
+}, 'initialize cursor for all documents';
+
+lives_ok
+{
+ @documents = ( );
+ while $cursor.fetch( ) -> %document {
+ @documents.push( { %document } );
+ }
+}, 'fetch all documents';
+
+# TODO compare documents
+
+lives_ok {
+ $cursor = $collection.find( number_to_return => 8 )
+}, 'initialize cursor for given amount of documents';
+
+lives_ok {
+ $cursor.kill();
+}, 'kill cursor';
+
+is ([+]$cursor.id.list), 0, 'cursor is killed';
+
+lives_ok
+{
+ @documents = ( );
+ while $cursor.fetch( ) -> %document {
+ @documents.push( { %document } );
+ }
+}, 'fetch given amount of documents';
+
+# TODO compare documents
+
+lives_ok {
+ $cursor = $collection.find( number_to_return => 1 )
+}, 'initialize cursor for one document';
+
+is ([+]$cursor.id.list), 0, 'cursor for one document is closed automatically';
+
+lives_ok
+{
+ @documents = ( );
+ while $cursor.fetch( ) -> %document {
+ @documents.push( { %document } );
+ }
+}, 'fetch one document';
+
+# TODO compare documents
View
40 t/insert.t
@@ -0,0 +1,40 @@
+BEGIN { @*INC.unshift( 'lib' ) }
+
+use Test;
+use MongoDB;
+
+plan( 5 );
+
+my $connection = MongoDB::Connection.new;
+my $database = $connection.database( 'test' );
+my $collection = $database.collection( 'perl6_driver' );
+
+# TODO replace with drop when available
+$collection.remove( );
+
+lives_ok {
+ $collection.insert( { 'foo' => 0 } );
+}, 'insert single document';
+
+lives_ok {
+ $collection.insert( { 'bar' => 0 }, { 'bar' => 1 } );
+}, 'insert multiple documents';
+
+# TODO simulate failure, maybe violate constraint?
+lives_ok {
+ $collection.insert( { 'baz' => 0 }, :continue_on_error );
+}, 'insert single document with continue_on_error flag';
+
+dies_ok {
+ $collection.insert( );
+}, 'insert without documents is forbidden';
+
+dies_ok {
+ $collection.insert( 1, "a" );
+}, 'insert fails on incorrect document types';
+
+# TODO check output, expected result
+# { "_id" : ObjectId("..."), "foo" : 0 }
+# { "_id" : ObjectId("..."), "bar" : 0 }
+# { "_id" : ObjectId("..."), "bar" : 1 }
+# { "_id" : ObjectId("..."), "baz" : 0 }
View
38 t/remove.t
@@ -0,0 +1,38 @@
+BEGIN { @*INC.unshift( 'lib' ) }
+
+use Test;
+use MongoDB;
+
+plan( 4 );
+
+my $connection = MongoDB::Connection.new;
+my $database = $connection.database( 'test' );
+my $collection = $database.collection( 'perl6_driver' );
+
+# TODO replace with drop when available
+$collection.remove( );
+
+# feed test data
+$collection.insert( { 'foo' => 0 }, { 'foo' => 0 }, { 'bar' => 0 }, { 'bar' => 0 } );
+
+lives_ok {
+ $collection.remove( { 'foo' => 0 } );
+}, 'remove many documents';
+
+lives_ok {
+ $collection.remove( { 'bar' => 0 }, :single_remove );
+}, 'remove single document with single_remove flag';
+
+lives_ok {
+ $collection.remove( { 'baz' => 0 } );
+}, 'remove no documents';
+
+# TODO check output, expected result
+# { "_id" : ObjectId("..."), "bar" : 0 }
+
+lives_ok {
+ $collection.remove( );
+}, 'remove all documents';
+
+# TODO check output, expected result
+# empty collection
View
46 t/update.t
@@ -0,0 +1,46 @@
+BEGIN { @*INC.unshift( 'lib' ) }
+
+use Test;
+use MongoDB;
+
+plan( 6 );
+
+my $connection = MongoDB::Connection.new;
+my $database = $connection.database( 'test' );
+my $collection = $database.collection( 'perl6_driver' );
+
+# TODO replace with drop when available
+$collection.remove( );
+
+# feed test data
+$collection.insert( { 'foo' => 0 }, { 'foo' => 0 } );
+
+lives_ok {
+ $collection.update( { 'foo' => 0 }, { '$inc' => { 'foo' => 1 } } );
+}, 'update single document';
+
+lives_ok {
+ $collection.update( { 'foo' => { '$exists' => True } }, { '$inc' => { 'foo' => 1 } }, :multi_update );
+}, 'update many documents with multi_update flag';
+
+lives_ok {
+ $collection.update( { 'bar' => 0 }, { '$inc' => { 'bar' => 1 } } );
+}, 'update nonexisting document';
+
+
+lives_ok {
+ $collection.update( { 'bar' => 0 }, { '$inc' => { 'bar' => 1 } }, :upsert );
+}, 'update nonexisting document with upsert flag';
+
+dies_ok {
+ $collection.update( );
+}, 'update without selector and document is forbidden';
+
+dies_ok {
+ $collection.update( 1, "a" );
+}, 'update fails on incorrect document types';
+
+# TODO check output, expected result
+# { "_id" : ObjectId("..."), "foo" : 2 }
+# { "_id" : ObjectId("..."), "foo" : 1 }
+# { "_id" : ObjectId("..."), "bar" : 1 }

0 comments on commit f0570ae

Please sign in to comment.