1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More;
7use Test::Exception;
8
9use Net::RNDC::Session;
10
11## new
12throws_ok { Net::RNDC::Session->new(); }
13	qr/Missing required argument 'want_read'/,
14	"new() without want_read fails";
15
16throws_ok { Net::RNDC::Session->new(
17		want_read   => sub  {},
18	) }
19	qr/Missing required argument 'want_write'/,
20	"new() without want_write fails";
21
22throws_ok { Net::RNDC::Session->new(
23		want_read   => sub {},
24		want_write  => sub {},
25	) }
26	qr/Missing required argument 'want_finish'/,
27	"new() without want_finish fails";
28
29throws_ok { Net::RNDC::Session->new(
30		want_read   => sub {},
31		want_write  => sub {},
32		want_finish => sub {},
33	) }
34	qr/Missing required argument 'want_error'/,
35	"new() without want_finish fails";
36
37throws_ok { Net::RNDC::Session->new(
38		want_read   => sub {},
39		want_write  => sub {},
40		want_finish => sub {},
41		want_error  => sub {},
42	) }
43	qr/Missing required argument 'key'/,
44	"new() without key fails";
45
46throws_ok { Net::RNDC::Session->new(
47		want_read   => sub {},
48		want_write  => sub {},
49		want_finish => sub {},
50		want_error  => sub {},
51		key         => 'aabc',
52	) }
53	qr/Missing required argument 'command'/,
54	"new() without command fails";
55
56throws_ok { Net::RNDC::Session->new(
57		want_read   => sub {},
58		want_write  => sub {},
59		want_finish => sub {},
60		want_error  => sub {},
61		key         => 'aabc',
62		command     => 'status',
63	) }
64	qr/Argument 'is_client' or 'is_server' must be defined/,
65	"new() without is_client or is_server fails";
66
67throws_ok { Net::RNDC::Session->new(
68		want_read   => 'cat',
69		want_write  => sub {},
70		want_finish => sub {},
71		want_error  => sub {},
72		key         => 'aabc',
73		command     => 'status',
74		is_client   => 1,
75	) }
76	qr/Argument 'want_read' is not a code ref/,
77	"new() with bad want_read fails";
78
79throws_ok { Net::RNDC::Session->new(
80		want_read   => sub {},
81		want_write  => 'cat',
82		want_finish => sub {},
83		want_error  => sub {},
84		key         => 'aabc',
85		command     => 'status',
86		is_client   => 1,
87	) }
88	qr/Argument 'want_write' is not a code ref/,
89	"new() with bad want_write fails";
90
91throws_ok { Net::RNDC::Session->new(
92		want_read   => sub {},
93		want_write  => sub {},
94		want_finish => 'cat',
95		want_error  => sub {},
96		key         => 'aabc',
97		command     => 'status',
98		is_client   => 1,
99	) }
100	qr/Argument 'want_finish' is not a code ref/,
101	"new() with bad want_finish fails";
102
103throws_ok { Net::RNDC::Session->new(
104		want_read   => sub {},
105		want_write  => sub {},
106		want_finish => sub {},
107		want_error  => 'cat',
108		key         => 'aabc',
109		command     => 'status',
110		is_client   => 1,
111	) }
112	qr/Argument 'want_error' is not a code ref/,
113	"new() with bad want_error fails";
114
115throws_ok { Net::RNDC::Session->new(
116		want_read   => sub {},
117		want_write  => sub {},
118		want_finish => sub {},
119		want_error  => sub {},
120		key         => 'aabc',
121		command     => 'status',
122		is_client   => 1,
123		is_server   => 1,
124	) }
125	qr/Argument 'is_client' cannot be mixed with 'is_server'/,
126	"new() with is_client and is_server fails";
127
128{
129
130# Test both client/session (which also tests parsing/generation)
131
132# Response from server
133my $sresp;
134
135# Client error, if any
136my $cerror;
137
138# Server error, if any
139my $serror;
140
141my ($client, $server);
142
143$client = Net::RNDC::Session->new(
144	want_read => sub {}, # $server->want_write() handles this
145	want_write => sub {
146		my $c = shift;
147
148		$c->next;
149
150		$server->next(shift);
151	},
152	want_finish => sub {
153		my $c = shift;
154
155		$sresp = shift;
156	},
157	want_error => sub {
158		my $c = shift;
159
160		$cerror = shift;
161	},
162	key       => 'abcd',
163	is_client => 1,
164	command   => 'status',
165);
166
167$server = Net::RNDC::Session->new(
168	want_read => sub {}, # $client->want_write() handles this
169	want_write => sub {
170		my $s = shift;
171
172		$s->next;
173
174		$client->next(shift);
175	},
176	want_finish => sub {
177		my $s = shift;
178
179		return;
180	},
181	want_error => sub {
182		my $s = shift;
183
184		$serror = shift;
185	},
186	key       => 'abcd',
187	is_server => 1,
188	command   => 'hahahaha',
189);
190
191# Calls $server->want_read which does nothing
192$server->start;
193
194# Calls $client->want_write which kicks off the flow
195$client->start;
196
197is($cerror, undef, 'No client error reported');
198is($serror, undef, 'No server error reported');
199
200is($sresp, 'hahahaha', 'Client/Server communicated');
201
202}
203
204done_testing;
205