use
MongoDBTest
qw/skip_unless_mongod build_client get_test_db server_version server_type/
;
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(
"foo"
);
subtest
'basic indexes'
=>
sub
{
$coll
->drop;
$coll
->drop;
for
(
my
$i
= 0;
$i
< 10;
$i
++ ) {
$coll
->insert_one( {
'x'
=>
$i
,
'z'
=> 3,
'w'
=> 4 } );
$coll
->insert_one( {
'x'
=>
$i
,
'y'
=> 2,
'z'
=> 3,
'w'
=> 4 } );
}
$coll
->drop;
ok( !
$coll
->get_indexes,
'no indexes yet'
);
my
$indexes
= Tie::IxHash->new(
foo
=> 1,
bar
=> 1,
baz
=> 1 );
ok(
$coll
->ensure_index(
$indexes
) );
my
$err
=
$testdb
->last_error;
is(
$err
->{ok}, 1 );
is(
$err
->{err},
undef
);
$indexes
= Tie::IxHash->new(
foo
=> 1,
bar
=> 1 );
ok(
$coll
->ensure_index(
$indexes
) );
$coll
->insert_one( {
foo
=> 1,
bar
=> 1,
baz
=> 1,
boo
=> 1 } );
$coll
->insert_one( {
foo
=> 1,
bar
=> 1,
baz
=> 1,
boo
=> 2 } );
is(
$coll
->count, 2 );
ok(
$coll
->ensure_index( {
boo
=> 1 }, {
unique
=> 1 } ) );
eval
{
$coll
->insert_one( {
foo
=> 3,
bar
=> 3,
baz
=> 3,
boo
=> 2 } ) };
is(
$coll
->count, 2,
'unique index'
);
my
@indexes
=
$coll
->get_indexes;
is(
scalar
@indexes
, 4,
'three custom indexes and the default _id_ index'
);
my
(
$foobarbaz
) =
grep
{
$_
->{name} eq
'foo_1_bar_1_baz_1'
}
@indexes
;
is_deeply( [
sort
keys
%{
$foobarbaz
->{key} } ], [
sort
qw/foo bar baz/
], );
my
(
$foobar
) =
grep
{
$_
->{name} eq
'foo_1_bar_1'
}
@indexes
;
is_deeply( [
sort
keys
%{
$foobar
->{key} } ], [
sort
qw/foo bar/
], );
$coll
->drop_index(
'foo_1_bar_1_baz_1'
);
@indexes
=
$coll
->get_indexes;
is(
scalar
@indexes
, 3 );
ok( ( !
scalar
grep
{
$_
->{name} eq
'foo_1_bar_1_baz_1'
}
@indexes
),
"right index deleted"
);
$coll
->drop;
ok( !
$coll
->get_indexes,
'no indexes after dropping'
);
$coll
->ensure_index( {
"foo"
=> 1 } );
@indexes
=
$coll
->get_indexes;
is(
scalar
@indexes
, 2,
'1 custom index and the default _id_ index'
);
};
subtest
'drop dups'
=>
sub
{
$coll
->drop;
$coll
->insert_one( {
foo
=> 1,
bar
=> 1,
baz
=> 1,
boo
=> 1 } );
$coll
->insert_one( {
foo
=> 1,
bar
=> 1,
baz
=> 1,
boo
=> 2 } );
is(
$coll
->count, 2 );
eval
{
$coll
->ensure_index( {
foo
=> 1 }, {
unique
=> 1 } ) };
like( $@,
qr/E11000/
,
"got expected error creating unique index with dups"
);
if
(
$server_version
< v2.7.5 ) {
ok(
$coll
->ensure_index( {
foo
=> 1 }, {
unique
=> 1,
drop_dups
=> 1 } ) );
}
};
subtest
'new form of ensure index'
=>
sub
{
$coll
->drop;
ok(
$coll
->ensure_index( {
foo
=> 1,
bar
=> -1,
baz
=> 1 } ) );
ok(
$coll
->ensure_index( [
foo
=> 1,
bar
=> 1 ] ) );
$coll
->insert_one( {
foo
=> 1,
bar
=> 1,
baz
=> 1,
boo
=> 1 } );
$coll
->insert_one( {
foo
=> 1,
bar
=> 1,
baz
=> 1,
boo
=> 2 } );
is(
$coll
->count, 2 );
$coll
->ensure_index( {
boo
=> 1 }, {
unique
=> 1 } );
eval
{
$coll
->insert_one( {
foo
=> 3,
bar
=> 3,
baz
=> 3,
boo
=> 2 } ) };
is(
$coll
->count, 2,
'unique index'
);
};
subtest
'2d index with options'
=>
sub
{
$coll
->drop;
$coll
->ensure_index( {
loc
=>
'2d'
}, {
bits
=> 32,
sparse
=> 1 } );
my
(
$index
) =
grep
{
$_
->{name} eq
'loc_2d'
}
$coll
->get_indexes;
ok(
$index
,
"created 2d index"
);
ok(
$index
->{sparse},
"sparse option set on index"
);
is(
$index
->{bits}, 32,
"bits option set on index"
);
};
subtest
'ensure index arbitrary options'
=>
sub
{
$coll
->ensure_index( {
wibble
=> 1 }, {
notReallyAnOption
=> {
foo
=> 1 } } );
my
(
$index
) =
grep
{
$_
->{name} eq
'wibble_1'
}
$coll
->get_indexes;
ok(
$index
,
"created index"
);
cmp_deeply(
$index
->{notReallyAnOption},
{
foo
=> 1 },
"arbitrary option set on index"
);
};
subtest
"indexes with dots"
=>
sub
{
my
$ok
=
$coll
->ensure_index({
"x.y"
=> 1}, {
"name"
=>
"foo"
});
my
(
$index
) =
grep
{
$_
->{name} eq
'foo'
}
$coll
->get_indexes;
ok(
$index
);
ok(
$index
->{
'key'
});
ok(
$index
->{
'key'
}->{
'x.y'
});
$coll
->drop;
};
subtest
'sparse indexes'
=>
sub
{
for
(1..10) {
$coll
->insert_one({
x
=>
$_
,
y
=>
$_
});
$coll
->insert_one({
x
=>
$_
});
}
is(
$coll
->count, 20);
eval
{
$coll
->ensure_index({
"y"
=> 1}, {
"unique"
=> 1,
"name"
=>
"foo"
}) };
my
(
$index
) =
grep
{
$_
->{name} eq
'foo'
}
$coll
->get_indexes;
ok(!
$index
);
$coll
->ensure_index({
"y"
=> 1}, {
"unique"
=> 1,
"sparse"
=> 1,
"name"
=>
"foo"
});
(
$index
) =
grep
{
$_
->{name} eq
'foo'
}
$coll
->get_indexes;
ok(
$index
);
$coll
->drop;
};
subtest
'text indices'
=>
sub
{
plan
skip_all
=>
"text indices won't work with db version $server_version"
unless
$server_version
>= v2.4.0;
if
(
$server_version
< v2.6.0 ) {
my
$res
=
$conn
->get_database(
'admin'
)->run_command([
'getParameter'
=> 1,
'textSearchEnabled'
=> 1]);
plan
skip_all
=>
"text search not enabled"
if
!
$res
->{
'textSearchEnabled'
};
}
my
$coll
=
$testdb
->get_collection(
'test_text'
);
$coll
->insert_one({
language
=>
'english'
,
w1
=>
'hello'
,
w2
=>
'world'
})
foreach
(1..10);
is(
$coll
->count, 10);
my
$res
=
$coll
->ensure_index({
'$**'
=>
'text'
}, {
name
=>
'testTextIndex'
,
default_language
=>
'spanish'
,
language_override
=>
'language'
,
weights
=> {
w1
=> 5,
w2
=> 10 }
});
ok(
$res
);
my
(
$text_index
) =
grep
{
$_
->{name} eq
'testTextIndex'
}
$coll
->get_indexes;
is(
$text_index
->{
'default_language'
},
'spanish'
,
'default_language option works'
);
is(
$text_index
->{
'language_override'
},
'language'
,
'language_override option works'
);
is(
$text_index
->{
'weights'
}->{
'w1'
}, 5,
'weights option works 1'
);
is(
$text_index
->{
'weights'
}->{
'w2'
}, 10,
'weights option works 2'
);
if
(
$server_version
>= v2.6.0 ) {
my
$n_found
=()=
$coll
->find( {
'$text'
=> {
'$search'
=>
'world'
} } )->all;
is(
$n_found
, 10,
"correct number of results found"
);
}
else
{
my
$results
=
$testdb
->run_command( [
'text'
=>
'test_text'
,
'search'
=>
'world'
] )->{results};
is(
scalar
(
@$results
), 10,
"correct number of results found"
);
}
$coll
->drop;
};
done_testing;