view release on metacpan or search on metacpan
AnyMongo.xs view on Meta::CPAN
perl_mongo_serialize_int(&buf, flags);
perl_mongo_sv_to_bson(&buf, criteria, NO_PREP);
perl_mongo_sv_to_bson(&buf, obj, NO_PREP);
perl_mongo_serialize_size(buf.start, &buf);
RETVAL = newSVpvn(buf.start, buf.pos-buf.start);
Safefree(buf.start);
OUTPUT:
RETVAL
SV*
build_get_more_message(request_id,ns, cursor_id,size)
SV *request_id
char *ns
SV *cursor_id
int size
PREINIT:
buffer buf;
mongo_msg_header header;
CODE:
size = 34+strlen(ns);
New(0, buf.start, size, char);
buf.pos = buf.start;
buf.end = buf.start + size;
CREATE_RESPONSE_HEADER(buf, ns, SvIV(request_id), OP_GET_MORE);
perl_mongo_serialize_int(&buf, size);
perl_mongo_serialize_long(&buf, (int64_t)SvIV(cursor_id));
perl_mongo_serialize_size(buf.start, &buf);
// CREATE_BUF(INITIAL_BUF_SIZE);
// // standard message head
// CREATE_MSG_HEADER(SvIV(request_id), 0, OP_GET_MORE);
// APPEND_HEADER_NS(buf, ns, 0);
// // batch size
// perl_mongo_serialize_int(&buf, SvIV(size));
// // cursor id
// perl_mongo_serialize_long(&buf, (int64_t) SvIV(cursor_id));
// perl_mongo_serialize_size(buf.start, &buf);
RETVAL = newSVpvn(buf.start, buf.pos-buf.start);
Safefree(buf.start);
OUTPUT:
RETVAL
SV*
build_kill_cursor_message(request_id_sv,cursor_id)
SV *request_id_sv
SV *cursor_id
PREINIT:
buffer buf;
char quickbuf[128];
mongo_msg_header header;
CODE:
buf.pos = quickbuf;
buf.start = buf.pos;
buf.end = buf.start + 128;
// std header
CREATE_MSG_HEADER(SvIV(request_id_sv), 0, OP_KILL_CURSORS);
APPEND_HEADER(buf, 0);
// # of cursors
perl_mongo_serialize_int(&buf, 1);
// cursor ids
perl_mongo_serialize_long(&buf, (int64_t)SvIV(cursor_id));
perl_mongo_serialize_size(buf.start, &buf);
RETVAL = newSVpvn(buf.start, buf.pos-buf.start);
OUTPUT:
RETVAL
SV*
decode_bson_documents(SV *documents)
PREINIT:
buffer buf;
AV *ret;
lib/AnyMongo/GridFS/File.pm
lib/AnyMongo/MongoSupport.pm
mongo_support.c
mongo_support.h
prepare_dzil_buildtools.sh
t/00compile.t
t/author-critic.t
t/bson.t
t/perl-driver-api/bson.t
t/perl-driver-api/collection.t
t/perl-driver-api/cursor.t
t/perl-driver-api/database.t
t/perl-driver-api/db.t
t/perl-driver-api/types.t
t/release-pod-syntax.t
t/rs.pl
xt/perlcriticrc
benchmarks/bench.pl view on Meta::CPAN
'developers','focus','building','mongodb','mongo'] * 20
};
my $sub_insert = sub {
my ($col,$doc) = @_;
$col->insert($doc);
};
my $sub_query = sub {
my ($col) = @_;
my $cursor = $col->find;
do {
} while($cursor->next);
};
my $mongo_con = MongoDB::Connection->new(host => 'mongodb://127.0.0.1');
my $any_con = AnyMongo->new_connection(host => 'mongodb://127.0.0.1');
my $mongo_col = $mongo_con->get_database('anymongo_bench')->get_collection('bench');
my $any_col = $any_con->get_database('anymongo_bench')->get_collection('bench2');
$|= 1;
say "bench insert docs ...";
cmpthese($tries,{
'mongo-perl-driver' => sub { $sub_insert->($mongo_col,$large_doc) },
'anymongo' => sub{ $sub_insert->($any_col,$large_doc) }
});
say "bench query/cursor ...";
cmpthese(1,{
'mongo-perl-driver' => sub { $sub_query->($mongo_col) },
'anymongo' => sub{ $sub_query->($any_col) }
});
$mongo_con->get_database('anymongo_bench')->drop;
lib/AnyMongo/Collection.pm view on Meta::CPAN
if ($sort_by) {
$q->{'query'} = $query;
$q->{'orderby'} = $sort_by;
}
else {
$q = $query ? $query : {};
}
my $conn = $self->_database->_connection;
my $ns = $self->full_name;
my $cursor = AnyMongo::Cursor->new(
_connection => $conn,
_ns => $ns,
_query => $q,
_limit => $limit,
_skip => $skip
);
return $cursor;
}
sub query {
my ($self, $query, $attrs) = @_;
return $self->find($query, $attrs);
}
sub find_one {
my ($self, $query, $fields) = @_;
lib/AnyMongo/Collection.pm view on Meta::CPAN
sub _make_safe {
my ($self, $req) = @_;
my $conn = $self->_database->_connection;
my $db = $self->_database->name;
my $last_error = Tie::IxHash->new(getlasterror => 1, w => $conn->w, wtimeout => $conn->wtimeout);
my $request_id = AnyMongo::MongoSupport::make_request_id();
my $query = AnyMongo::MongoSupport::build_query_message(
$request_id, $db.'.$cmd', 0, 0, -1, $last_error);
# $conn->recv($cursor);
$conn->send_message("$req$query");
my ($number_received,$cursor_id,$result) = $conn->recv_message();
# use Data::Dumper;
# warn "_make_safe getlasterror number_received:$number_received cursor_id:$cursor_id result=> ".Dumper($result);
if ( $number_received == 1 ) {
my $ok = $result->[0];
# $result->{ok} is 1 if err is set
Carp::croak $ok->{err} if $ok->{err};
# $result->{ok} == 0 is still an error
if (!$ok->{ok}) {
Carp::croak $ok->{errmsg};
}
}
lib/AnyMongo/Connection.pm view on Meta::CPAN
sub _check_connection {
my ($self) = @_;
$self->connected or ($self->auto_reconnect and $self->connect);
$self->connected;
}
sub recv_message {
my ($self,$hd) = @_;
my ($message_length,$request_id,$response_to,$op) = $self->_receive_header($hd);
my ($response_flags,$cursor_id,$starting_from,$number_returned) = $self->_receive_response_header($hd);
$self->_check_respone_flags($response_flags);
my $results = $self->_read_documents($message_length-36,$cursor_id,$hd);
return ($number_returned,$cursor_id,$results);
}
sub _check_respone_flags {
my ($self,$flags) = @_;
if (($flags & REPLY_CURSOR_NOT_FOUND) != 0) {
croak("cursor not found");
}
}
sub receive_data {
my ($self,$size,$hd) = @_;
$hd ||= $self->master_handle;
croak 'connection lost' unless $hd or $self->_check_connection;
my $cv = AE::cv;
my $timer; $timer = AnyEvent->timer( after => $self->query_timeout ,cb => sub {
undef $timer;
lib/AnyMongo/Connection.pm view on Meta::CPAN
my $header_buf = $self->receive_data(STANDARD_HEADER_SIZE,$hd);
croak 'Short read for DB response header; length:'.length($header_buf) unless length $header_buf == STANDARD_HEADER_SIZE;
return unpack('V4',$header_buf);
}
sub _receive_response_header {
my ($self,$hd) = @_;
my $header_buf = $self->receive_data(RESPONSE_HEADER_SIZE,$hd);
croak 'Short read for DB response header' unless length $header_buf == RESPONSE_HEADER_SIZE;
my ($response_flags) = unpack 'V',substr($header_buf,0,BSON_INT32);
my ($cursor_id) = unpack 'j',substr($header_buf,BSON_INT32,BSON_INT64);
my ($starting_from,$number_returned) = unpack 'V2',substr($header_buf,BSON_INT32+BSON_INT64);
return ($response_flags,$cursor_id,$starting_from,$number_returned);
}
sub _read_documents {
my ($self,$doc_message_length,$cursor_id,$hd) = @_;
my $remaining = $doc_message_length;
my $bson_buf;
# do {
# my $buf_len = $remaining > 4096? 4096:$remaining;
# $bson_buf .= $self->receive_data($buf_len);
# $remaining -= $buf_len;
# } while ($remaining >0 );
$bson_buf = $self->receive_data($doc_message_length,$hd);
return unless $bson_buf;
# warn "#_read_documents:bson_buf size:".length($bson_buf);
lib/AnyMongo/Cursor.pm view on Meta::CPAN
package AnyMongo::Cursor;
BEGIN {
$AnyMongo::Cursor::VERSION = '0.03';
}
#ABSTRACT: A asynchronous cursor/iterator for Mongo query results
use strict;
use warnings;
use namespace::autoclean;
use boolean;
use Tie::IxHash;
use AnyMongo::MongoSupport;
use Any::Moose;
use Carp qw(croak confess);
$AnyMongo::Cursor::slave_okay = 0;
lib/AnyMongo/Cursor.pm view on Meta::CPAN
default => 0,
);
has _skip => (
is => 'rw',
isa => 'Int',
required => 0,
default => 0,
);
has _cursor_id => (
is => 'rw',
isa => 'Int',
required => 0,
default => 0,
);
has _num_remain => (
is => 'rw',
isa => 'Int',
lib/AnyMongo/Cursor.pm view on Meta::CPAN
);
has _print_debug => (
is => 'rw',
isa => 'Bool',
default => 0,
);
sub CLONE_SKIP { 1 }
sub BUILD { shift->_init_cursor }
sub _init_cursor {
my ($self) = @_;
$self->{query_run} = 0;
$self->{closed} = 0;
$self->{cursor_id} = 0;
$self->{at} = 0;
}
sub _ensure_special {
my ($self) = @_;
if ($self->_grrrr) {
return;
}
lib/AnyMongo/Cursor.pm view on Meta::CPAN
}
# warn "#send_initial_query ...\n" if $self->_print_debug;
my $opts = $AnyMongo::Cursor::slave_okay | ($self->tailable << 1) |
($self->slave_okay << 2) | ($self->immortal << 4);
my $query = AnyMongo::MongoSupport::build_query_message($self->_next_request_id,$self->_ns,
$opts, $self->_skip, $self->_limit, $self->_query, $self->_fields);
$self->_connection->send_message($query,$self->_socket_handle);
my ($number_received,$cursor_id,$result) = $self->_connection->recv_message($self->_socket_handle);
# warn "#send_initial_query number_received:$number_received cursor_id:".sprintf('%x',$cursor_id)." result#:".@{$result} if $self->_print_debug;
# warn "#send_initial_query number_received:$number_received cursor_id:".sprintf('%x',$cursor_id);
push @{$self->{_result_cache}},@{$result} if $result;
$self->{number_received} = $number_received;
$self->{cursor_id} = $cursor_id;
$self->{query_run} = 1;
$self->close_cursor_if_query_complete;
return 1;
}
sub next {
my ($self) = @_;
# warn "#next ...\n" if $self->_print_debug;
return $self->next_document if $self->has_next && ( $self->{_limit} <= 0
|| $self->{at} < $self->{_limit} );
lib/AnyMongo/Cursor.pm view on Meta::CPAN
$doc;
}
sub has_next { shift->num_remaining > 0 }
sub reset {
my ($self) = @_;
# warn "#reset ...\n" if $self->_print_debug;
$self->{query_run} = 0;
$self->{closed} = 0;
$self->kill_cursor;
$self->{at} = 0;
$self->{_result_cache} = [];
$self;
}
sub refill_via_get_more {
my ($self) = @_;
# warn "#refill_via_get_more...\n" if $self->_print_debug;
return if $self->send_initial_query || $self->{cursor_id} == 0;
my $request_id = $self->_next_request_id;
# warn "#refill_via_get_more > build_get_more_message<
# request_id:$request_id
# _ns: ".$self->_ns."
# cursor_id:".$self->{cursor_id}."
# batch_size:".$self->batch_size."
# >...\n" if $self->_print_debug;
# get_more
my $get_more_message = AnyMongo::MongoSupport::build_get_more_message(
$request_id,
$self->_ns,
$self->{cursor_id},
$self->batch_size);
# warn "#refill_via_get_more > send_message...\n" if $self->_print_debug;
$self->_connection->send_message($get_more_message,$self->_socket_handle);
# warn "#refill_via_get_more > recv_message...\n" if $self->_print_debug;
my ($number_received,$cursor_id,$result) = $self->_connection->recv_message($self->_socket_handle);
# warn "#refill_via_get_more > got number_received:$number_received cursor_id:$cursor_id...\n" if $self->_print_debug;
$self->{cursor_id} = $cursor_id;
push @{$self->{_result_cache}},@{$result} if $result;
$self->{number_received} = $number_received;
$self->{cursor_id} = $cursor_id;
$self->{query_run} = 1;
$self->close_cursor_if_query_complete;
}
sub close_cursor_if_query_complete {
my ($self) = @_;
# warn "#close_cursor_if_query_complete ...\n" if $self->_print_debug;
$self->close if $self->_limit >0 && $self->{number_received} >= $self->_limit;
}
sub num_remaining {
my ($self) = @_;
# warn "#num_remaining ...\n" if $self->_print_debug;
$self->refill_via_get_more if @{$self->{_result_cache}} == 0;
return scalar @{$self->{_result_cache}};
}
sub close {
my ($self) = @_;
# warn "#close ...\n" if $self->_print_debug;
$self->kill_cursor if $self->{cursor_id};
$self->{cursor_id} = 0;
$self->{closed} = 1;
$self->{at} = 0;
}
sub kill_cursor {
my ($self) = @_;
# warn "#kill_cursor ...\n" if $self->_print_debug;
return unless $self->{cursor_id};
my $message = AnyMongo::MongoSupport::build_kill_cursor_message($self->_next_request_id,$self->{cursor_id});
$self->_connection->send_message($message,$self->_socket_handle);
$self->{cursor_id} = 0;
}
sub _check_modifiable {
my ($self) = @_;
confess 'Cannot modify the query once it has been run or closed.'
if $self->{query_run} || $self->{closed};
}
sub _next_request_id {
my ($self) = @_;
lib/AnyMongo/Cursor.pm view on Meta::CPAN
}
__PACKAGE__->meta->make_immutable;
1;
=pod
=head1 NAME
AnyMongo::Cursor - A asynchronous cursor/iterator for Mongo query results
=head1 VERSION
version 0.03
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 AUTHORS
lib/AnyMongo/Database.pm view on Meta::CPAN
$cmd->Push("w", $options->{w}) if $options->{w};
$cmd->Push("wtimeout", $options->{wtimeout}) if $options->{wtimeout};
$cmd->Push("fsync", $options->{fsync}) if $options->{fsync};
}
return $self->run_command($cmd);
}
sub run_command {
my ($self, $command,$hd) = @_;
my $cursor = AnyMongo::Cursor->new(
_ns => $self->collection_ns(SYSTEM_COMMAND_COLLECTION),
_connection => $self->_connection,
_socket_handle => $hd,
_query => $command,
_limit => -1,
);
my $obj = $cursor->next;
return $obj if ref $obj && $obj->{ok};
$obj->{'errmsg'};
}
sub eval {
my ($self, $code, $args) = @_;
my $cmd = tie(my %hash, 'Tie::IxHash');
%hash = ('$eval' => $code,
'args' => $args);
lib/AnyMongo/MongoSupport.pm view on Meta::CPAN
$AnyMongo::MongoSupport::VERSION = '0.03';
}
# ABSTRACT: Internal functions to support mongo wired protocol
use strict;
use warnings;
use AnyMongo;
use parent 'Exporter';
our @EXPORT_OK = qw(
make_request_id
build_get_more_message
build_kill_cursor_message
build_query_message
build_insert_message
build_remove_message
build_update_message
decode_bson_documents
);
# my $current_request_id = int(rand(1000000));
my $current_request_id = 0;
lib/AnyMongo/MongoSupport.pm view on Meta::CPAN
=head3 OP_GETMORE
The OP_GETMORE message is used to query the database for documents in a collection.
The format of the OP_GETMORE message is :
struct {
MsgHeader header; // standard message header
int32 ZERO; // 0 - reserved for future use
cstring fullCollectionName; // "dbname.collectionname"
int32 numberToReturn; // number of documents to return
int64 cursorID; // cursorID from the OP_REPLY
}
=head3 OP_DELETE
The OP_DELETE message is used to remove one or more messages from a collection.
The format of the OP_DELETE message is :
struct {
MsgHeader header; // standard message header
int32 ZERO; // 0 - reserved for future use
cstring fullCollectionName; // "dbname.collectionname"
int32 flags; // bit vector - see below for details.
document selector; // query object. See below for details.
}
=head3 OP_KILL_CURSORS
The OP_KILL_CURSORS message is used to close an active cursor in the database. This is necessary to ensure
that database resources are reclaimed at the end of the query. The format of the OP_KILL_CURSORS message is :
struct {
MsgHeader header; // standard message header
int32 ZERO; // 0 - reserved for future use
int32 numberOfCursorIDs; // number of cursorIDs in message
int64* cursorIDs; // sequence of cursorIDs to close
}
=head2 Database Response Messages
=head3 OP_REPLY
The OP_REPLY message is sent by the database in response to an
L<MongoDB::MongoSupport/OP_QUERY> or L<MongoDB::MongoSupport/OP_GET_MORE>
message. The format of an OP_REPLY message is:
struct {
MsgHeader header; // standard message header
int32 responseFlags; // bit vector - see details below
int64 cursorID; // cursor id if client needs to do get more's
int32 startingFrom; // where in the cursor this reply is starting
int32 numberReturned; // number of documents in the reply
document* documents; // documents
}
=head1 AUTHORS
=over 4
=item *
mongo_support.h view on Meta::CPAN
#define OP_REPLY 1
#define OP_MSG 1000
#define OP_UPDATE 2001
#define OP_INSERT 2002
#define OP_GET_BY_OID 2003
#define OP_QUERY 2004
#define OP_GET_MORE 2005
#define OP_DELETE 2006
#define OP_KILL_CURSORS 2007
// cursor flags
#define CURSOR_NOT_FOUND 1
#define CURSOR_ERR 2
#define MSG_HEADER_SIZE 16
#define REPLY_HEADER_SIZE (MSG_HEADER_SIZE+20)
#define INITIAL_BUF_SIZE 4096
// should only be 4MB, can be 64MB with big docs
#define MAX_RESPONSE_LEN 67108864
#define DEFAULT_CHUNK_SIZE (256*1024)
t/perl-driver-api/bson.t view on Meta::CPAN
$c->update({x => 1}, {"=inc" => {x => 1}}, {upsert => true});
my $up = $c->find_one;
is($up->{x}, 2);
}
{
$MongoDB::BSON::char = ":";
$c->drop;
$c->batch_insert([{x => 1}, {x => 2}, {x => 3}, {x => 4}, {x => 5}]);
my $cursor = $c->query({x => {":gt" => 2, ":lte" => 4}})->sort({x => 1});
my $result = $cursor->next;
is($result->{x}, 3);
$result = $cursor->next;
is($result->{x}, 4);
ok(!$cursor->has_next);
}
# utf8
{
$c->drop;
# should convert invalid utf8 to valid
my $invalid = "\xFE";
$c->insert({char => $invalid});
my $x =$c->find_one;
t/perl-driver-api/collection.t view on Meta::CPAN
$coll->ensure_index($keys);
my @tied = $coll->get_indexes;
is(scalar @tied, 2, 'num indexes');
is($tied[1]->{'ns'}, 'test_database.test_collection', 'namespace');
is($tied[1]->{'name'}, 'sn_1_ts_-1', 'namespace');
$coll->drop;
$coll->insert({x => 1, y => 2, z => 3, w => 4});
my $cursor = $coll->query->fields({'y' => 1});
$obj = $cursor->next;
is(exists $obj->{'y'}, 1, 'y exists');
is(exists $obj->{'_id'}, 1, '_id exists');
is(exists $obj->{'x'}, '', 'x doesn\'t exist');
is(exists $obj->{'z'}, '', 'z doesn\'t exist');
is(exists $obj->{'w'}, '', 'w doesn\'t exist');
# batch insert
$coll->drop;
my $ids = $coll->batch_insert([{'x' => 1}, {'x' => 2}, {'x' => 3}]);
is($coll->count, 3, 'batch_insert');
$cursor = $coll->query->sort({'x' => 1});
my $i = 1;
while ($obj = $cursor->next) {
is($obj->{'x'}, $i++);
}
# find_one fields
$coll->drop;
$coll->insert({'x' => 1, 'y' => 2, 'z' => 3});
my $yer = $coll->find_one({}, {'y' => 1});
ok(exists $yer->{'y'}, 'y exists');
ok(!exists $yer->{'x'}, 'x doesn\'t');
t/perl-driver-api/collection.t view on Meta::CPAN
$coll->update({"x" => 1}, {'$set' => {'x' => "hi"}});
# make sure one is set, one is not
ok($coll->find_one({"x" => "hi"}));
ok($coll->find_one({"x" => 1}));
# multiple update
$coll->update({"x" => 2}, {'$set' => {'x' => 4}}, {'multiple' => 1});
is($coll->count({"x" => 4}), 2);
$cursor = $coll->query({"x" => 4})->sort({"y" => 1});
$obj = $cursor->next();
is($obj->{'y'}, 3);
$obj = $cursor->next();
is($obj->{'y'}, 4);
# check with upsert if there are matches
SKIP: {
my $admin = $conn->get_database('admin');
my $buildinfo = $admin->run_command({buildinfo => 1});
skip "multiple update won't work with db version $buildinfo->{version}", 5 if $buildinfo->{version} =~ /(0\.\d+\.\d+)|(1\.[12]\d*.\d+)/;
$coll->update({"x" => 4}, {'$set' => {"x" => 3}}, {'multiple' => 1, 'upsert' => 1});
is($coll->count({"x" => 3}), 2, 'count');
$cursor = $coll->query({"x" => 3})->sort({"y" => 1});
$obj = $cursor->next();
is($obj->{'y'}, 3, 'y == 3');
$obj = $cursor->next();
is($obj->{'y'}, 4, 'y == 4');
# check with upsert if there are no matches
$coll->update({"x" => 15}, {'$set' => {"z" => 4}}, {'upsert' => 1, 'multiple' => 1});
ok($coll->find_one({"z" => 4}));
is($coll->count(), 5);
}
$coll->drop;
t/perl-driver-api/collection.t view on Meta::CPAN
}
# find
{
$coll->drop;
$coll->insert({x => 1});
$coll->insert({x => 4});
$coll->insert({x => 5});
my $cursor = $coll->find({x=>4});
my $result = $cursor->next;
is($result->{'x'}, 4, 'find');
$cursor = $coll->find({x=>{'$gt' => 1}})->sort({x => -1});
$result = $cursor->next;
is($result->{'x'}, 5);
$result = $cursor->next;
is($result->{'x'}, 4);
}
# # autoload
SKIP: {
skip 'Autoload not support anymore, skip',2 if 1;
my $coll1 = $conn->foo->bar->baz;
is($coll1->name, "bar.baz");
is($coll1->full_name, "foo.bar.baz");
}
t/perl-driver-api/cursor.t view on Meta::CPAN
$coll = $db->get_collection('test_collection');
is($coll->query->next, undef, 'test undef');
is_deeply([$coll->query->all], []);
my $id1 = $coll->insert({x => 1});
my $id2 = $coll->insert({x => 5});
is($coll->count, 2);
my $cursor = $coll->query;
is($cursor->next->{'x'}, 1);
is($cursor->next->{'x'}, 5);
is($cursor->next, undef);
my $cursor2 = $coll->query({x => 5});
is_deeply([$cursor2->all], [{_id => $id2, x => 5}]);
is_deeply([$coll->query->all], [{_id => $id1, x => 1}, {_id => $id2, x => 5}]);
# sort
my $cursor_sort = $coll->query->sort({'x' => -1});
is($cursor_sort->has_next, 1);
is($cursor_sort->next->{'x'}, 5, 'Cursor->sort');
is($cursor_sort->next->{'x'}, 1);
$cursor_sort = $coll->query->sort({'x' => 1});
is($cursor_sort->next->{'x'}, 1);
is($cursor_sort->next->{'x'}, 5);
# sort by tie::ixhash
my $hash = Tie::IxHash->new("x" => -1);
$cursor_sort = $coll->query->sort($hash);
is($cursor_sort->has_next, 1);
is($cursor_sort->next->{'x'}, 5, 'Tie::IxHash cursor->sort');
is($cursor_sort->next->{'x'}, 1);
# snapshot
my $cursor3 = $coll->query->snapshot;
is($cursor3->has_next, 1, 'check has_next');
my $r1 = $cursor3->next;
is($cursor3->has_next, 1, 'if this failed, the database you\'re running is old and snapshot won\'t work');
$cursor3->next;
is(int $cursor3->has_next, 0, 'check has_next is false');
$coll->insert({x => 2});
$coll->insert({x => 3});
$coll->insert({x => 4});
my $paging = $coll->query->skip(1)->limit(2);
is($paging->has_next, 1, 'check skip/limit');
$paging->next;
is($paging->has_next, 1);
$paging->next;
is(int $paging->has_next, 0);
t/perl-driver-api/cursor.t view on Meta::CPAN
my $collection = $db->get_collection('test');
$collection->drop;
$collection->ensure_index({'sn'=>1});
my $sn = 0;
while ($sn <= 500) {
$collection->insert({sn => $sn++});
}
$cursor = $collection->query;
my $count = 0;
while (my $doc = $cursor->next()) {
$count++;
}
is(501, $count);
# reset
$cursor->reset;
$r1 = $cursor->next;
$cursor->reset;
my $r2 = $cursor->next;
is($r1->{'sn'}, $r2->{'sn'}, 'reset');
# explain
my $exp = $cursor->explain;
is($exp->{'n'}, 501, 'explain');
is($exp->{'cursor'}, 'BasicCursor');
$cursor->reset;
$exp = $cursor->limit(20)->explain;
is(20, $exp->{'n'}, 'explain limit');
$cursor->reset;
$exp = $cursor->limit(-20)->explain;
is(20, $exp->{'n'});
#hint
$cursor->reset;
my $hinted = $cursor->hint({'x' => 1});
is($hinted, $cursor);
$collection->drop;
$collection->insert({'num' => 1, 'foo' => 1});
my $aok = 1;
eval {
$collection->query->hint({'num' => 1})->explain;
$aok = 0;
};
ok($@ =~ m/bad hint/);
# MongoDB::Cursor::slave_okay
$MongoDB::Cursor::slave_okay = 1;
$cursor = $collection->query->next;
$MongoDB::Cursor::slave_okay = 0;
$cursor = $collection->query->next;
$collection->drop;
# count
$coll->drop;
$coll->batch_insert([{'x' => 1}, {'x' => 1}, {'y' => 1}, {'x' => 1, 'z' => 1}]);
is($coll->query->count, 4, 'count');
is($coll->query({'x' => 1})->count, 3, 'count query');
is($coll->query->limit(1)->count(1), 1, 'count limit');
is($coll->query->skip(1)->count(1), 3, 'count skip');
is($coll->query->limit(1)->skip(1)->count(1), 1, 'count limit & skip');
# cursor opts
# not a functional test, just make sure they don't blow up
{
my $cursor = $coll->find();
$cursor->tailable(1);
is($cursor->tailable, 1);
$cursor->tailable(0);
is($cursor->tailable, 0);
$cursor->immortal(1);
is($cursor->immortal, 1);
$cursor->immortal(0);
is($cursor->immortal, 0);
$cursor->slave_okay(1);
is($cursor->slave_okay, 1);
$cursor->slave_okay(0);
is($cursor->slave_okay, 0);
}
END {
if ($db) {
$db->drop;
}
}