view release on metacpan or  search on metacpan

test.pl  view on Meta::CPAN

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");