t/local/events.t

#!perl
use strict;
no warnings;
use Test::More;
use AnyEvent::Impl::Perl;
use AnyEvent;
use Net::IRC3::Connection;
use Net::IRC3::Client::Connection;
use Net::IRC3::Util qw/split_prefix prefix_nick/;
use Socket;
use IO::Handle;
$Net::IRC3::Client::Connection::DEBUG = 1;

our $WATCHDOG;

sub prepare_cl_srv {
   my $srv = Net::IRC3::Connection->new;
   my $cl  = Net::IRC3::Client::Connection->new;

   socketpair (my $s1, my $s2, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
      or die "socketpair: $!";
   $s1 or die "couldn't make socketpair: $!";
   $srv->use_socket ('localhost', '65533', $s1);
   $cl->use_socket ('localhost', '6667', $s2);

   ($srv, $cl)
}

sub start_watchdog {
   my ($c, $checks) = @_;
   $WATCHDOG =
      AnyEvent->timer (after => 10, cb => sub {
         $c->broadcast;
         $checks->{watchdog} = 1;
         undef $WATCHDOG
      });
}

sub uniq {
   my (@lst) = @_;
   my %h;
   $h{$_}++ for @lst;
   keys %h
}

plan tests => 20;

{
   my $c = AnyEvent->condvar;

   my ($srv, $cl) = prepare_cl_srv;
   my ($nick, $user, $real) = (test => testbot => "I'm a Net::IRC3 test");
   my @test_nicks = qw/@elmex @testor foobar/; # for channel $test_chan1
   my $test_chan1 = '#test';
   my $test_chan2 = '#tESt2';

   my $test_chan_msg_srcnick = 'testbot';

   my $ss     = {}; # server state
   my $checks = $cl->heap; # for storing testing check results
   $checks->{stage} = 0;

   $srv->reg_cb (
      irc_nick => sub {
         my ($srv, $p) = @_;
         $ss->{nick} = $p->{params}->[0];

         if ($ss->{retry} < 2) {
            if ($ss->{retry} > 0) {
               $cl->set_nick_change_cb (undef);
            }

            $ss->{retry}++;
            $srv->send_msg (
               'localhost', '433' =>
               "Nickname is already in use", $ss->{nick}
            );

         } elsif ($checks->{stage} == 0) {
            $checks->{srv_nick} = $ss->{nick};

            $ss->{cl_prefix} = sprintf "%s!%s@%s", $ss->{nick}, $ss->{user}, 'localhost';

            if ($ss->{user}) {
               $srv->send_msg (
                  'localhost', '001' =>
                  'Welcome to the Net::IRC3 test', $ss->{nick}
               );
            }
         }
         1
      },
      irc_user => sub {
         my ($srv, $p) = @_;
         $ss->{user} = $p->{params}->[0];
         $ss->{real} = $p->{params}->[3];

         $checks->{srv_user} = $ss->{user};
         $checks->{srv_real} = $ss->{real};
         $checks->{srv_nick} = $ss->{nick};

         1
      },
      irc_pong => sub {
         my ($srv) = @_;
         $checks->{recv_pong} = 1;
         1
      },
      irc_privmsg => sub {
         my ($srv, $m) = @_;
         if ($m->{trailing} =~ /TEST HELLO/) {
            $srv->send_msg (
               $test_chan_msg_srcnick
               . '!'
               . $test_chan_msg_srcnick
               . '@localhost',
               PRIVMSG => "TEST REPLY", $m->{params}->[0]
            );
            $checks->{recv_message} = $m->{trailing};
         }
      },
      irc_join => sub {
         my ($srv, $p) = @_;
         my $chan = $p->{params}->[0];
         $srv->send_msg ($ss->{cl_prefix}, JOIN => $chan);

         if ($chan eq $test_chan1) {
            $srv->send_msg (
               'localhost', '353',
               (join ' ', @test_nicks, $ss->{nick}),
               $ss->{nick}, '=', $chan
            );

            $srv->send_raw ("PING :fooobar");

            $srv->send_msg (
               'localhost', '366',
               'End of /NAMES list',
               $ss->{nick}, $chan
            );
            $ss->{chan1} = [ @test_nicks, $ss->{nick} ];

         } elsif ($chan eq $test_chan2) {
            $srv->send_msg (
               'localhost', '353',
               (join ' ', '@' . $ss->{nick}),
               $ss->{nick}, '=', $chan
            );
            $srv->send_msg (
               'localhost', '366',
               'End of /NAMES list',
               $ss->{nick}, $chan
            );

            $ss->{chan2} = [ '@' . $ss->{nick} ];
         }

         1
      },
      disconnect => sub {
         my ($srv, $r) = @_;
         $checks->{srv_disconnect} = $r;
         $c->broadcast;
         1
      }
   );

   $cl->reg_cb (
      registered => sub {
         my ($cl) = @_;
         $checks->{connected} = $cl->is_connected;
         $checks->{registered} = $cl->nick;
         $checks->{stage} = 1;
         1
      },
      irc_ping => sub {
         my ($cl) = @_;
         $checks->{recv_ping} = 1;
         1
      },
      irc_join => sub {
         my ($cl, $p) = @_;

         if ($checks->{stage} == 1) {
            my ($n, $u, $h) = split_prefix ($p);
            $checks->{stage_1_prefix} = [$n, $u, $h];
         }
         1
      },
      publicmsg => sub {
         my ($cl, $chan, $msg) = @_;
         $checks->{public_reply} = [prefix_nick ($msg), $msg->{trailing}];
         1
      },
      channel_add => sub {
         my ($cl, $chan, @nicks) = @_;

         if ($chan eq $test_chan1 && $checks->{stage} == 1) {
            push @{$checks->{stage_1_nicks}}, @nicks;

         } elsif ($chan eq $test_chan2 && $checks->{stage} == 2) {
            push @{$checks->{stage_2_nicks}}, @nicks;

         }

         if ($checks->{stage} == 1
             && scalar (@{$checks->{stage_1_nicks} || []}) == scalar (@test_nicks) + 1)
         {
            $checks->{stage} = 2;
            $cl->send_srv (JOIN => $test_chan2);

         } elsif ($checks->{stage} == 2 && scalar (@{$checks->{stage_2_nicks} || []}) == 1) {
            $checks->{stage} = 3;
            $checks->{stage_3_channel_list} = [ keys %{$cl->channel_list} ];
            $cl->disconnect ("done");
         }

         1
      },
      disconnect => sub {
         my ($cl, $r) = @_;
         $checks->{cl_disconnect} = $r;
         1
      }
   );

   $cl->set_nick_change_cb (sub {
      my ($n) = @_;
      "$n|"
   });

   $cl->register ($nick, $user, $real);
   $cl->send_chan ($test_chan1, PRIVMSG => "TEST HELLO", $test_chan1);
   $cl->send_srv (JOIN => $test_chan1);

   start_watchdog ($c, $checks);

   $c->wait;

   $nick .= "|_";

   # TEST CHECKS:

   $checks = $cl->heap;

   ok ($checks->{connected},  "client connected");
   is ($checks->{registered}, $nick, "client registered with correct nick");
   is ($checks->{srv_nick},   $nick, "server got nick after 2 collisions");
   is ($checks->{srv_user},   $user, "server got user");
   is ($checks->{srv_real},   $real, "server got real");
   ok ($checks->{recv_ping},  "client got ping");
   ok ($checks->{recv_pong},  "server got pong");
   is ($checks->{recv_message},      'TEST HELLO', "channel message received by server");
   is ($checks->{public_reply}->[0], $test_chan_msg_srcnick,
       "channel message reply received by client from right nick");
   is ($checks->{public_reply}->[1], 'TEST REPLY',
       "channel message reply received by client");
   is ($checks->{stage_1_prefix}->[0], $nick,       "stage 1: nick prefix ok");
   is ($checks->{stage_1_prefix}->[1], $user,       "stage 1: user prefix ok");
   is ($checks->{stage_1_prefix}->[2], 'localhost', "stage 1: host prefix ok");
   is (
      (join ' ', sort @{$checks->{stage_1_nicks} || []}),
      (join ' ', sort map { s/^@//; $_ } @test_nicks, $nick),
      "stage 1: successfully joined channel with test users"
   );
   is (
      (join ' ', sort @{$checks->{stage_2_nicks} || []}),
      (join ' ', sort $nick),
      "stage 2: successfully joined second channel without"
   );
   is (
      (join ' ', sort @{$checks->{stage_3_channel_list} || []}),
      (join ' ', sort map lc $_, $test_chan1, $test_chan2),
      "stage 3: channel list ok"
   );
   is ($checks->{stage}, 3, "last test stage reached");
   is ($checks->{cl_disconnect}, 'done', "client disconnected");
   like ($checks->{srv_disconnect}, qr/EOF/, "server disconnected");
   ok (!$checks->{watchdog}, "watchdog didn't trigger");
}
Revision:	1.2
Committed:	Wed Jul 9 09:48:20 2008 UTC (18 years, 2 months ago) by elmex
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.1:	+2 -2 lines
Log Message:	non blocknig connect tested => ok
#	User	Rev	Content
1	elmex	1.1	#!perl
2			use strict;
3			no warnings;
4			use Test::More;
5			use AnyEvent::Impl::Perl;
6			use AnyEvent;
7			use Net::IRC3::Connection;
8			use Net::IRC3::Client::Connection;
9			use Net::IRC3::Util qw/split_prefix prefix_nick/;
10			use Socket;
11			use IO::Handle;
12			$Net::IRC3::Client::Connection::DEBUG = 1;
13
14			our $WATCHDOG;
15
16			sub prepare_cl_srv {
17			my $srv = Net::IRC3::Connection->new;
18			my $cl = Net::IRC3::Client::Connection->new;
19
20			socketpair (my $s1, my $s2, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
21			or die "socketpair: $!";
22			$s1 or die "couldn't make socketpair: $!";
23			$srv->use_socket ('localhost', '65533', $s1);
24			$cl->use_socket ('localhost', '6667', $s2);
25
26			($srv, $cl)
27			}
28
29			sub start_watchdog {
30			my ($c, $checks) = @_;
31			$WATCHDOG =
32			AnyEvent->timer (after => 10, cb => sub {
33			$c->broadcast;
34			$checks->{watchdog} = 1;
35			undef $WATCHDOG
36			});
37			}
38
39			sub uniq {
40			my (@lst) = @_;
41			my %h;
42			$h{$_}++ for @lst;
43			keys %h
44			}
45
46			plan tests => 20;
47
48			{
49			my $c = AnyEvent->condvar;
50
51			my ($srv, $cl) = prepare_cl_srv;
52			my ($nick, $user, $real) = (test => testbot => "I'm a Net::IRC3 test");
53			my @test_nicks = qw/@elmex @testor foobar/; # for channel $test_chan1
54			my $test_chan1 = '#test';
55			my $test_chan2 = '#tESt2';
56
57			my $test_chan_msg_srcnick = 'testbot';
58
59			my $ss = {}; # server state
60			my $checks = $cl->heap; # for storing testing check results
61			$checks->{stage} = 0;
62
63			$srv->reg_cb (
64			irc_nick => sub {
65			my ($srv, $p) = @_;
66			$ss->{nick} = $p->{params}->[0];
67
68			if ($ss->{retry} < 2) {
69			if ($ss->{retry} > 0) {
70			$cl->set_nick_change_cb (undef);
71			}
72
73			$ss->{retry}++;
74			$srv->send_msg (
75			'localhost', '433' =>
76			"Nickname is already in use", $ss->{nick}
77			);
78
79			} elsif ($checks->{stage} == 0) {
80			$checks->{srv_nick} = $ss->{nick};
81
82			$ss->{cl_prefix} = sprintf "%s!%s@%s", $ss->{nick}, $ss->{user}, 'localhost';
83
84			if ($ss->{user}) {
85			$srv->send_msg (
86			'localhost', '001' =>
87			'Welcome to the Net::IRC3 test', $ss->{nick}
88			);
89			}
90			}
91			1
92			},
93			irc_user => sub {
94			my ($srv, $p) = @_;
95			$ss->{user} = $p->{params}->[0];
96			$ss->{real} = $p->{params}->[3];
97
98			$checks->{srv_user} = $ss->{user};
99			$checks->{srv_real} = $ss->{real};
100			$checks->{srv_nick} = $ss->{nick};
101
102			1
103			},
104			irc_pong => sub {
105			my ($srv) = @_;
106			$checks->{recv_pong} = 1;
107			1
108			},
109			irc_privmsg => sub {
110			my ($srv, $m) = @_;
111			if ($m->{trailing} =~ /TEST HELLO/) {
112			$srv->send_msg (
113			$test_chan_msg_srcnick
114			. '!'
115			. $test_chan_msg_srcnick
116			. '@localhost',
117			PRIVMSG => "TEST REPLY", $m->{params}->[0]
118			);
119			$checks->{recv_message} = $m->{trailing};
120			}
121			},
122			irc_join => sub {
123			my ($srv, $p) = @_;
124			my $chan = $p->{params}->[0];
125			$srv->send_msg ($ss->{cl_prefix}, JOIN => $chan);
126
127			if ($chan eq $test_chan1) {
128			$srv->send_msg (
129			'localhost', '353',
130			(join ' ', @test_nicks, $ss->{nick}),
131			$ss->{nick}, '=', $chan
132			);
133
134			$srv->send_raw ("PING :fooobar");
135
136			$srv->send_msg (
137			'localhost', '366',
138			'End of /NAMES list',
139			$ss->{nick}, $chan
140			);
141			$ss->{chan1} = [ @test_nicks, $ss->{nick} ];
142
143			} elsif ($chan eq $test_chan2) {
144			$srv->send_msg (
145			'localhost', '353',
146			(join ' ', '@' . $ss->{nick}),
147			$ss->{nick}, '=', $chan
148			);
149			$srv->send_msg (
150			'localhost', '366',
151			'End of /NAMES list',
152			$ss->{nick}, $chan
153			);
154
155			$ss->{chan2} = [ '@' . $ss->{nick} ];
156			}
157
158			1
159			},
160			disconnect => sub {
161			my ($srv, $r) = @_;
162			$checks->{srv_disconnect} = $r;
163			$c->broadcast;
164			1
165			}
166			);
167
168			$cl->reg_cb (
169			registered => sub {
170			my ($cl) = @_;
171			$checks->{connected} = $cl->is_connected;
172			$checks->{registered} = $cl->nick;
173			$checks->{stage} = 1;
174			1
175			},
176			irc_ping => sub {
177			my ($cl) = @_;
178			$checks->{recv_ping} = 1;
179			1
180			},
181			irc_join => sub {
182			my ($cl, $p) = @_;
183
184			if ($checks->{stage} == 1) {
185			my ($n, $u, $h) = split_prefix ($p);
186			$checks->{stage_1_prefix} = [$n, $u, $h];
187			}
188			1
189			},
190			publicmsg => sub {
191			my ($cl, $chan, $msg) = @_;
192			$checks->{public_reply} = [prefix_nick ($msg), $msg->{trailing}];
193			1
194			},
195			channel_add => sub {
196			my ($cl, $chan, @nicks) = @_;
197
198			if ($chan eq $test_chan1 && $checks->{stage} == 1) {
199			push @{$checks->{stage_1_nicks}}, @nicks;
200
201			} elsif ($chan eq $test_chan2 && $checks->{stage} == 2) {
202			push @{$checks->{stage_2_nicks}}, @nicks;
203
204			}
205
206			if ($checks->{stage} == 1
207	elmex	1.2	&& scalar (@{$checks->{stage_1_nicks} \|\| []}) == scalar (@test_nicks) + 1)
208	elmex	1.1	{
209			$checks->{stage} = 2;
210			$cl->send_srv (JOIN => $test_chan2);
211
212	elmex	1.2	} elsif ($checks->{stage} == 2 && scalar (@{$checks->{stage_2_nicks} \|\| []}) == 1) {
213	elmex	1.1	$checks->{stage} = 3;
214			$checks->{stage_3_channel_list} = [ keys %{$cl->channel_list} ];
215			$cl->disconnect ("done");
216			}
217
218			1
219			},
220			disconnect => sub {
221			my ($cl, $r) = @_;
222			$checks->{cl_disconnect} = $r;
223			1
224			}
225			);
226
227			$cl->set_nick_change_cb (sub {
228			my ($n) = @_;
229			"$n\|"
230			});
231
232			$cl->register ($nick, $user, $real);
233			$cl->send_chan ($test_chan1, PRIVMSG => "TEST HELLO", $test_chan1);
234			$cl->send_srv (JOIN => $test_chan1);
235
236			start_watchdog ($c, $checks);
237
238			$c->wait;
239
240			$nick .= "\|_";
241
242			# TEST CHECKS:
243
244			$checks = $cl->heap;
245
246			ok ($checks->{connected}, "client connected");
247			is ($checks->{registered}, $nick, "client registered with correct nick");
248			is ($checks->{srv_nick}, $nick, "server got nick after 2 collisions");
249			is ($checks->{srv_user}, $user, "server got user");
250			is ($checks->{srv_real}, $real, "server got real");
251			ok ($checks->{recv_ping}, "client got ping");
252			ok ($checks->{recv_pong}, "server got pong");
253			is ($checks->{recv_message}, 'TEST HELLO', "channel message received by server");
254			is ($checks->{public_reply}->[0], $test_chan_msg_srcnick,
255			"channel message reply received by client from right nick");
256			is ($checks->{public_reply}->[1], 'TEST REPLY',
257			"channel message reply received by client");
258			is ($checks->{stage_1_prefix}->[0], $nick, "stage 1: nick prefix ok");
259			is ($checks->{stage_1_prefix}->[1], $user, "stage 1: user prefix ok");
260			is ($checks->{stage_1_prefix}->[2], 'localhost', "stage 1: host prefix ok");
261			is (
262			(join ' ', sort @{$checks->{stage_1_nicks} \|\| []}),
263			(join ' ', sort map { s/^@//; $_ } @test_nicks, $nick),
264			"stage 1: successfully joined channel with test users"
265			);
266			is (
267			(join ' ', sort @{$checks->{stage_2_nicks} \|\| []}),
268			(join ' ', sort $nick),
269			"stage 2: successfully joined second channel without"
270			);
271			is (
272			(join ' ', sort @{$checks->{stage_3_channel_list} \|\| []}),
273			(join ' ', sort map lc $_, $test_chan1, $test_chan2),
274			"stage 3: channel list ok"
275			);
276			is ($checks->{stage}, 3, "last test stage reached");
277			is ($checks->{cl_disconnect}, 'done', "client disconnected");
278			like ($checks->{srv_disconnect}, qr/EOF/, "server disconnected");
279			ok (!$checks->{watchdog}, "watchdog didn't trigger");
280			}