Net-IRC3/t/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/;
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 => 16;

{
   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 $ss     = {}; # server state
   my $checks = { stage => 0 }; # for storing testing check results

   $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_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
      },
      channel_add => sub {
         my ($cl, $chan, @nicks) = @_;

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

         } elsif ($chan eq $test_chan2 && $checks->{stage} == 2) {
            push @{$checks->{stage_2_nicks}}, @nicks;
            @{$checks->{stage_2_nicks}} = uniq (@{$checks->{stage_2_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;
            $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_srv (JOIN => $test_chan1);

   start_watchdog ($c, $checks);

   $c->wait;

   $nick .= "|_";

   # TEST CHECKS:

   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->{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 ($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.1
Committed:	Sat Feb 24 10:24:55 2007 UTC (19 years, 6 months ago) by elmex
Content type:	application/x-troff
Branch:	MAIN
Log Message:	added further tests and improved modules
#	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/;
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 => 16;
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 $ss = {}; # server state
58			my $checks = { stage => 0 }; # for storing testing check results
59
60			$srv->reg_cb (
61			irc_nick => sub {
62			my ($srv, $p) = @_;
63			$ss->{nick} = $p->{params}->[0];
64
65			if ($ss->{retry} < 2) {
66			if ($ss->{retry} > 0) {
67			$cl->set_nick_change_cb (undef);
68			}
69
70			$ss->{retry}++;
71			$srv->send_msg (
72			'localhost', '433' =>
73			"Nickname is already in use", $ss->{nick}
74			);
75
76			} elsif ($checks->{stage} == 0) {
77			$checks->{srv_nick} = $ss->{nick};
78
79			$ss->{cl_prefix} = sprintf "%s!%s@%s", $ss->{nick}, $ss->{user}, 'localhost';
80
81			if ($ss->{user}) {
82			$srv->send_msg (
83			'localhost', '001' =>
84			'Welcome to the Net::IRC3 test', $ss->{nick}
85			);
86			}
87			}
88			1
89			},
90			irc_user => sub {
91			my ($srv, $p) = @_;
92			$ss->{user} = $p->{params}->[0];
93			$ss->{real} = $p->{params}->[3];
94
95			$checks->{srv_user} = $ss->{user};
96			$checks->{srv_real} = $ss->{real};
97			$checks->{srv_nick} = $ss->{nick};
98
99			1
100			},
101			irc_pong => sub {
102			my ($srv) = @_;
103			$checks->{recv_pong} = 1;
104			1
105			},
106			irc_join => sub {
107			my ($srv, $p) = @_;
108			my $chan = $p->{params}->[0];
109			$srv->send_msg ($ss->{cl_prefix}, JOIN => $chan);
110
111			if ($chan eq $test_chan1) {
112			$srv->send_msg (
113			'localhost', '353',
114			(join ' ', @test_nicks, $ss->{nick}),
115			$ss->{nick}, '=', $chan
116			);
117
118			$srv->send_raw ("PING :fooobar");
119
120			$srv->send_msg (
121			'localhost', '366',
122			'End of /NAMES list',
123			$ss->{nick}, $chan
124			);
125			$ss->{chan1} = [ @test_nicks, $ss->{nick} ];
126
127			} elsif ($chan eq $test_chan2) {
128			$srv->send_msg (
129			'localhost', '353',
130			(join ' ', '@' . $ss->{nick}),
131			$ss->{nick}, '=', $chan
132			);
133			$srv->send_msg (
134			'localhost', '366',
135			'End of /NAMES list',
136			$ss->{nick}, $chan
137			);
138
139			$ss->{chan2} = [ '@' . $ss->{nick} ];
140			}
141
142			1
143			},
144			disconnect => sub {
145			my ($srv, $r) = @_;
146			$checks->{srv_disconnect} = $r;
147			$c->broadcast;
148			1
149			}
150			);
151
152			$cl->reg_cb (
153			registered => sub {
154			my ($cl) = @_;
155			$checks->{connected} = $cl->is_connected;
156			$checks->{registered} = $cl->nick;
157			$checks->{stage} = 1;
158			1
159			},
160			irc_ping => sub {
161			my ($cl) = @_;
162			$checks->{recv_ping} = 1;
163			1
164			},
165			irc_join => sub {
166			my ($cl, $p) = @_;
167
168			if ($checks->{stage} == 1) {
169			my ($n, $u, $h) = split_prefix ($p);
170			$checks->{stage_1_prefix} = [$n, $u, $h];
171			}
172			1
173			},
174			channel_add => sub {
175			my ($cl, $chan, @nicks) = @_;
176
177			if ($chan eq $test_chan1 && $checks->{stage} == 1) {
178			push @{$checks->{stage_1_nicks}}, @nicks;
179			@{$checks->{stage_1_nicks}} = uniq (@{$checks->{stage_1_nicks}});
180
181			} elsif ($chan eq $test_chan2 && $checks->{stage} == 2) {
182			push @{$checks->{stage_2_nicks}}, @nicks;
183			@{$checks->{stage_2_nicks}} = uniq (@{$checks->{stage_2_nicks}});
184
185			}
186
187			if ($checks->{stage} == 1
188			&& scalar (@{$checks->{stage_1_nicks}}) == scalar (@test_nicks) + 1)
189			{
190			$checks->{stage} = 2;
191			$cl->send_srv (JOIN => $test_chan2);
192
193			} elsif ($checks->{stage} == 2 && scalar (@{$checks->{stage_2_nicks}}) == 1) {
194			$checks->{stage} = 3;
195			$cl->disconnect ("done");
196			}
197
198			1
199			},
200			disconnect => sub {
201			my ($cl, $r) = @_;
202			$checks->{cl_disconnect} = $r;
203			1
204			}
205			);
206
207			$cl->set_nick_change_cb (sub {
208			my ($n) = @_;
209			"$n\|"
210			});
211
212			$cl->register ($nick, $user, $real);
213			$cl->send_srv (JOIN => $test_chan1);
214
215			start_watchdog ($c, $checks);
216
217			$c->wait;
218
219			$nick .= "\|_";
220
221			# TEST CHECKS:
222
223			ok ($checks->{connected}, "client connected");
224			is ($checks->{registered}, $nick, "client registered with correct nick");
225			is ($checks->{srv_nick}, $nick, "server got nick after 2 collisions");
226			is ($checks->{srv_user}, $user, "server got user");
227			is ($checks->{srv_real}, $real, "server got real");
228			ok ($checks->{recv_ping}, "client got ping");
229			ok ($checks->{recv_pong}, "server got pong");
230			is ($checks->{stage_1_prefix}->[0], $nick, "stage 1: nick prefix ok");
231			is ($checks->{stage_1_prefix}->[1], $user, "stage 1: user prefix ok");
232			is ($checks->{stage_1_prefix}->[2], 'localhost', "stage 1: host prefix ok");
233			is (
234			(join ' ', sort @{$checks->{stage_1_nicks} \|\| []}),
235			(join ' ', sort map { s/^@//; $_ } @test_nicks, $nick),
236			"stage 1: successfully joined channel with test users"
237			);
238			is (
239			(join ' ', sort @{$checks->{stage_2_nicks} \|\| []}),
240			(join ' ', sort $nick),
241			"stage 2: successfully joined second channel without"
242			);
243			is ($checks->{stage}, 3, "last test stage reached");
244			is ($checks->{cl_disconnect}, 'done', "client disconnected");
245			like ($checks->{srv_disconnect}, qr/EOF/, "server disconnected");
246			ok (!$checks->{watchdog}, "watchdog didn't trigger");
247			}