Listing 2. simple_recv.pl: An IP Telephone in 74 Lines of PERL
The Perl Journal, Fall 2000
 

Accept incoming connections.

 0    #!/usr/bin/perl

 1    use strict;
 2    use IO::Socket;
 3    use IO::File;

 4    use constant DSP     => '/dev/dsp';
 5    use constant BUFSIZE => 4000;
 6    $SIG{CHLD} = sub { wait };

 7    my $port = shift || 2007;
 8    my $listen = IO::Socket::INET->new(LocalPort => $port,
 9                                       Listen => 5,
 10                                       Reuse => 1) 
                     || die "Can't listen: $!";


 11   while (1) {
 12       warn "waiting for a connection...\n";
 13       my $sock = $listen->accept;
 14       warn "accepting connection from ", $sock->peerhost, "\n";
 15       unless (my $dsp = IO::File->new(DSP, "r+")) {
 17           close $sock;
 18       } else {
 19           handle_connection($sock, $dsp);
 20       }
 21   }

 22   sub handle_connection {
 23       my ($sock, $dsp) = @_;
 24       my $child = fork();
 25       die "Can't fork: $!" unless defined $child;
 26       my $data;
 27       if ($child) { # parent process
 28           eval {
 29             local $SIG{INT} = sub {die};
 30             print $dsp $data while sysread($sock, $data, BUFSIZE);
 31           };
 32           close $sock;
 33           kill TERM => $child;
 34       } else {
 35           close $listen;
 36           print $sock $data while sysread($dsp, $data, BUFSIZE);
 37           exit;
 38       }
 39   }