diff --git a/Changes b/Changes index 10443b3..371f573 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +2.0 + - Promises support for all non-blocking methods + - Fix Mojolicious 8.x compatibility + - Use official MongoDB BSON parser + 1.31 - Fix typo in the synopsis (#33) diff --git a/Makefile.PL b/Makefile.PL index c773b06..7d1f29e 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -26,6 +26,9 @@ WriteMakefile( }, no_index => {directory => ['t']} }, - PREREQ_PM => {Mojolicious => '5.40'}, + PREREQ_PM => { + Mojolicious => '8.40', + BSON => '1.12.2', + }, test => {TESTS => 't/*.t t/*/*.t'} ); diff --git a/README.md b/README.md index ce968c9..303e259 100644 --- a/README.md +++ b/README.md @@ -1,11 +1,12 @@ Pure-Perl non-blocking I/O MongoDB driver, optimized for use with the [Mojolicious](http://mojolicio.us) real-time web framework. + It also supports [BSON::XS](https://metacpan.org/pod/BSON::XS) parser ```perl use Mojolicious::Lite; use Mango; -use Mango::BSON ':bson'; +use BSON:Types ':all'; my $uri = 'mongodb://:@/'; helper mango => sub { state $mango = Mango->new($uri) }; @@ -18,21 +19,17 @@ get '/' => sub { my $ip = $c->tx->remote_address; # Store information about current visitor - $collection->insert({when => bson_time, from => $ip} => sub { - my ($collection, $err, $oid) = @_; - - return $c->reply->exception($err) if $err; - + $collection->insert_p({when => bson_time, from => $ip})->then(sub { + my ($oid) = @_; # Retrieve information about previous visitors - $collection->find->sort({when => -1})->fields({_id => 0})->all(sub { - my ($collection, $err, $docs) = @_; - - return $c->reply->exception($err) if $err; - + $collection->find->sort({when => -1})->fields({_id => 0})->all_p->then(sub { + my ($docs) = @_; # And show it to current visitor $c->render(json => $docs); - }); - }); + }) + })->catch(sub { + return $c->reply->exception(@_) + }) }; app->start; diff --git a/lib/Mango.pm b/lib/Mango.pm index 40b11d7..d495c0e 100644 --- a/lib/Mango.pm +++ b/lib/Mango.pm @@ -3,7 +3,7 @@ use Mojo::Base 'Mojo::EventEmitter'; use Carp 'croak'; use Hash::Util::FieldHash; -use Mango::BSON 'bson_doc'; +use BSON::Types 'bson_doc'; use Mango::Database; use Mango::Protocol; use Mojo::IOLoop; @@ -29,7 +29,7 @@ has w => 1; # is good for security. Hash::Util::FieldHash::fieldhash my %AUTH; -our $VERSION = '1.30'; +our $VERSION = '2.0.1'; sub DESTROY { shift->_cleanup } @@ -330,7 +330,7 @@ sub _write { =head1 NAME -Mango - Pure-Perl non-blocking I/O MongoDB driver +Mango - Pure-Perl non-blocking I/O MongoDB driver. Supports BSON::XS parser if it's available. =head1 SYNOPSIS @@ -357,9 +357,9 @@ Mango - Pure-Perl non-blocking I/O MongoDB driver mango->db('test')->collection('foo')->remove({bar => 'yada'}); # Insert document with special BSON types - use Mango::BSON ':bson'; + use BSON::Types ':all'; my $oid = mango->db('test')->collection('foo') - ->insert({data => bson_bin("\x00\x01"), now => bson_time}); + ->insert({data => bson_bytes("\x00\x01"), now => bson_time}); # Non-blocking concurrent find my $delay = Mojo::IOLoop->delay(sub { @@ -401,7 +401,7 @@ in this distribution is no replacement for it. Look at L for CRUD operations. Many arguments passed to methods as well as values of attributes get -serialized to BSON with L, which provides many helper functions +serialized to BSON with L, which provides many helper functions you can use to generate data types that are not available natively in Perl. All connections will be reset automatically if a new process has been forked, this allows multiple processes to share the same L object safely. diff --git a/lib/Mango/Auth/SCRAM.pm b/lib/Mango/Auth/SCRAM.pm index 99b7711..6d12af8 100644 --- a/lib/Mango/Auth/SCRAM.pm +++ b/lib/Mango/Auth/SCRAM.pm @@ -2,7 +2,7 @@ package Mango::Auth::SCRAM; use Mojo::Base 'Mango::Auth'; use Mojo::Util qw(dumper md5_sum encode b64_encode b64_decode); -use Mango::BSON 'bson_doc'; +use BSON::Types 'bson_doc'; EVAL: { local $@; @@ -20,50 +20,44 @@ sub _credentials { } sub _authenticate { - my ($self, $id) = @_; - - my $mango = $self->mango; - my $cnx = $self->mango->{connections}{$id}; - my $creds = $self->{credentials}; - - my ($db, $user, $pass) = @$creds; - - my $scram_client = Authen::SCRAM::Client->new( - skip_saslprep => 1, - username => $user, - password => $pass - ); - - my $delay = Mojo::IOLoop::Delay->new; - my $conv_id; - - $delay->steps( - sub { - my ($d, $mango, $err, $doc) = @_; - $conv_id = $doc->{conversationId}; - my $final_msg = $scram_client->final_msg(b64_decode $doc->{payload}); - - my $command = $self->_cmd_sasl_continue($conv_id, $final_msg); - $mango->_fast($id, $db, $command, $d->begin(0)); - }, - sub { - my ($d, $mango, $err, $doc) = @_; - $scram_client->validate(b64_decode $doc->{payload}); - - my $command = $self->_cmd_sasl_continue($conv_id, ''); - $mango->_fast($id, $db, $command, $d->begin(0)); - }, - sub { - my ($d, $mango, $err, $doc) = @_; - $mango->emit(connection => $id)->_next; - } - ); - - my $command = $self->_cmd_sasl_start($scram_client->first_msg); - $mango->_fast($id, $db, $command, $delay->begin(0)); - - $delay->wait; - $delay->ioloop->one_tick unless $delay->ioloop->is_running; + my ($self, $id) = @_; + + my $mango = $self->mango; + my $cnx = $self->mango->{connections}{$id}; + my $creds = $self->{credentials}; + + my ($db, $user, $pass) = @$creds; + + my $scram_client = Authen::SCRAM::Client->new( + skip_saslprep => 1, + username => $user, + password => $pass + ); + + my $loop = Mojo::IOLoop->new; + my $conv_id; + + my $command = $self->_cmd_sasl_start($scram_client->first_msg); + $mango->_fast($id, $db, $command, sub { + my ($mango, $err, $doc) = @_; + $conv_id = $doc->{conversationId}; + my $final_msg = $scram_client->final_msg(b64_decode $doc->{payload}); + + my $command = $self->_cmd_sasl_continue($conv_id, $final_msg); + $mango->_fast($id, $db, $command, sub { + my ($mango, $err, $doc) = @_; + $scram_client->validate(b64_decode $doc->{payload}); + + my $command = $self->_cmd_sasl_continue($conv_id, ''); + $mango->_fast($id, $db, $command, sub { + my ($mango, $err, $doc) = @_; + $mango->emit(connection => $id)->_next; + $loop->stop; + }) + }) + }); + + $loop->start; } sub _cmd_sasl_start { diff --git a/lib/Mango/BSON.pm b/lib/Mango/BSON.pm index e7bbcbb..a4e99f3 100644 --- a/lib/Mango/BSON.pm +++ b/lib/Mango/BSON.pm @@ -1,569 +1,36 @@ package Mango::BSON; use Mojo::Base -strict; -use re 'regexp_pattern'; -use Carp 'croak'; use Exporter 'import'; -use Mango::BSON::Binary; -use Mango::BSON::Code; -use Mango::BSON::Document; -use Mango::BSON::Number; -use Mango::BSON::ObjectID; -use Mango::BSON::Time; -use Mango::BSON::Timestamp; -use Mojo::JSON; -use Scalar::Util 'blessed'; - -my @BSON = ( - qw(bson_bin bson_code bson_dbref bson_decode bson_doc bson_double), - qw(bson_encode bson_false bson_int32 bson_int64 bson_length bson_max), - qw(bson_min bson_oid bson_raw bson_time bson_true bson_ts) -); -our @EXPORT_OK = (@BSON, 'encode_cstring'); -our %EXPORT_TAGS = (bson => \@BSON); - -# Types -use constant { - DOUBLE => "\x01", - STRING => "\x02", - DOCUMENT => "\x03", - ARRAY => "\x04", - BINARY => "\x05", - UNDEFINED => "\x06", - OBJECT_ID => "\x07", - BOOL => "\x08", - DATETIME => "\x09", - NULL => "\x0a", - REGEX => "\x0b", - CODE => "\x0d", - CODE_SCOPE => "\x0f", - INT32 => "\x10", - TIMESTAMP => "\x11", - INT64 => "\x12", - MIN_KEY => "\xff", - MAX_KEY => "\x7f" -}; - -# Binary subtypes -use constant { - BINARY_GENERIC => "\x00", - BINARY_FUNCTION => "\x01", - BINARY_UUID => "\x04", - BINARY_MD5 => "\x05", - BINARY_USER_DEFINED => "\x80" -}; - -# The pack() format to use for each numeric type -my %num_pack_fmt = ( - DOUBLE() => 'd<', - INT32() => 'l<', - INT64() => 'q<' -); - -# Reuse boolean singletons -my $FALSE = Mojo::JSON->false; -my $TRUE = Mojo::JSON->true; -my $BOOL = blessed $TRUE; - -my $MAXKEY = bless {}, 'Mango::BSON::_MaxKey'; -my $MINKEY = bless {}, 'Mango::BSON::_MinKey'; - -sub bson_bin { Mango::BSON::Binary->new(data => shift) } - -sub bson_code { Mango::BSON::Code->new(code => shift) } - -sub bson_dbref { bson_doc('$ref' => shift, '$id' => shift) } - -sub bson_decode { - my $bson = shift; - return undef unless my $len = bson_length($bson); - return length $bson == $len ? _decode_doc(\$bson) : undef; -} - -sub bson_doc { - tie my %hash, 'Mango::BSON::Document', @_; - return \%hash; -} - -sub bson_double { Mango::BSON::Number->new(shift, DOUBLE) } - -sub bson_encode { - my $doc = shift; - - # Embedded BSON - return $doc->{'$bson'} if exists $doc->{'$bson'}; - - my $bson = join '', - map { _encode_value(encode_cstring($_), $doc->{$_}) } keys %$doc; - - # Document ends with null byte - return pack('l<', length($bson) + 5) . $bson . "\x00"; -} - -sub bson_false {$FALSE} - -sub bson_int32 { Mango::BSON::Number->new(shift, INT32) } - -sub bson_int64 { Mango::BSON::Number->new(shift, INT64) } - +our @EXPORT_OK = qw(bson_length encode_cstring); sub bson_length { length $_[0] < 4 ? undef : unpack 'l<', substr($_[0], 0, 4) } -sub bson_max {$MAXKEY} - -sub bson_min {$MINKEY} - -sub bson_oid { Mango::BSON::ObjectID->new(@_) } - -sub bson_raw { bson_doc('$bson' => shift) } - -sub bson_time { Mango::BSON::Time->new(@_) } - -sub bson_ts { - Mango::BSON::Timestamp->new(seconds => shift, increment => shift); -} - -sub bson_true {$TRUE} - sub encode_cstring { my $str = shift; utf8::encode $str; return pack 'Z*', $str; } -sub _decode_binary { - my $bsonref = shift; - - my $len = unpack 'l<', substr($$bsonref, 0, 4, ''); - my $subtype = substr $$bsonref, 0, 1, ''; - my $binary = substr $$bsonref, 0, $len, ''; - - return bson_bin($binary)->type('function') if $subtype eq BINARY_FUNCTION; - return bson_bin($binary)->type('md5') if $subtype eq BINARY_MD5; - return bson_bin($binary)->type('uuid') if $subtype eq BINARY_UUID; - return bson_bin($binary)->type('user_defined') - if $subtype eq BINARY_USER_DEFINED; - return bson_bin($binary)->type('generic'); -} - -sub _decode_cstring { - my $bsonref = shift; - my $str = substr $$bsonref, 0, index($$bsonref, "\x00"), ''; - utf8::decode $str; - substr $$bsonref, 0, 1, ''; - return $str; -} - -sub _decode_doc { - my $bsonref = shift; - - # Every element starts with a type - my @doc; - substr $$bsonref, 0, 4, ''; - while (my $type = substr $$bsonref, 0, 1, '') { - - # Null byte (end of document) - last if $type eq "\x00"; - - push @doc, _decode_cstring($bsonref), _decode_value($type, $bsonref); - } - - return bson_doc(@doc); -} - -sub _decode_string { - my $bsonref = shift; - - my $len = unpack 'l<', substr($$bsonref, 0, 4, ''); - my $str = substr $$bsonref, 0, $len - 1, ''; - utf8::decode $str; - substr $$bsonref, 0, 1, ''; - - return $str; -} - -sub _decode_value { - my ($type, $bsonref) = @_; - - # String - return _decode_string($bsonref) if $type eq STRING; - - # Object ID - return bson_oid(unpack 'H*', substr $$bsonref, 0, 12, '') - if $type eq OBJECT_ID; - - # Double/Int32/Int64 - return unpack 'd<', substr $$bsonref, 0, 8, '' if $type eq DOUBLE; - return unpack 'l<', substr($$bsonref, 0, 4, '') if $type eq INT32; - return unpack 'q<', substr($$bsonref, 0, 8, '') if $type eq INT64; - - # Document - return _decode_doc($bsonref) if $type eq DOCUMENT; - - # Array - return [values %{_decode_doc($bsonref)}] if $type eq ARRAY; - - # Booleans and Null - return substr($$bsonref, 0, 1, '') eq "\x00" ? bson_false() : bson_true() - if $type eq BOOL; - return undef if $type eq NULL; - - # Time - return bson_time(unpack 'q<', substr($$bsonref, 0, 8, '')) - if $type eq DATETIME; - - # Regex - if ($type eq REGEX) { - my ($p, $m) = (_decode_cstring($bsonref), _decode_cstring($bsonref)); - croak "invalid regex modifier(s) in 'qr/$p/$m'" - if length($m) and $m !~ /^[msixpadlun]+\z/; - # escape $pat to avoid code injection - return eval "qr/\$p/$m"; - } - - # Binary (with subtypes) - return _decode_binary($bsonref) if $type eq BINARY; - - # Min/Max - return bson_min() if $type eq MIN_KEY; - return bson_max() if $type eq MAX_KEY; - - # Code (with and without scope) - return bson_code(_decode_string($bsonref)) if $type eq CODE; - if ($type eq CODE_SCOPE) { - substr $$bsonref, 0, 4, ''; - return bson_code(_decode_string($bsonref))->scope(_decode_doc($bsonref)); - } - - # Timestamp - return bson_ts( - reverse map({ unpack 'l<', substr($$_, 0, 4, '') } $bsonref, $bsonref)) - if $type eq TIMESTAMP; - - # Undefined - a deprecated type which should not exist anymore - # but apparently still does: https://github.com/oliwer/mango/issues/1 - return undef if $type eq UNDEFINED; - - # Unknown - croak 'Unknown BSON type'; -} - -sub _encode_binary { - my ($e, $subtype, $value) = @_; - return BINARY . $e . pack('l<', length $value) . $subtype . $value; -} - -sub _encode_object { - my ($e, $value, $class) = @_; - - # ObjectID - return OBJECT_ID . $e . $value->to_bytes - if $class eq 'Mango::BSON::ObjectID'; - - # Boolean - return BOOL . $e . ($value ? "\x01" : "\x00") if $class eq $BOOL; - - # Time - return DATETIME . $e . pack('q<', $value) if $class eq 'Mango::BSON::Time'; - - # Max - return MAX_KEY . $e if $value eq $MAXKEY; - - # Min - return MIN_KEY . $e if $value eq $MINKEY; - - # Regex - if ($class eq 'Regexp') { - my ($p, $m) = regexp_pattern($value); - return REGEX . $e . encode_cstring($p) . encode_cstring($m); - } - - # Binary - if ($class eq 'Mango::BSON::Binary') { - my $type = $value->type // 'generic'; - my $data = $value->data; - return _encode_binary($e, BINARY_FUNCTION, $data) if $type eq 'function'; - return _encode_binary($e, BINARY_MD5, $data) if $type eq 'md5'; - return _encode_binary($e, BINARY_USER_DEFINED, $data) - if $type eq 'user_defined'; - return _encode_binary($e, BINARY_UUID, $data) if $type eq 'uuid'; - return _encode_binary($e, BINARY_GENERIC, $data); - } - - # Code - if ($class eq 'Mango::BSON::Code') { - - # With scope - if (my $scope = $value->scope) { - my $code = _encode_string($value->code) . bson_encode($scope); - return CODE_SCOPE . $e . pack('l<', length $code) . $code; - } - - # Without scope - return CODE . $e . _encode_string($value->code); - } - - # Timestamp - return TIMESTAMP, $e, map { pack 'l<', $_ } $value->increment, - $value->seconds - if $class eq 'Mango::BSON::Timestamp'; - - # Number - if ($class eq 'Mango::BSON::Number') { - my $t = $value->type; - return $t . $e . pack($num_pack_fmt{$t}, $value->value); - } - - # Blessed reference with TO_JSON method - if (my $sub = $value->can('TO_BSON') // $value->can('TO_JSON')) { - return _encode_value($e, $value->$sub); - } - - # Stringify - return STRING . $e . _encode_string($value); -} - -sub _encode_string { - my $str = shift; - utf8::encode $str; - return pack('l<', length($str) + 1) . "$str\x00"; -} - -sub _encode_value { - my ($e, $value) = @_; - - # Null - return NULL . $e unless defined $value; - - # Reference - if (my $ref = ref $value) { - - # Blessed - return _encode_object($e, $value, $ref) if blessed $value; - - # Hash (Document) - return DOCUMENT . $e . bson_encode($value) if $ref eq 'HASH'; - - # Array - if ($ref eq 'ARRAY') { - my $i = 0; - return ARRAY . $e . bson_encode(bson_doc(map { $i++ => $_ } @$value)); - } - - # Scalar (boolean shortcut) - return _encode_object($e, !!$$value, $BOOL) if $ref eq 'SCALAR'; - } - - # Numeric - if (my $type = Mango::BSON::Number::guess_type($value)) { - return $type . $e . pack($num_pack_fmt{$type}, $value); - } - - # String - return STRING . $e . _encode_string("$value"); -} - -# Constants -package Mango::BSON::_MaxKey; - -package Mango::BSON::_MinKey; - 1; =encoding utf8 =head1 NAME -Mango::BSON - BSON +Mango::BSON - Helper module for BSON handle =head1 SYNOPSIS - use Mango::BSON ':bson'; - - my $bson = bson_encode { - foo => 'bar', - baz => 0.42, - unordered => {one => [1, 2, 3], two => bson_time}, - ordered => bson_doc(one => qr/test/i, two => bson_true) - }; - my $doc = bson_decode $bson; - -=head1 DESCRIPTION - -L is a minimalistic implementation of L. - -In addition to a bunch of custom BSON data types it supports normal Perl data -types like scalar, regular expression, C, array reference, hash -reference and will try to call the C and C methods on -blessed references, or stringify them if it doesn't exist. Scalar references -will be used to generate booleans, based on if their values are true or false. + The module provides only helpers. Decoding/encondig are performed by L Module =head1 FUNCTIONS -L implements the following functions, which can be imported -individually or at once with the C<:bson> flag. - -=head2 bson_bin - - my $bin = bson_bin $bytes; - -Create new BSON element of the binary type with L, -defaults to the C binary subtype. - - # Function - bson_bin($bytes)->type('function'); - - # MD5 - bson_bin($bytes)->type('md5'); - - # UUID - bson_bin($bytes)->type('uuid'); - - # User defined - bson_bin($bytes)->type('user_defined'); - -=head2 bson_code - - my $code = bson_code 'function () {}'; - -Create new BSON element of the code type with L. - - # With scope - bson_code('function () {}')->scope({foo => 'bar'}); - -=head2 bson_dbref - - my $dbref = bson_dbref 'test', $oid; - -Create a new database reference. - - # Longer version - my $dbref = {'$ref' => 'test', '$id' => $oid}; - -=head2 bson_decode - - my $doc = bson_decode $bson; - -Decode BSON into Perl data structures. - -=head2 bson_doc - - my $doc = bson_doc; - my $doc = bson_doc foo => 'bar', baz => 0.42, yada => {yada => [1, 2, 3]}; - -Create new BSON document with L, which can also be used -as a generic ordered hash. - - # Order is preserved - my $hash = bson_doc one => 1, two => 2, three => 3; - $hash->{four} = 4; - delete $hash->{two}; - say for keys %$hash; - -=head2 bson_double - - my $doc = { foo => bson_double(13.0) }; - -Force a scalar value to be encoded as a double in MongoDB. Croaks if the -value is incompatible with the double type. - -=head2 bson_encode - - my $bson = bson_encode $doc; - my $bson = bson_encode {}; - -Encode Perl data structures into BSON. - -=head2 bson_false - - my $false = bson_false; - -Create new BSON element of the boolean type false. - -=head2 bson_int32 - - my $doc = { foo => bson_int32(13) }; - - # This will die (integer is too big) - my $doc = { foo => bson_int32(2147483648) }; - -Force a scalar value to be encoded as a 32 bit integer in MongoDB. Croaks if -the value is incompatible with the int32 type. - -=head2 bson_int64 - - my $doc = { foo => bson_int64(666) }; - -Force a scalar value to be encoded as a 64 bit integer in MongoDB. Croaks if -the value is incompatible with the int64 type. - =head2 bson_length my $len = bson_length $bson; Check BSON length prefix. -=head2 bson_max - - my $max_key = bson_max; - -Create new BSON element of the max key type. - -=head2 bson_min - - my $min_key = bson_min; - -Create new BSON element of the min key type. - -=head2 bson_oid - - my $oid = bson_oid; - my $oid = bson_oid '1a2b3c4e5f60718293a4b5c6'; - -Create new BSON element of the object id type with L, -defaults to generating a new unique object id. - - # Generate object id with specific epoch time - my $oid = bson_oid->from_epoch(1359840145); - -=head2 bson_raw - - my $raw = bson_raw $bson; - -Pre-encoded BSON document. - - # Longer version - my $raw = {'$bson' => $bson}; - - # Embed pre-encoded BSON document - my $first = bson_encode {foo => 'bar'}; - my $second = bson_encode {test => bson_raw $first}; - -=head2 bson_time - - my $now = bson_time; - my $time = bson_time time * 1000; - -Create new BSON element of the UTC datetime type with L, -defaults to milliseconds since the UNIX epoch. - - # "1360626536.748" - bson_time(1360626536748)->to_epoch; - - # "2013-02-11T23:48:56.748Z" - bson_time(1360626536748)->to_datetime; - -=head2 bson_true - - my $true = bson_true; - -Create new BSON element of the boolean type true. - -=head2 bson_ts - - my $timestamp = bson_ts 23, 24; - -Create new BSON element of the timestamp type with L. - =head2 encode_cstring my $bytes = encode_cstring $cstring; @@ -572,6 +39,6 @@ Encode cstring. =head1 SEE ALSO -L, L, L. +L, L, L, L, L. =cut diff --git a/lib/Mango/Bulk.pm b/lib/Mango/Bulk.pm index a89c03b..6c0c9f3 100644 --- a/lib/Mango/Bulk.pm +++ b/lib/Mango/Bulk.pm @@ -1,13 +1,16 @@ package Mango::Bulk; use Mojo::Base -base; +use boolean; use Carp 'croak'; -use Mango::BSON qw(bson_doc bson_encode bson_oid bson_raw); +use BSON::Types qw(bson_doc bson_oid bson_raw); use Mojo::IOLoop; +use Mango::Promisify; has 'collection'; has ordered => 1; +promisify 'execute'; sub execute { my ($self, $cb) = @_; @@ -45,8 +48,8 @@ sub insert { sub remove { shift->_remove(0) } sub remove_one { shift->_remove(1) } -sub update { shift->_update(\1, @_) } -sub update_one { shift->_update(\0, @_) } +sub update { shift->_update(true, @_) } +sub update_one { shift->_update(false, @_) } sub upsert { shift->_set(upsert => 1) } @@ -57,7 +60,7 @@ sub _group { my $collection = $self->collection; return $type, $offset, bson_doc $type => $collection->name, $type eq 'insert' ? 'documents' : "${type}s" => $group, - ordered => $self->ordered ? \1 : \0, + ordered => $self->ordered ? true : false, writeConcern => $collection->db->build_write_concern; } @@ -118,7 +121,7 @@ sub _op { my $batch_max = $mango->max_write_batch_size; my $ops = $self->{ops} ||= []; my $previous = @$ops ? $ops->[-1] : []; - my $bson = bson_encode $doc; + my $bson = BSON->new->encode_one($doc); my $size = length $bson; my $new = ($self->{size} // 0) + $size; my $limit = $new > $bson_max || @$previous >= $batch_max + 2; @@ -148,7 +151,7 @@ sub _set { sub _update { my ($self, $multi, $update) = @_; my $query = delete $self->{query} // {}; - my $upsert = delete $self->{upsert} ? \1 : \0; + my $upsert = delete $self->{upsert} ? true : false; return $self->_op( update => {q => $query, u => $update, multi => $multi, upsert => $upsert}); } diff --git a/lib/Mango/Collection.pm b/lib/Mango/Collection.pm index d1ef5f3..0a3a5ea 100644 --- a/lib/Mango/Collection.pm +++ b/lib/Mango/Collection.pm @@ -1,21 +1,25 @@ package Mango::Collection; use Mojo::Base -base; +use boolean; use Carp 'croak'; -use Mango::BSON qw(bson_code bson_doc bson_oid); +use BSON::Types qw(bson_code bson_doc bson_oid); use Mango::Bulk; use Mango::Cursor; use Mango::Cursor::Query; +use Mango::Promisify; has [qw(db name)]; +promisify 'aggregate'; sub aggregate { my ($self, $pipeline) = (shift, shift); my $cb = ref $_[-1] eq 'CODE' ? pop : undef; + my %command_ = %{shift // {}}; + $command_{cursor} //= {} unless $command_{explain}; my $command = bson_doc(aggregate => $self->name, pipeline => $pipeline, - %{shift // {}}); - $command->{cursor} //= {} unless $command->{explain}; + %command_); # Blocking return $self->_aggregate($command, $self->db->command($command)) unless $cb; @@ -29,20 +33,24 @@ sub build_index_name { join '_', keys %{$_[1]} } sub bulk { Mango::Bulk->new(collection => shift) } +promisify 'create'; sub create { my $self = shift; my $cb = ref $_[-1] eq 'CODE' ? pop : undef; return $self->_command(bson_doc(create => $self->name, %{shift // {}}), $cb); } +promisify 'drop'; sub drop { $_[0]->_command(bson_doc(drop => $_[0]->name), $_[1]) } +promisify 'drop_index'; sub drop_index { my ($self, $name) = (shift, shift); return $self->_command(bson_doc(dropIndexes => $self->name, index => $name), shift); } +promisify 'ensure_index'; sub ensure_index { my ($self, $spec) = (shift, shift); my $cb = ref $_[-1] eq 'CODE' ? pop : undef; @@ -68,15 +76,17 @@ sub find { ); } +promisify 'find_and_modify'; sub find_and_modify { my ($self, $opts, $cb) = @_; return $self->_command(bson_doc(findAndModify => $self->name, %$opts), $cb, sub { my $doc = shift; $doc ? $doc->{value} : undef }); } +promisify 'find_one'; sub find_one { my ($self, $query) = (shift, shift); - $query = {_id => $query} if ref $query eq 'Mango::BSON::ObjectID'; + $query = {_id => $query} if ref $query eq 'BSON::OID'; my $cb = ref $_[-1] eq 'CODE' ? pop : undef; # Non-blocking @@ -89,6 +99,7 @@ sub find_one { sub full_name { join '.', $_[0]->db->name, $_[0]->name } +promisify 'index_information'; sub index_information { my $self = shift; my $cb = ref $_[-1] eq 'CODE' ? pop : undef; @@ -104,23 +115,25 @@ sub index_information { ); } +promisify 'insert'; sub insert { my ($self, $orig_docs, $cb) = @_; $orig_docs = [$orig_docs] unless ref $orig_docs eq 'ARRAY'; # Make a shallow copy of the documents and add an id if needed + my @ids = map { $_->{_id} //= bson_oid } @$orig_docs; my @docs = map { bson_doc %$_ } @$orig_docs; - my @ids = map { $_->{_id} //= bson_oid } @docs; my $command = bson_doc insert => $self->name, documents => \@docs, - ordered => \1, + ordered => true, writeConcern => $self->db->build_write_concern; return $self->_command($command, $cb, sub { @ids > 1 ? \@ids : $ids[0] }); } +promisify 'map_reduce'; sub map_reduce { my ($self, $map, $reduce) = (shift, shift, shift); my $cb = ref $_[-1] eq 'CODE' ? pop : undef; @@ -138,6 +151,7 @@ sub map_reduce { $command => sub { shift; $self->$cb(shift, $self->_map_reduce(shift)) }); } +promisify 'options'; sub options { my ($self, $cb) = @_; @@ -145,6 +159,7 @@ sub options { $self->_command($cmd, $cb, sub { shift->{cursor}->{firstBatch}->[0] }); } +promisify 'remove'; sub remove { my $self = shift; my $cb = ref $_[-1] eq 'CODE' ? pop : undef; @@ -152,16 +167,17 @@ sub remove { my $flags = shift // {}; ($query, $flags) = ({_id => $query}, {single => 1}) - if ref $query eq 'Mango::BSON::ObjectID'; + if ref $query eq 'BSON::OID'; my $command = bson_doc delete => $self->name, deletes => [{q => $query, limit => $flags->{single} ? 1 : 0}], - ordered => \1, + ordered => true, writeConcern => $self->db->build_write_concern; return $self->_command($command, $cb); } +promisify 'rename'; sub rename { my ($self, $name, $cb) = @_; @@ -184,6 +200,7 @@ sub rename { return $doc->{ok} ? $self->db->collection($name) : undef; } +promisify 'save'; sub save { my ($self, $doc, $cb) = @_; @@ -202,21 +219,22 @@ sub save { sub stats { $_[0]->_command(bson_doc(collstats => $_[0]->name), $_[1]) } +promisify 'update'; sub update { my ($self, $query, $update) = (shift, shift, shift); my $cb = ref $_[-1] eq 'CODE' ? pop : undef; my $flags = shift // {}; $update = { - q => ref $query eq 'Mango::BSON::ObjectID' ? {_id => $query} : $query, + q => ref $query eq 'BSON::OID' ? {_id => $query} : $query, u => $update, - upsert => $flags->{upsert} ? \1 : \0, - multi => $flags->{multi} ? \1 : \0 + upsert => $flags->{upsert} ? true : false, + multi => $flags->{multi} ? true : false, }; my $command = bson_doc update => $self->name, updates => [$update], - ordered => \1, + ordered => true, writeConcern => $self->db->build_write_concern; return $self->_command($command, $cb); @@ -225,11 +243,12 @@ sub update { sub _aggregate { my ($self, $command, $doc) = @_; + my %command_ = @$command; # Document (explain) - return $doc if $command->{explain}; + return $doc if $command_{explain}; # Collection - my $out = $command->{pipeline}[-1]{'$out'}; + my $out = $command_{pipeline}[-1]{'$out'}; return $self->db->collection($out) if defined $out; # Cursor diff --git a/lib/Mango/Cursor.pm b/lib/Mango/Cursor.pm index fcc51ab..d3d0f0b 100644 --- a/lib/Mango/Cursor.pm +++ b/lib/Mango/Cursor.pm @@ -2,6 +2,7 @@ package Mango::Cursor; use Mojo::Base -base; use Mojo::IOLoop; +use Mango::Promisify; has [qw(collection id ns)]; has [qw(batch_size limit)] => 0; @@ -12,6 +13,7 @@ sub add_batch { return $self; } +promisify 'all'; sub all { my ($self, $cb) = @_; @@ -24,6 +26,7 @@ sub all { return \@all; } +promisify 'next'; sub next { my ($self, $cb) = @_; return defined $self->id ? $self->_continue($cb) : $self->_start($cb); @@ -36,6 +39,7 @@ sub num_to_return { return $limit == 0 || ($size > 0 && $size < $limit) ? $size : $limit; } +promisify 'rewind'; sub rewind { my ($self, $cb) = @_; diff --git a/lib/Mango/Cursor/Query.pm b/lib/Mango/Cursor/Query.pm index c5386dc..816cc0f 100644 --- a/lib/Mango/Cursor/Query.pm +++ b/lib/Mango/Cursor/Query.pm @@ -1,7 +1,8 @@ package Mango::Cursor::Query; use Mojo::Base 'Mango::Cursor'; -use Mango::BSON 'bson_doc'; +use BSON::Types 'bson_doc'; +use Mango::Promisify; has [ qw(await_data comment hint max_scan max_time_ms read_preference snapshot), @@ -37,6 +38,7 @@ sub clone { return $clone; } +promisify 'count'; sub count { my $self = shift; my $cb = ref $_[-1] eq 'CODE' ? pop : undef; @@ -61,6 +63,7 @@ sub count { return $doc ? $doc->{n} : 0; } +promisify 'distinct'; sub distinct { my ($self, $key) = (shift, shift); my $cb = ref $_[-1] eq 'CODE' ? pop : undef; @@ -79,6 +82,7 @@ sub distinct { $db->command($command => sub { shift; $self->$cb(shift, shift->{values}) }); } +promisify 'explain'; sub explain { my ($self, $cb) = @_; diff --git a/lib/Mango/Database.pm b/lib/Mango/Database.pm index 4b0ea03..9ff2f72 100644 --- a/lib/Mango/Database.pm +++ b/lib/Mango/Database.pm @@ -1,17 +1,19 @@ package Mango::Database; use Mojo::Base -base; +use boolean; use Carp 'croak'; -use Mango::BSON qw(bson_code bson_doc); +use BSON::Types qw(bson_code bson_doc); use Mango::Collection; use Mango::GridFS; +use Mango::Promisify; has [qw(mango name)]; sub build_write_concern { my $mango = shift->mango; return { - j => $mango->j ? \1 : \0, + j => $mango->j ? true : false, w => $mango->w, wtimeout => $mango->wtimeout }; @@ -22,6 +24,7 @@ sub collection { return Mango::Collection->new(db => $self, name => $name); } +promisify 'collection_names'; sub collection_names { my $self = shift; my $cb = ref $_[-1] eq 'CODE' ? pop : undef; @@ -43,6 +46,7 @@ sub collection_names { return $docs; } +promisify 'command'; sub command { my ($self, $command) = (shift, shift); my $cb = ref $_[-1] eq 'CODE' ? pop : undef; @@ -67,6 +71,7 @@ sub command { return $doc; } +promisify 'dereference'; sub dereference { my ($self, $dbref, $cb) = @_; @@ -81,6 +86,7 @@ sub dereference { sub gridfs { Mango::GridFS->new(db => shift) } +promisify 'list_collections'; sub list_collections { my $self = shift; my $cb = ref $_[-1] eq 'CODE' ? pop : undef; @@ -103,6 +109,7 @@ sub list_collections { ->add_batch($cursor->{firstBatch}); } +promisify 'stats'; sub stats { shift->command(bson_doc(dbstats => 1), @_) } 1; diff --git a/lib/Mango/GridFS/Writer.pm b/lib/Mango/GridFS/Writer.pm index 375db1e..483ba9b 100644 --- a/lib/Mango/GridFS/Writer.pm +++ b/lib/Mango/GridFS/Writer.pm @@ -1,9 +1,10 @@ package Mango::GridFS::Writer; use Mojo::Base -base; +use boolean; use Carp 'croak'; use List::Util 'first'; -use Mango::BSON qw(bson_bin bson_doc bson_oid bson_time); +use BSON::Types qw(bson_bytes bson_doc bson_oid bson_time); use Mojo::IOLoop; has chunk_size => 261120; @@ -19,7 +20,7 @@ sub close { return Mojo::IOLoop->next_tick(sub { $self->$cb(undef, $files_id) }); } - my @index = (bson_doc(files_id => 1, n => 1), {unique => \1}); + my @index = (bson_doc(files_id => 1, n => 1), {unique => true}); my $gridfs = $self->gridfs; my $command = bson_doc filemd5 => $self->_files_id, root => $gridfs->prefix; @@ -91,7 +92,7 @@ sub _chunk { my $n = $self->{n}++; return $bulk->insert( - {files_id => $self->_files_id, n => $n, data => bson_bin($chunk)}); + {files_id => $self->_files_id, n => $n, data => bson_bytes($chunk)}); } sub _files_id { shift->{files_id} //= bson_oid } diff --git a/lib/Mango/Promisify.pm b/lib/Mango/Promisify.pm new file mode 100644 index 0000000..8fc9cf1 --- /dev/null +++ b/lib/Mango/Promisify.pm @@ -0,0 +1,29 @@ +package Mango::Promisify; +use Mojo::Base -strict; + +use Exporter 'import'; + +use Mojo::Util qw(monkey_patch); +use Mojo::Promise; + +our @EXPORT = qw( promisify ); + +sub promisify { + my ($name) = @_; + my $name_p = $name . '_p'; + my ($package) = caller(0); + no strict 'refs'; + my $method = \&{"${package}::$name"}; + monkey_patch $package, $name_p => sub { + my (@args) = @_; + my $promise = Mojo::Promise->new; + $method->(@args, sub { + my ($self, $err, $result) = @_; + return $promise->reject($err) if $err; + $promise->resolve($result) + }); + return $promise + } +} + +1; \ No newline at end of file diff --git a/lib/Mango/Protocol.pm b/lib/Mango/Protocol.pm index b7c4b12..7b83cd5 100644 --- a/lib/Mango/Protocol.pm +++ b/lib/Mango/Protocol.pm @@ -1,7 +1,8 @@ package Mango::Protocol; use Mojo::Base -base; -use Mango::BSON qw(bson_decode bson_encode bson_length encode_cstring); +use Mango::BSON qw(bson_length); +use BSON; # Opcodes use constant {REPLY => 1, QUERY => 2004, GET_MORE => 2005, @@ -11,7 +12,7 @@ sub build_get_more { my ($self, $id, $name, $return, $cursor) = @_; # Zero and name - my $msg = pack('l<', 0) . encode_cstring($name); + my $msg = pack('l<', 0) . pack('Z*', $name); # Number to return and cursor id $msg .= pack('l<', $return) . pack('q<', $cursor); @@ -36,6 +37,7 @@ sub build_kill_cursors { sub build_query { my ($self, $id, $name, $flags, $skip, $return, $query, $fields) = @_; + my $codec = BSON->new; # Flags my $vec = pack 'B*', '0' x 32; vec($vec, 1, 1) = 1 if $flags->{tailable_cursor}; @@ -47,16 +49,17 @@ sub build_query { my $msg = pack 'l<', unpack('V', $vec); # Name - $msg .= encode_cstring $name; + utf8::encode $name; + $msg .= pack 'Z*', $name; # Skip and number to return $msg .= pack('l<', $skip) . pack('l<', $return); # Query - $msg .= bson_encode $query; + $msg .= $codec->encode_one($query); # Optional field selector - $msg .= bson_encode $fields if $fields; + $msg .= $codec->encode_one($fields) if $fields; # Header return _build_header($id, length($msg), QUERY) . $msg; @@ -72,6 +75,8 @@ sub next_id { $_[1] > 2147483646 ? 1 : $_[1] + 1 } sub parse_reply { my ($self, $bufref) = @_; + my $codec = BSON->new; + # Make sure we have the whole message return undef unless my $len = bson_length $$bufref; return undef if length $$bufref < $len; @@ -100,7 +105,7 @@ sub parse_reply { # Documents (remove number of documents prefix) substr $msg, 0, 4, ''; my @docs; - push @docs, bson_decode(substr $msg, 0, bson_length($msg), '') while $msg; + push @docs, $codec->decode_one(substr $msg, 0, bson_length($msg), '') while $msg; return { id => $id,