Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

svenXY's scratchpad

by svenXY (Deacon)
on Jul 08, 2005 at 12:57 UTC ( [id://473396]=scratchpad: print w/replies, xml ) Need Help??

the problem with the REAPER

(see TCP Client-Server: Server exits though it shouldn't)

as stated out in the OP, the REAPER throws the parent-process out of the while loop (or accept() is not true). This is a rewrite with onlys the required lines to show this problem. I get the feeling that this is a bug.

Server Code:
#!/usr/bin/perl -w use strict; use IO::Socket; use Sys::Hostname; use POSIX qw(:sys_wait_h); # choose either. ignore will work, REAPER won't $SIG{CHLD} = 'IGNORE'; # still loathe sysV $SIG{CHLD} = \&REAPER; # still loathe sysV my $sock = new IO::Socket::INET( LocalHost => '127.0.0.1', LocalPort => 9898, Proto => 'tcp', Listen => 10, ReuseAddr => 1 ); $sock or die "no socket :$!"; print STDERR "Parent $$: Server up\n"; while ( my $new_sock = $sock->accept() ) { $new_sock->autoflush(1); my($buf, $kid); if ($kid = fork) { print STDERR "Parent $$ after fork\n"; } else { die "fork: $!" unless defined $kid; # child now... print STDERR "Child $$: started\n"; # read from client $buf = <$new_sock>; chomp $buf; print "Child $$: Read from client: $buf\n"; # do something (sleep some random secs) my $secs = int(rand(srand())*10)+1; sleep $secs; print $new_sock "READY\n"; print "Child $$: Sent READY, closing\n"; exit 0; } } print STDERR "Parent $$: Should never get here\n"; ######################################################## sub REAPER { ######################################################## my $child; while (($child = waitpid(-1,WNOHANG)) > 0) { print "Parent $$: Reaped $child\n"; } $SIG{CHLD} = \&REAPER; # still loathe sysV }

Client code
#!/usr/bin/env perl use strict; use warnings; use IO::Socket; my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => '127.0.0.1', PeerPort => "9898", ); unless ($remote) { die "cannot connect" } $remote->autoflush(1); print $remote "client $$\n"; while ( <$remote> ) { print;last; } close $remote; print "Socket gone, exiting\n";
output (on the server side) is then:
Parent 28877: Server up Parent 28877 after forking Child 28949: started Child 28949: Read from client: client 28948 Child 28949: Sent READY, closing Parent 28877: Reaped 28949 Parent 28877: Should never get here
and the server is gone.
Any hints/ideas/whatever greatly appreciated!
Sorting an HTML table by the first column has been removed. /msg me if you are interested, but the suggested solutions (see HTML::TreeBuilder: sort a Definition List (<dl>)) are much better than my initial code.

Nodes with good snippets
Perl Special Variables Quick Reference
Re: Perl script to comment out lines in named.con file - going through lines with curly braces and know when the last one shows up
Re: Date and time for log files

Clear output line of arbitrary length in windows
use Win32::Console::ANSI; $|=1; print "\e[s"; # store 1st pos otherwise it will clear the whole screen for ( 'a'x300, 'b'x200, 'c'x100) { print "\e[u\e[0J"; # go to stored pos, del to end print "\e[s$_"; # store pos, print output sleep 3; }
oneliner to count pregnancy weeks (or weeks since birth) perl -MDateTime -e '$i=DateTime->new(year => 2007,month => 11,day => 1);print "Woche $_ ab ",$i->add(weeks => 1)->strftime(q{%d.%m.%y}), $/ for 1..40'

# module versions for i in `cat perlmodules`; do echo -n "$i ";perl -le 'eval "require $ARGV[0]" and print $ARGV[0]->VERSION' $i; done


brian's Guide to Solving Any Perl Problem
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (6)
As of 2024-03-28 14:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found