AnyMongo

 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;

MANIFEST  view on Meta::CPAN

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;
    }
}



( run in 0.403 second using v1.01-cache-2.11-cpan-4d50c553e7e )