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