From bd744e6a67f342975fac67e9c8308ec1716d1400 Mon Sep 17 00:00:00 2001 From: Thomas Bloor Date: Fri, 14 Sep 2018 16:50:59 +0100 Subject: [PATCH 1/2] PERL-970 Allow BSON::Doc as sort argument --- lib/MongoDB/Collection.pm | 3 ++ t/sort-bson-doc.t | 70 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 73 insertions(+) create mode 100644 t/sort-bson-doc.t diff --git a/lib/MongoDB/Collection.pm b/lib/MongoDB/Collection.pm index 5b2d9169..c03cc395 100644 --- a/lib/MongoDB/Collection.pm +++ b/lib/MongoDB/Collection.pm @@ -1857,6 +1857,9 @@ sub __ixhash { elsif ( $type eq 'ARRAY' ) { $hash->{$key} = Tie::IxHash->new( @$ref ); } + elsif ( $ref->$_can('_as_tied_hash') ) { + $hash->{$key} = $ref->_as_tied_hash; + } else { MongoDB::UsageError->throw("Can't convert $type to a Tie::IxHash"); } diff --git a/t/sort-bson-doc.t b/t/sort-bson-doc.t new file mode 100644 index 00000000..3dd49a4f --- /dev/null +++ b/t/sort-bson-doc.t @@ -0,0 +1,70 @@ +# Copyright 2015 - present MongoDB, Inc. +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + +use strict; +use warnings; +use Test::More 0.96; +use Test::Fatal; +use Test::Deep qw/!blessed/; + +use utf8; +use Tie::IxHash; + +use MongoDB; +use MongoDB::Error; +use BSON::Types ':all'; + +use lib "t/lib"; +use MongoDBTest qw/skip_unless_mongod build_client get_test_db server_version server_type get_capped/; + +skip_unless_mongod(); + +my $conn = build_client(); +my $testdb = get_test_db($conn); +my $server_version = server_version($conn); +my $server_type = server_type($conn); +my $coll = $testdb->get_collection('test_collection'); + +$coll->insert_many( [ + { _id => 1, size => 10 }, + { _id => 2, size => 5 }, + { _id => 3, size => 15 }, +] ); + +subtest "sort standard hash" => sub { + my @res = $coll->find( {}, { sort => { size => 1 } } )->result->all; + + cmp_deeply \@res, + [ + { _id => 2, size => 5 }, + { _id => 1, size => 10 }, + { _id => 3, size => 15 }, + ], + 'Got correct sort order'; +}; + +subtest "sort BSON::Doc" => sub { + my $b_doc = bson_doc( size => 1 ); + my @res = $coll->find( {}, { sort => $b_doc } )->result->all; + + cmp_deeply \@res, + [ + { _id => 2, size => 5 }, + { _id => 1, size => 10 }, + { _id => 3, size => 15 }, + ], + 'Got correct sort order'; +}; + +done_testing; From b1ab555c04ecea5e02d60b8ff24b01632ac9a527 Mon Sep 17 00:00:00 2001 From: Thomas Bloor Date: Mon, 17 Sep 2018 16:57:20 +0100 Subject: [PATCH 2/2] PERL-970 Inline _as_tied_hash conversion for BSON::Doc Also move tests for sorting by BSON::Doc into collection.t --- lib/MongoDB/Collection.pm | 5 +-- t/collection.t | 43 ++++++++++++++++++++++++ t/sort-bson-doc.t | 70 --------------------------------------- 3 files changed, 44 insertions(+), 74 deletions(-) delete mode 100644 t/sort-bson-doc.t diff --git a/lib/MongoDB/Collection.pm b/lib/MongoDB/Collection.pm index c03cc395..7d805b37 100644 --- a/lib/MongoDB/Collection.pm +++ b/lib/MongoDB/Collection.pm @@ -1854,12 +1854,9 @@ sub __ixhash { if ( $type eq 'HASH' ) { $hash->{$key} = Tie::IxHash->new( %$ref ); } - elsif ( $type eq 'ARRAY' ) { + elsif ( $type eq 'ARRAY' || $type eq 'BSON::Doc' ) { $hash->{$key} = Tie::IxHash->new( @$ref ); } - elsif ( $ref->$_can('_as_tied_hash') ) { - $hash->{$key} = $ref->_as_tied_hash; - } else { MongoDB::UsageError->throw("Can't convert $type to a Tie::IxHash"); } diff --git a/t/collection.t b/t/collection.t index ddf3ce56..46dfbf03 100644 --- a/t/collection.t +++ b/t/collection.t @@ -1016,4 +1016,47 @@ for my $criteria ( $js_str, $js_obj ) { }; } +subtest "sort standard hash" => sub { + + $coll->drop; + + $coll->insert_many( [ + { _id => 1, size => 10 }, + { _id => 2, size => 5 }, + { _id => 3, size => 15 }, + ] ); + + my @res = $coll->find( {}, { sort => { size => 1 } } )->result->all; + + cmp_deeply \@res, + [ + { _id => 2, size => 5 }, + { _id => 1, size => 10 }, + { _id => 3, size => 15 }, + ], + 'Got correct sort order'; +}; + +subtest "sort BSON::Doc" => sub { + + $coll->drop; + + $coll->insert_many( [ + { _id => 1, size => 10 }, + { _id => 2, size => 5 }, + { _id => 3, size => 15 }, + ] ); + + my $b_doc = bson_doc( size => 1 ); + my @res = $coll->find( {}, { sort => $b_doc } )->result->all; + + cmp_deeply \@res, + [ + { _id => 2, size => 5 }, + { _id => 1, size => 10 }, + { _id => 3, size => 15 }, + ], + 'Got correct sort order'; +}; + done_testing; diff --git a/t/sort-bson-doc.t b/t/sort-bson-doc.t deleted file mode 100644 index 3dd49a4f..00000000 --- a/t/sort-bson-doc.t +++ /dev/null @@ -1,70 +0,0 @@ -# Copyright 2015 - present MongoDB, Inc. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. - -use strict; -use warnings; -use Test::More 0.96; -use Test::Fatal; -use Test::Deep qw/!blessed/; - -use utf8; -use Tie::IxHash; - -use MongoDB; -use MongoDB::Error; -use BSON::Types ':all'; - -use lib "t/lib"; -use MongoDBTest qw/skip_unless_mongod build_client get_test_db server_version server_type get_capped/; - -skip_unless_mongod(); - -my $conn = build_client(); -my $testdb = get_test_db($conn); -my $server_version = server_version($conn); -my $server_type = server_type($conn); -my $coll = $testdb->get_collection('test_collection'); - -$coll->insert_many( [ - { _id => 1, size => 10 }, - { _id => 2, size => 5 }, - { _id => 3, size => 15 }, -] ); - -subtest "sort standard hash" => sub { - my @res = $coll->find( {}, { sort => { size => 1 } } )->result->all; - - cmp_deeply \@res, - [ - { _id => 2, size => 5 }, - { _id => 1, size => 10 }, - { _id => 3, size => 15 }, - ], - 'Got correct sort order'; -}; - -subtest "sort BSON::Doc" => sub { - my $b_doc = bson_doc( size => 1 ); - my @res = $coll->find( {}, { sort => $b_doc } )->result->all; - - cmp_deeply \@res, - [ - { _id => 2, size => 5 }, - { _id => 1, size => 10 }, - { _id => 3, size => 15 }, - ], - 'Got correct sort order'; -}; - -done_testing;