1use Mojo::Base -strict;
2
3use Test::More;
4use Mango::Protocol;
5
6# Generate next id
7my $protocol = Mango::Protocol->new;
8is $protocol->next_id(1),          2,          'right id';
9is $protocol->next_id(2147483646), 2147483647, 'right id';
10is $protocol->next_id(2147483647), 1,          'right id';
11
12# Build minimal query
13is $protocol->build_query(1, 'foo', {}, 0, 10, {}, {}),
14    "\x2a\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\xd4\x07\x00\x00\x00\x00"
15  . "\x00\x00\x66\x6f\x6f\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x05\x00\x00\x00"
16  . "\x00\x05\x00\x00\x00\x00", 'minimal query';
17
18# Build query with all flags
19my $flags = {
20  tailable_cursor   => 1,
21  slave_ok          => 1,
22  no_cursor_timeout => 1,
23  await_data        => 1,
24  exhaust           => 1,
25  partial           => 1
26};
27is $protocol->build_query(1, 'foo', $flags, 0, 10, {}, {}),
28    "\x2a\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\xd4\x07\x00\x00\xf6"
29  . "\x00\x00\x00\x66\x6f\x6f\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x05\x00"
30  . "\x00\x00\x00\x05\x00\x00\x00\x00", 'query with all flags';
31
32# Build minimal get_more
33is $protocol->build_get_more(1, 'foo', 10, 1),
34  "\x24\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\xd5\x07\x00\x00\x00\x00"
35  . "\x00\x00\x66\x6f\x6f\x00\x0a\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00",
36  'minimal get_more';
37
38# Build minimal kill_cursors
39is $protocol->build_kill_cursors(1, 1),
40  "\x20\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\xd7\x07\x00\x00\x00\x00"
41  . "\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00",
42  'minimal kill_cursors';
43
44# Parse full reply with leftovers
45my $buffer
46  = "\x51\x00\x00\x00\x69\xaa\x04\x00\x03\x00\x00\x00\x01\x00\x00\x00\x08\x00"
47  . "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00"
48  . "\x2d\x00\x00\x00\x02\x6e\x6f\x6e\x63\x65\x00\x11\x00\x00\x00\x33\x32\x39"
49  . "\x35\x65\x35\x63\x64\x35\x65\x65\x66\x32\x35\x30\x30\x00\x01\x6f\x6b\x00"
50  . "\x00\x00\x00\x00\x00\x00\xf0\x3f\x00\x51";
51my $reply = $protocol->parse_reply(\$buffer);
52is $buffer, "\x51", 'right leftovers';
53my $nonce = {
54  id     => 305769,
55  to     => 3,
56  flags  => {await_capable => 1},
57  cursor => 0,
58  from   => 0,
59  docs   => [{nonce => '3295e5cd5eef2500', ok => 1}]
60};
61is_deeply $reply, $nonce, 'right reply';
62
63# Parse query failure
64$buffer
65  = "\x59\x00\x00\x00\x3b\xd7\x04\x00\x01\x00\x00\x00\x01\x00\x00\x00\x02\x00"
66  . "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00"
67  . "\x35\x00\x00\x00\x02\x24\x65\x72\x72\x00\x1c\x00\x00\x00\x24\x6f\x72\x20"
68  . "\x72\x65\x71\x75\x69\x72\x65\x73\x20\x6e\x6f\x6e\x65\x6d\x70\x74\x79\x20"
69  . "\x61\x72\x72\x61\x79\x00\x10\x63\x6f\x64\x65\x00\xce\x33\x00\x00\x00";
70$reply = $protocol->parse_reply(\$buffer);
71my $query = {
72  id     => 317243,
73  to     => 1,
74  flags  => {query_failure => 1},
75  cursor => 0,
76  from   => 0,
77  docs   => [{'$err' => '$or requires nonempty array', code => 13262}]
78};
79is_deeply $reply, $query, 'right reply';
80
81# Parse partial reply
82my $before = my $after = "\x10";
83is $protocol->parse_reply(\$after), undef, 'nothing';
84is $before, $after, 'no changes';
85$before = $after = "\x00\x01\x00\x00";
86is $protocol->parse_reply(\$after), undef, 'nothing';
87is $before, $after, 'no changes';
88
89# Parse wrong message type
90$buffer = $protocol->build_query(1, 'foo', {}, 0, 10, {}, {}) . "\x00";
91is $protocol->parse_reply(\$buffer), undef, 'nothing';
92is $buffer, "\x00", 'message has been removed';
93
94# Extract error messages from reply
95is $protocol->query_failure($query), '$or requires nonempty array',
96  'right query failure';
97is $protocol->query_failure(undef), undef, 'no query failure';
98is $protocol->query_failure($nonce), undef, 'no query failure';
99
100# Extract error messages from documents
101my $unknown
102  = {errmsg => 'no such cmd: whatever', 'bad cmd' => {whatever => 1}, ok => 0};
103my $write = {
104  n           => 0,
105  ok          => 1,
106  writeErrors => [
107    {
108      code   => 11000,
109      errmsg => 'insertDocument :: caused by :: 11000 E11000 duplicate'
110        . ' key error index: test.collection_test.$_id_  dup key: '
111        . '{ : ObjectId(\'53408aad5867b46961a50000\') }',
112      index => 0
113    }
114  ]
115};
116is $protocol->command_error($unknown), 'no such cmd: whatever', 'right error';
117is $protocol->command_error($write), undef, 'no error';
118like $protocol->write_error($write),
119  qr/^Write error at index 0: insertDocument/, 'right error';
120is $protocol->write_error($unknown), undef, 'no error';
121
122done_testing();
123