Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'nom'

  • Loading branch information...
commit f4d99ab4fc6869133a8463c56fa47f4dcc347e42 2 parents c67d3c3 + a0f2512
Pawel Pabian bbkr authored
2  META.info
View
@@ -1,6 +1,6 @@
{
"name" : "MongoDB",
- "version" : "0.1",
+ "version" : "0.3",
"description" : "MongoDB driver",
"author" : "Pawel Pabian",
"authority" : "bbkr",
16 MongoDB Perl6 driver.xcodeproj/project.pbxproj
View
@@ -7,8 +7,14 @@
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>"; };
@@ -16,8 +22,6 @@
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>";
48 README
View
@@ -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,13 +68,28 @@ 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
@@ -85,22 +97,18 @@ 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
12 changelog.txt
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.
10 lib/MongoDB.pm
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;
53 lib/MongoDB/Collection.pm
View
@@ -1,11 +1,12 @@
-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;
@@ -13,23 +14,49 @@ submethod BUILD ( MongoDB::DataBase $database, Str $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 );
+}
23 lib/MongoDB/Connection.pm
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 );
}
46 lib/MongoDB/Cursor.pm
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 );
}
8 lib/MongoDB/DataBase.pm
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;
8 lib/MongoDB/Protocol.pm
View
@@ -0,0 +1,8 @@
+use MongoDB::Wire;
+
+role MongoDB::Protocol {
+
+ our $wp = MongoDB::Wire.new;
+
+ method ^wire { return $wp };
+};
140 lib/MongoDB/Wire.pm
View
@@ -2,11 +2,12 @@ use BSON;
class MongoDB::Wire is BSON;
-has Bool $.debug is rw = False;
-
# Implements Mongo Wire Protocol
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol
+has Bool $.debug is rw = False;
+has Int $.request_id is rw = 0;
+
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-RequestOpcodes
has %.op_codes = (
'OP_REPLY' => 1, # Reply to a client request. responseTo is set
@@ -24,7 +25,7 @@ multi method _msg_header ( Int $length, Str $op_code ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-StandardMessageHeader
# struct MsgHeader
- my $msg_header =
+ my Buf $msg_header =
# int32 messageLength
# total message size, including this
@@ -32,7 +33,7 @@ multi method _msg_header ( Int $length, Str $op_code ) {
# int32 requestID
# identifier for this message
- ~ self._int32( ( 1 .. 2147483647 ).pick )
+ ~ self._int32( $.request_id++ )
# int32 responseTo
# requestID from the original request
@@ -46,7 +47,7 @@ multi method _msg_header ( Int $length, Str $op_code ) {
return $msg_header;
}
-multi method _msg_header ( Buf $b ) {
+multi method _msg_header ( Array $a ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-StandardMessageHeader
# struct MsgHeader
@@ -54,20 +55,20 @@ multi method _msg_header ( Buf $b ) {
# int32 messageLength
# total message size, including this
- 'message_length' => self._int32( $b ),
+ 'message_length' => self._int32( $a ),
# int32 requestID
# identifier for this message
- 'request_id' => self._int32( $b ),
+ 'request_id' => self._int32( $a ),
# int32 responseTo
# requestID from the original request
# (used in reponses from db)
- 'response_to' => self._int32( $b ),
+ 'response_to' => self._int32( $a ),
# int32 opCode
# request type
- 'op_code' => self._int32( $b ),
+ 'op_code' => self._int32( $a ),
);
@@ -77,10 +78,10 @@ multi method _msg_header ( Buf $b ) {
return %msg_header;
}
-method OP_INSERT ( MongoDB::Collection $collection, Int $flags, *@documents ) {
+method OP_INSERT ( $collection, Int $flags, *@documents ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPINSERT
- my $OP_INSERT =
+ my Buf $OP_INSERT =
# int32 flags
# bit vector
@@ -89,7 +90,7 @@ method OP_INSERT ( MongoDB::Collection $collection, Int $flags, *@documents ) {
# cstring fullCollectionName
# "dbname.collectionname"
~ self._cstring( join '.', $collection.database.name, $collection.name );
-
+
# document* documents
# one or more documents to insert into the collection
for @documents -> $document {
@@ -98,37 +99,37 @@ method OP_INSERT ( MongoDB::Collection $collection, Int $flags, *@documents ) {
# MsgHeader header
# standard message header
- my $msg_header = self._msg_header( +$OP_INSERT.contents, 'OP_INSERT' );
+ my Buf $msg_header = self._msg_header( $OP_INSERT.elems, 'OP_INSERT' );
# send message without waiting for response
$collection.database.connection.send( $msg_header ~ $OP_INSERT, False );
}
-method OP_QUERY ( MongoDB::Cursor $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 $OP_QUERY =
+ 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; ]
@@ -136,10 +137,10 @@ method OP_QUERY ( MongoDB::Cursor $cursor ) {
# MsgHeader header
# standard message header
- my $msg_header = self._msg_header( +$OP_QUERY.contents, 'OP_QUERY' );
+ my Buf $msg_header = self._msg_header( $OP_QUERY.elems, 'OP_QUERY' );
# send message and wait for response
- my $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 );
@@ -151,13 +152,13 @@ method OP_QUERY ( MongoDB::Cursor $cursor ) {
# TODO check if requestID matches responseTo
# return response back to cursor
- $cursor._feed( %OP_REPLY );
+ return %OP_REPLY;
}
-method OP_GETMORE ( MongoDB::Cursor $cursor ) {
+method OP_GETMORE ( $cursor ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPGETMORE
- my $OP_GETMORE =
+ my Buf $OP_GETMORE =
# int32 ZERO
# 0 - reserved for future use
@@ -178,10 +179,10 @@ method OP_GETMORE ( MongoDB::Cursor $cursor ) {
# MsgHeader header
# standard message header
# (watch out for inconsistent OP_code and messsage name)
- my $msg_header = self._msg_header( +$OP_GETMORE.contents, 'OP_GET_MORE' );
+ my Buf $msg_header = self._msg_header( $OP_GETMORE.elems, 'OP_GET_MORE' );
# send message and wait for response
- my $OP_REPLY = $cursor.collection.database.connection.send( $msg_header ~ $OP_GETMORE, True );
+ my Buf $OP_REPLY = $cursor.collection.database.connection.send( $msg_header ~ $OP_GETMORE, True );
# parse response
my %OP_REPLY = self.OP_REPLY( $OP_REPLY );
@@ -195,13 +196,40 @@ method OP_GETMORE ( MongoDB::Cursor $cursor ) {
# TODO check if cursorID matches (if present)
# return response back to cursor
- $cursor._feed( %OP_REPLY );
+ return %OP_REPLY;
+}
+
+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 ( MongoDB::Collection $collection, %selector, %update, Int $flags = 2 ) {
+method OP_UPDATE ( $collection, Int $flags, %selector, %update ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPUPDATE
- my $OP_UPDATE =
+ my Buf $OP_UPDATE =
# int32 ZERO
# 0 - reserved for future use
@@ -225,16 +253,16 @@ method OP_UPDATE ( MongoDB::Collection $collection, %selector, %update, Int $fla
# MsgHeader header
# standard message header
- my $msg_header = self._msg_header( +$OP_UPDATE.contents, 'OP_UPDATE' );
+ my Buf $msg_header = self._msg_header( $OP_UPDATE.elems, 'OP_UPDATE' );
# send message without waiting for response
$collection.database.connection.send( $msg_header ~ $OP_UPDATE, False );
}
-method OP_DELETE ( MongoDB::Collection $collection, %selector, Int $flags = 0 ) {
+method OP_DELETE ( $collection, Int $flags, %selector ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPDELETE
- my $OP_DELETE =
+ my Buf $OP_DELETE =
# int32 ZERO
# 0 - reserved for future use
@@ -254,7 +282,7 @@ method OP_DELETE ( MongoDB::Collection $collection, %selector, Int $flags = 0 )
# MsgHeader header
# standard message header
- my $msg_header = self._msg_header( +$OP_DELETE.contents, 'OP_DELETE' );
+ my Buf $msg_header = self._msg_header( $OP_DELETE.elems, 'OP_DELETE' );
# send message without waiting for response
$collection.database.connection.send( $msg_header ~ $OP_DELETE, False );
@@ -263,69 +291,57 @@ method OP_DELETE ( MongoDB::Collection $collection, %selector, Int $flags = 0 )
method OP_REPLY ( Buf $b ) {
# http://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPREPLY
+ my $a = $b.list;
+
my %OP_REPLY = (
# MsgHeader header
# standard message header
- 'msg_header' => self._msg_header( $b ),
+ 'msg_header' => self._msg_header( $a ),
# int32 responseFlags
# bit vector
- 'response_flags' => self._int32( $b ),
+ 'response_flags' => self._int32( $a ),
# int64 cursorID
# cursor id if client needs to do get more's
# TODO big integers are not yet implemented in Rakudo
# so cursor is build using raw Buf
- 'cursor_id' => self._nyi( $b, 8 ),
+ 'cursor_id' => self._nyi( $a, 8 ),
# int32 startingFrom
# where in the cursor this reply is starting
- 'starting_from' => self._int32( $b ),
+ 'starting_from' => self._int32( $a ),
# int32 numberReturned
# number of documents in the reply
- 'number_returned' => self._int32( $b ),
+ 'number_returned' => self._int32( $a ),
# document* documents
# documents
- 'documents' => ( ),
+ 'documents' => [ ],
);
- # extract documents in message
+ # extract documents from message
for ^%OP_REPLY{ 'number_returned' } {
- my %document = self._document( $b );
+ my %document = self._document( $a );
%OP_REPLY{ 'documents' }.push( { %document } );
}
# every response byte must be consumed
- die 'Response ended incorrectly' if +$b.contents;
+ die 'Unexpected bytes at the end of response' if $a.elems;
return %OP_REPLY;
}
-multi method _nyi ( Buf $b, Int $length ) {
- # fetch given amount of bytes from buffer and return as buffer
+multi method _nyi ( Array $a, Int $length ) {
+ # fetch given amount of bytes from Array and return as Buffer
# mostly used to jump over not yet implemented decoding
- my $nyi = Buf.new( );
+ my @a;
- $nyi.contents.push( $b.contents.shift ) for ^$length;
-
- return $nyi;
-}
+ @a.push( $a.shift ) for ^$length;
-# HACK to concatenate 2 Buf()s
-# workaround for https://rt.perl.org/rt3/Public/Bug/Display.html?id=96430
-multi sub infix:<~>(Buf $a, Buf $b) {
-
- return Buf.new( $a.contents.list, $b.contents.list );
-}
-
-# HACK to merge 2 Buf()s
-# workaround for https://rt.perl.org/rt3/Public/Bug/Display.html?id=96430
-multi sub infix:<~=>(Buf $a, Buf $b) {
-
- $a.contents.push( $b.contents );
+ return Buf.new( @a );
}
BIN  logotype/logo_32x32.png
View
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
69 t/find.t
View
@@ -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
40 t/insert.t
View
@@ -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 }
9 t/load.t
View
@@ -1,9 +0,0 @@
-BEGIN { @*INC.unshift( 'lib' ) }
-
-use Test;
-
-plan( 1 );
-
-lives_ok
- { use MongoDB },
- 'Load classes';
38 t/remove.t
View
@@ -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
46 t/update.t
View
@@ -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 }
78 t/wire.t
View
@@ -1,78 +0,0 @@
-BEGIN { @*INC.unshift( 'lib' ) }
-
-use Test;
-use MongoDB;
-
-plan( 12 );
-
-my $connection = MongoDB::Connection.new( );
-my $database = $connection.database( 'test' );
-my $collection = $database.collection( 'perl6_driver' );
-my $cursor;
-my %document;
-my @documents;
-
-# TODO replace this test with drop collection
-lives_ok
- { $collection.delete( ) },
- 'delete all old documents';
-
-lives_ok
- { $collection.insert( { 'ala' => 'kot' } ) },
- 'single insert';
-
-lives_ok
- {
- $collection.update(
- { 'ala' => 'kot' },
- { '$set' => { 'zażółć' => 'gęślą jaźń' } }
- )
- },
- 'single update';
-
-lives_ok
- { $cursor = $collection.find( ) },
- 'initialize cursor for all documents';
-
-lives_ok
- { %document = $cursor.fetch( ) },
- 'fetch the only document';
-
-isa_ok
- %document.delete( '_id' ),
- BSON::ObjectId,
- 'check document _id';
-
-is_deeply
- %document,
- { "ala" => "kot", "zażółć" => "gęślą jaźń" },
- 'check document content';
-
-is_deeply
- ?$cursor.fetch( ),
- False,
- 'no more documents to fetch';
-
-lives_ok
- { $collection.delete( ) },
- 'delete all documents';
-
-lives_ok
- {
- @documents.push( { "mosquito" => $_} ) for ^128;
- $collection.insert( @documents );
- @documents = ( );
- },
- 'batch insert';
-
-lives_ok
- { $cursor = $collection.find( ) },
- 'initialize cursor for all documents';
-
-lives_ok
- {
- while $cursor.fetch( ) -> %document {
- @documents.push( { %document } );
- }
- },
- 'fetch all documents';
Please sign in to comment.
Something went wrong with that request. Please try again.