Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: ruoso/IO-BindHandles
base: b447605321
...
head fork: ruoso/IO-BindHandles
compare: bd633ae7b0
Checking mergeability… Don't worry, you can still create the pull request.
  • 4 commits
  • 3 files changed
  • 0 commit comments
  • 1 contributor
Showing with 48 additions and 17 deletions.
  1. +10 −0 Changes
  2. +1 −1  dist.ini
  3. +37 −16 t/02-socket.t
View
10 Changes
@@ -1,4 +1,14 @@
+cpan/0.004
+ 4a19c69 2011-06-02 Daniel Ruoso
+ bump version
+ 1462b13 2011-06-02 Daniel Ruoso
+ change tests so that we get more info from reports
+ b447605 2011-05-28 Daniel Ruoso
+ use ReadmeFromPod
+ 194eea8 2011-05-28 Daniel Ruoso
+ adding changelog
+
cpan/0.003
09770a1 2011-05-28 Daniel Ruoso
Version bumb to 0.003
View
2  dist.ini
@@ -4,7 +4,7 @@ license = Perl_5
copyright_holder = Daniel Ruoso
copyright_year = 2011
-version = 0.003
+version = 0.005
[GatherDir]
[MetaYAML]
View
53 t/02-socket.t
@@ -5,37 +5,49 @@ use warnings;
use IO::BindHandles;
use IO::Handle;
use IO::Socket::UNIX;
-use File::Temp qw(:POSIX );
# in this test we'll build a server that echoes uppercase output, a
# client that posts a set of lines and a proxy that should bind all
# the handles.
-my $socket_name = tmpnam();
+my $socket_name;
+BEGIN {
+ $socket_name = 't/02-socket.sock';
+ unlink $socket_name;
+}
+END {
+ unlink $socket_name;
+}
+
+print '#'."[MAIN] will fork server\n";
my $server_pid = fork();
if ($server_pid == 0) {
# this is our server that will keep buffer for a while...
my $sock = IO::Socket::UNIX->new( Local => $socket_name, Listen => 1 ) or die $!;
- my $sock_c = $sock->accept();
+ my $sock_c = $sock->accept() or die $!;
my @buffer;
my $count = 0;
- #warn "[SERVER] before loop.\n";
+ print '#'."[SERVER] before loop.\n";
while (my $input = $sock_c->getline()) {
chomp $input;
- #warn "[SERVER] got $input.\n";
+ print '#'."[SERVER] got $input.\n";
push @buffer, uc($input);
if ($count++ & 1) {
- #warn "[SERVER] print.\n";
+ print '#'."[SERVER] print.\n";
$sock_c->print(shift(@buffer)."\n");
}
last if $input eq 'case';
}
- #warn "[SERVER] after loop.\n";
+ print '#'."[SERVER] after loop.\n";
$sock_c->print($_."\n") for @buffer;
- #warn "[SERVER] after print.\n";
+ print '#'."[SERVER] after print.\n";
+ $sock_c->close;
exit 0;
+} elsif (not defined $server_pid) {
+ die 'Failed to fork server side.';
}
+print '#'."[MAIN] Will setup the pipes\n";
# The STDIN/STDOUT pipes for our client...
my ($cli_stdin_r, $cli_stdin_w, $cli_stdout_r, $cli_stdout_w) = map { IO::Handle->new() } 1..4;
pipe($cli_stdin_r, $cli_stdin_w);
@@ -45,6 +57,7 @@ $cli_stdin_w->autoflush(1);
$cli_stdout_r->autoflush(1);
$cli_stdout_w->autoflush(1);
+print '#'."[MAIN] Will fork the client\n";
my $client_pid = fork();
if ($client_pid == 0) {
require Test::More;
@@ -54,30 +67,34 @@ if ($client_pid == 0) {
# this is our client...
# let's sleep 2 seconds so the proxy starts...
my @text = qw(this is our test set of strings to be sent lower case);
- #warn "[CLIENT] starting loop.\n";
+ print '#'."[CLIENT] starting loop.\n";
foreach my $l (@text) {
- #warn "[CLIENT] wrote line $l.\n";
+ print '#'."[CLIENT] wrote line $l.\n";
$cli_stdin_w->print($l."\n");
}
- #warn "[CLIENT] out of write loop.\n";
- $cli_stdin_w->close();
+ print '#'."[CLIENT] out of write loop.\n";
my @ret;
while (my $l = $cli_stdout_r->getline()) {
chomp $l;
- #warn "[CLIENT] got line $l.\n";
+ print '#'."[CLIENT] got line $l.\n";
push @ret, $l;
}
- #warn "[CLIENT] read it all.\n";
+ $cli_stdin_w->close();
+ $cli_stdout_r->close();
+ print '#'."[CLIENT] read it all.\n";
is($ret[$_], uc($text[$_])) for 0..$#text;
exit;
+} elsif (not defined $client_pid) {
+ die 'Failed to fork client side.';
};
$cli_stdin_w->close;
$cli_stdout_r->close;
-# we sleep to give time for the server to start...
+print '#'."[MAIN] we sleep to give time for the server to start\n";
sleep 1;
+print '#'."[MAIN] setup the proxy\n";
# we now finally setup our proxy
my $sock = IO::Socket::UNIX->new( Peer => $socket_name ) or die $!;
$sock->autoflush(1);
@@ -88,15 +105,19 @@ my $bh = IO::BindHandles->new
]
);
+print '#'."[MAIN] proxy loop\n";
while ($bh->bound()) {
+ print '#'."[MAIN] rwcycle\n";
$bh->rwcycle();
}
-
+print '#'."[MAIN] out of loop\n";
$cli_stdin_r->close();
$cli_stdout_w->close();
$sock->close();
+print '#'."[MAIN] waiting for processes\n";
waitpid $server_pid, 0;
waitpid $client_pid, 0;
+print '#'."[MAIN] exitting\n";
exit 0;

No commit comments for this range

Something went wrong with that request. Please try again.