use
MongoDBTest
qw/skip_unless_mongod build_client get_test_db/
;
skip_unless_mongod();
my
$conn
= build_client();
my
$testdb
= get_test_db(
$conn
);
my
$coll
=
$testdb
->get_collection(
'y'
);
$coll
->drop;
my
$id
= MongoDB::OID->new;
isa_ok(
$id
,
'MongoDB::OID'
);
is(
$id
.
""
,
$id
->value);
{
my
$ids
= [];
for
(0..9) {
push
@$ids
, new MongoDB::OID;
select
undef
,
undef
,
undef
, 0.1;
}
for
(0..8) {
ok((
@$ids
[
$_
].
""
) lt (
@$ids
[
$_
+1].
""
));
}
my
$now
= DateTime->now;
$id
= MongoDB::OID->new;
ok(
$id
->get_time >=
$now
->epoch,
"OID time >= epoch"
);
}
{
my
$value
=
"012345678901234567890abc"
;
my
$id
= MongoDB::OID->new(
value
=>
$value
);
is(
$id
->value,
$value
);
my
$id_orig
= MongoDB::OID->new;
foreach
my
$args
(
[
value
=>
$id_orig
->value],
[
value
=>
uc
$id_orig
->value],
[
$id_orig
->value],
[
$id_orig
],
) {
my
$id_copy
= MongoDB::OID->new(@{
$args
});
is(
$id_orig
->value,
$id_copy
->value);
}
}
{
my
$value
=
"506b37b1a7e2037c1f0004"
;
like(
exception { MongoDB::OID->new(
value
=>
$value
) },
qr/not a valid OID/
i,
"Invalid OID throws exception"
);
}
{
$coll
->insert_one({
'x'
=>
'FRED'
,
'y'
=> 1});
$coll
->insert_one({
'x'
=>
'bob'
});
$coll
->insert_one({
'x'
=>
'fRed'
,
'y'
=> 2});
my
$freds
=
$coll
->query({
'x'
=>
qr/fred/
i})->
sort
({
'y'
=> 1});
is(
$freds
->
next
->{
'x'
},
'FRED'
,
'case insensitive'
);
is(
$freds
->
next
->{
'x'
},
'fRed'
,
'case insensitive'
);
ok(!
$freds
->has_next,
'bob doesn\'t match'
);
my
$fred
=
$coll
->find_one({
'x'
=>
qr/^F/
});
is(
$fred
->{
'x'
},
'FRED'
,
'starts with'
);
$coll
->drop;
$coll
->insert_one({
"r"
=>
qr/foo/
i});
my
$obj
=
$coll
->find_one;
my
$qr
=
$obj
->{r}->try_compile;
like(
"foo"
,
$qr
,
'matches'
);
like(
"FOO"
,
$qr
,
"flag i works"
);
unlike(
"bar"
,
$qr
,
'not a match'
);
}
{
$coll
->drop;
my
$now
= DateTime->now;
$coll
->insert_one({
'date'
=>
$now
});
my
$date
=
$coll
->find_one;
is(
$date
->{
'date'
}->epoch,
$now
->epoch);
is(
$date
->{
'date'
}->day_of_week,
$now
->day_of_week);
my
$past
= DateTime->from_epoch(
'epoch'
=> 1234567890);
$coll
->insert_one({
'date'
=>
$past
});
$date
=
$coll
->find_one({
'date'
=>
$past
});
is(
$date
->{
'date'
}->epoch, 1234567890);
}
{
$coll
->drop;
my
$min
=
bless
{},
"MongoDB::MinKey"
;
my
$max
=
bless
{},
"MongoDB::MaxKey"
;
$coll
->insert_one({
min
=>
$min
,
max
=>
$max
});
my
$x
=
$coll
->find_one;
isa_ok(
$x
->{min},
'MongoDB::MinKey'
);
isa_ok(
$x
->{max},
'MongoDB::MaxKey'
);
}
{
$coll
->drop;
my
%test
;
tie
%test
,
'Tie::IxHash'
;
$test
{one} =
"on"
;
$test
{two} = 2;
ok(
$coll
->insert_one(\
%test
),
"inserted IxHash"
) ;
my
$doc
=
$coll
->find_one;
is(
$doc
->{
'one'
},
'on'
,
"field one"
);
is(
$doc
->{
'two'
}, 2,
"field two"
);
}
{
$coll
->drop;
my
$invalid
=
"\xFE"
;
ok(
$coll
->insert_one({
"bin"
=> \
$invalid
}),
"inserted binary data"
);
my
$one
=
$coll
->find_one;
isa_ok(
$one
->{bin},
"MongoDB::BSON::Binary"
,
"binary data"
);
is(
$one
->{
'bin'
},
"\xFE"
,
"read binary data"
);
}
{
$coll
->drop;
my
$x
= 2 ** 34;
$coll
->insert_one({
x
=>
$x
});
my
$result
=
$coll
->find_one;
is(
$result
->{
'x'
}, 17179869184)
or diag explain
$result
;
$coll
->drop;
$x
= (2 ** 34) * -1;
$coll
->insert_one({
x
=>
$x
});
$result
=
$coll
->find_one;
is(
$result
->{
'x'
}, -17179869184)
or diag explain
$result
;
$coll
->drop;
$coll
->insert_one({
x
=> 2712631400});
$result
=
$coll
->find_one;
is(
$result
->{
'x'
}, 2712631400)
or diag explain
$result
;
eval
{
$coll
->insert_one({
x
=> 9834590149023841902384137418571984503});
};
like($@,
qr/can't fit/
,
"big int too large error message"
);
$coll
->drop;
}
{
my
$str
=
"function() { return 5; }"
;
my
$code
= MongoDB::Code->new(
"code"
=>
$str
);
my
$scope
=
$code
->scope;
is(
keys
%$scope
, 0);
$coll
->insert_one({
"code"
=>
$code
});
my
$ret
=
$coll
->find_one;
my
$ret_code
=
$ret
->{code};
$scope
=
$ret_code
->scope;
is(
keys
%$scope
, 0);
is(
$ret_code
->code,
$str
);
my
$x
;
if
( !
$conn
->password ) {
$x
=
$testdb
->
eval
(
$code
);
is(
$x
, 5);
}
$str
=
"function() { return name; }"
;
$code
= MongoDB::Code->new(
"code"
=>
$str
,
"scope"
=> {
"name"
=>
"Fred"
});
if
( !
$conn
->password ) {
$x
=
$testdb
->
eval
(
$code
);
is(
$x
,
"Fred"
);
}
$coll
->drop;
$coll
->insert_one({
"x"
=>
"foo"
,
"y"
=>
$code
,
"z"
=> 1});
$x
=
$coll
->find_one;
is(
$x
->{x},
"foo"
);
is(
$x
->{y}->code,
$str
);
is(
$x
->{y}->scope->{
"name"
},
"Fred"
);
is(
$x
->{z}, 1);
$coll
->drop;
}
SKIP: {
skip
"Skipping 64 bit native SV"
, 1
if
( !
$Config
{use64bitint} );
$coll
->update_one({
x
=> 1 }, {
'$inc'
=> {
'y'
=> 19401194714 } }, {
'upsert'
=> 1 });
my
$result
=
$coll
->find_one;
is(
$result
->{
'y'
},19401194714,
'64 bit ints without Math::BigInt'
);
}
{
my
$doc
= {
"foo"
=> MongoDB::OID->new};
my
$j
= JSON->new;
$j
->allow_blessed;
$j
->convert_blessed;
my
$json
=
$j
->encode(
$doc
);
is(
$json
,
'{"foo":{"$oid":"'
.
$doc
->{
'foo'
}->value.
'"}}'
);
}
{
$coll
->drop;
my
$t
= MongoDB::Timestamp->new(
"sec"
=> 12345678,
"inc"
=> 9876543);
$coll
->insert_one({
"ts"
=>
$t
});
my
$x
=
$coll
->find_one;
is(
$x
->{
'ts'
}->sec,
$t
->sec);
is(
$x
->{
'ts'
}->inc,
$t
->inc);
}
{
$coll
->drop;
$coll
->insert_one({
"x"
=> boolean::true,
"y"
=> boolean::false});
my
$x
=
$coll
->find_one;
is(
ref
$x
->{x},
'boolean'
,
"roundtrip boolean field x"
);
is(
ref
$x
->{y},
'boolean'
,
"roundtrip boolean field y"
);
ok(
$x
->{x},
"x is true"
);
ok( !
$x
->{y},
"y is false"
);
}
{
eval
{
$coll
->insert_one({
"x"
=>
$coll
});
};
ok($@ =~ m/type \(MongoDB::Collection\) unhandled/,
"can't insert a non-recognized obj"
);
}
{
$coll
->drop;
my
$x
= 1.0;
my
(
$double_type
,
$int_type
) = ({
x
=> {
'$type'
=> 1}},
{
'$or'
=> [{
x
=> {
'$type'
=> 16}},
{
x
=> {
'$type'
=> 18}}]});
MongoDB::force_double(
$x
);
$coll
->insert_one({
x
=>
$x
});
my
$result
=
$coll
->find_one(
$double_type
);
is(
$result
->{x}, 1);
$result
=
$coll
->find_one(
$int_type
);
is(
$result
,
undef
);
$coll
->drop;
MongoDB::force_int(
$x
);
$coll
->insert_one({
x
=>
$x
});
$result
=
$coll
->find_one(
$double_type
);
is(
$result
,
undef
);
$result
=
$coll
->find_one(
$int_type
);
is(
$result
->{x}, 1);
}
done_testing;