1use strict; 2use warnings FATAL => 'all'; 3use lib 't/inc'; 4use File::Temp qw(tempdir); 5use File::Spec::Functions qw(catfile); 6use POE; 7use POE::Component::IRC::State; 8use POE::Component::IRC::Plugin::Logger; 9use POE::Component::Server::IRC; 10use Test::More; 11 12my $log_dir = tempdir(CLEANUP => 1); 13 14my $bot1 = POE::Component::IRC::State->spawn( 15 Flood => 1, 16 plugin_debug => 1, 17); 18my $bot2 = POE::Component::IRC::State->spawn( 19 Flood => 1, 20 plugin_debug => 1, 21); 22my $ircd = POE::Component::Server::IRC->spawn( 23 Auth => 0, 24 AntiFlood => 0, 25); 26 27$bot2->plugin_add(Logger => POE::Component::IRC::Plugin::Logger->new( 28 Path => $log_dir, 29)); 30 31my $file = catfile($log_dir, '=testbot1.log'); 32unlink $file if -e $file; 33 34my @correct = ( 35 qr/^--> Opened DCC chat connection with TestBot1 \(\S+:\d+\)$/, 36 '<TestBot1> Oh hi', 37 '* TestBot1 does something', 38 '<TestBot2> Hi yourself', 39 '* TestBot2 does something as well', 40 qr/^<-- Closed DCC chat connection with TestBot1 \(\S+:\d+\)$/, 41); 42 43plan tests => 7 + @correct; 44 45POE::Session->create( 46 package_states => [ 47 main => [qw( 48 _start 49 ircd_listener_add 50 ircd_listener_failure 51 _shutdown 52 irc_001 53 irc_dcc_request 54 irc_dcc_start 55 irc_dcc_chat 56 irc_disconnected 57 )], 58 ], 59); 60 61$poe_kernel->run(); 62 63sub _start { 64 my ($kernel) = $_[KERNEL]; 65 66 $ircd->yield('register', 'all'); 67 $ircd->yield('add_listener'); 68 $kernel->delay(_shutdown => 60, 'Timed out'); 69} 70 71sub ircd_listener_failure { 72 my ($kernel, $op, $reason) = @_[KERNEL, ARG1, ARG3]; 73 $kernel->yield('_shutdown', "$op: $reason"); 74} 75 76sub ircd_listener_add { 77 my ($kernel, $port) = @_[KERNEL, ARG0]; 78 79 $bot1->yield(register => 'all'); 80 $bot1->yield(connect => { 81 nick => 'TestBot1', 82 server => '127.0.0.1', 83 port => $port, 84 }); 85 86 $bot2->yield(register => 'all'); 87 $bot2->yield(connect => { 88 nick => 'TestBot2', 89 server => '127.0.0.1', 90 port => $port, 91 }); 92} 93 94sub _shutdown { 95 my ($kernel, $error) = @_[KERNEL, ARG0]; 96 fail($error) if defined $error; 97 98 $kernel->alarm_remove_all(); 99 $ircd->yield('shutdown'); 100 $bot1->yield('shutdown'); 101 $bot2->yield('shutdown'); 102} 103 104sub irc_001 { 105 my ($heap, $server) = @_[HEAP, ARG0]; 106 my $irc = $_[SENDER]->get_heap(); 107 108 pass($irc->nick_name() . ' logged in'); 109 $heap->{logged_in}++; 110 return if $heap->{logged_in} != 2; 111 $bot2->yield(dcc => $bot1->nick_name() => CHAT => undef, undef, 5); 112} 113 114sub irc_dcc_request { 115 my ($sender, $cookie) = @_[SENDER, ARG3]; 116 my $irc = $sender->get_heap(); 117 pass($irc->nick_name() . ' got dcc request'); 118 $irc->yield(dcc_accept => $cookie); 119} 120 121sub irc_dcc_start { 122 my ($sender, $heap, $id) = @_[SENDER, HEAP, ARG0]; 123 my $irc = $sender->get_heap(); 124 pass($irc->nick_name() . ' got irc_dcc_started'); 125 126 $heap->{started}++; 127 if ($heap->{started} == 2) { 128 $irc->yield(dcc_chat => $id, 'Oh hi'); 129 $irc->yield(dcc_chat => $id, "\001ACTION does something\001"); 130 } 131} 132 133sub irc_dcc_chat { 134 my ($heap, $sender, $id, $msg) = @_[HEAP, SENDER, ARG0, ARG3]; 135 my $irc = $sender->get_heap(); 136 137 $heap->{msgs}++; 138 if ($heap->{msgs} == 2) { 139 $irc->yield(dcc_chat => $id, 'Hi yourself'); 140 $irc->yield(dcc_chat => $id, "\001ACTION does something as well\001"); 141 } 142 elsif ($heap->{msgs} == 4) { 143 $irc->yield(dcc_close => $id); 144 $bot1->yield('quit'); 145 $bot2->yield('quit'); 146 } 147} 148 149sub irc_disconnected { 150 my ($kernel, $heap) = @_[KERNEL, HEAP]; 151 pass('irc_disconnected'); 152 $heap->{count}++; 153 154 if ($heap->{count} == 2) { 155 verify_log(); 156 $kernel->yield('_shutdown'); 157 } 158} 159 160sub verify_log { 161 open my $log, '<', $file or die "Can't open log file '$file': $!"; 162 my @lines = <$log>; 163 close $log; 164 165 my $check = 0; 166 for my $line (@lines) { 167 next if $line =~ /^\*{3}/; 168 chomp $line; 169 $line = substr($line, 20); 170 last if !defined $correct[$check]; 171 172 if (ref $correct[$check] eq 'Regexp') { 173 like($line, $correct[$check], 'Line ' . ($check+1)); 174 } 175 else { 176 is($line, $correct[$check], 'Line ' . ($check+1)); 177 } 178 $check++; 179 } 180 fail('Log too short') if $check > @correct; 181} 182