Perl Socket 编程样例（2）

Unix Domain Socket客户端, Socket模块

简介：使用Unix domain socket的客户端。

#!/usr/bin/perl -w
use strict;
use Socket;
use IO::Handle;

my $path = $ARGV[0] || '/tmp/daytime.sock';

socket(my $sock, PF_UNIX, SOCK_STREAM, 0);
my $sun = sockaddr_un($path);
connect($sock, $sun) or die "Connect: $!\n";
$sock->autoflush(1);
my $buf = <$sock>;
my $bs = length($buf);
print "Received $bs bytes, content $buf\n";
close $sock;

Unix Domain Socket 服务端, Socket模块

简介：使用Unix domain socket实现的daytime服务器。

#!/usr/bin/perl -w
# tcp_socket_dt_srv.pl
use strict;
use Socket;
use IO::Handle;
use POSIX qw(WNOHANG);

my $path     = $ARGV[0] || '/tmp/daytime.sock';

$SIG{'CHLD'} = sub {
      while((my $pid = waitpid(-1, WNOHANG)) >0) {
            print "Reaped child $pid\n";
        }
};

socket(SOCK, PF_UNIX, SOCK_STREAM, 0)
    or die "socket() failed: $!";
setsockopt(SOCK,SOL_SOCKET,SO_REUSEADDR,1)
    or die "Can't set SO_REUSADDR: $!" ;

unlink $path if -r $path;

bind(SOCK,sockaddr_un($path))    or die "bind() failed: $!";
listen(SOCK,SOMAXCONN)           or die "listen() failed: $!";

warn "Starting server on path $path...\n";

while (1) {
      next unless my $sockname = accept(SESSION,SOCK);
      defined (my $pid=fork) or die "Can't fork: $!\n";
 
      if($pid==0) {
          SESSION->autoflush(1);
          print SESSION (my $s = localtime);
          close SESSION;
          exit 0;
       }else {
          print "Forking child $pid\n";
       }
}

close SOCK;

转自

http://www.hzqbbc.com/blog/arch/2005/06/perl_socket_cca_1.html