#
# $Header: /cvsroot/Net::EasyTCP/test.pl,v 1.20 2003/07/11 19:23:42 mina Exp $
#
BEGIN {
$| = 1;
select(STDERR);
$| = 1;
select(STDOUT);
print "1..7\n";
}
END { print "not ok 1\n" unless $loaded; }
use Net::EasyTCP;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
#
#
# Because windows is such a crappy OS that does not support (well) a fork() or alarm(), we can not possibly
# run this test. (HOWEVER, THE MODULE STILL WORKS OK !) Sorry !
#
nowindows();
my $num = 1;
my $PORT = undef;
my $SERVER = undef;
prepareserver();
startclient();
startserver();
sub nowindows {
if ($^O =~ /win32/i) {
for (2 .. 7) {
print "ok $_\n";
}
warn("\n\nWARNING: SINCE YOU'RE RUNNING WINDOWS, WE COULD NOT TRULY TEST CLIENT-SERVER FUNCTIONALITY WITHIN 1 PROCESS. ASSUMING TEST SUCCEEDED\n\n");
warn("\n\nTO PROPERLY TEST THIS MODULE, LOOK INTO THE /util/ SUBFOLDER OF THIS DISTRO AND MANYALLY RUN THE server.pl THERE, THEN CONCURRENTLY RUN THE client.pl\n\n");
exit(0);
}
}
sub res {
my $res = shift;
my $desc = shift;
$num++;
if ($res) {
print "ok $num\n";
}
else {
print "not ok $num\n";
warn "Error in test [$desc]: $@\n";
die ("ABORTING TEST\n");
}
}
sub prepareserver {
my $temp;
my @tryports = qw(2345 65496 1025 2042);
foreach (@tryports) {
$PORT = $_;
$SERVER = new Net::EasyTCP(
mode => "server",
port => $PORT,
password => "just another perl hacker",
);
if ($SERVER) {
#
# We succeeded, no need to loop and try a different port
#
last;
}
}
res($SERVER, "Create new server");
$temp = $SERVER->setcallback(
data => \&gotdata,
connect => \&connected,
disconnect => \&disconnected,
);
res($temp, "Set callbacks");
}
sub startserver {
$SERVER->start();
}
sub startclient {
my $temp;
my $pid;
my $starttime;
my $maxelapsed = "15";
$pid = fork();
if ($pid) {
# I'm the parent
return;
}
elsif ($pid == 0) {
# I'm the client
undef $SERVER;
}
else {
die "ERROR: FAILED TO FORK A PROCESS FOR A CLIENT: $!\n";
}
$starttime = time;
while ((time - $starttime) <= $maxelapsed) {
$client = new Net::EasyTCP(
mode => "client",
host => '127.0.0.1',
port => $PORT,
password => "just another perl hacker",
);
if ($client) {
last;
}
}
$client || die "ERROR: CLIENT FAILED TO BE CREATED WITHIN $maxelapsed SECONDS: $@\n";
$temp = $client->receive();
($temp eq "SEND ME COMPLEX") || die "ERROR: CLIENT RECEIVED [$temp] INSTEAD OF [SEND ME COMPLEX]\n";
$temp = $client->send({ "complex" => "data" })
|| die "ERROR: CLIENT FAILED TO SEND HASH REFERENCE: $@\n";
$temp = $client->close()
|| die "ERROR: CLIENT FAILED TO CLOSE CONNECTION: $@\n";
exit(0);
}
sub connected {
my $client = shift;
my $temp;
res($client, "Server received connection");
$temp = $client->send("SEND ME COMPLEX");
res($temp, "Server send data from callback");
}
sub gotdata {
my $client = shift;
my $data = $client->data();
res($data->{complex} eq "data", "Server receive complex data");
}
sub disconnected {
my $client = shift;
res($client, "Server received client disconnection");
exit(0);
}
syntax highlighted by Code2HTML, v. 0.9.1