El siguiente ejemplo esta tomado de la distribución de Net::Server .
casiano@mserver:~/src/perl/netserver$ cat -n ./connection_test.pl 1 #!/usr/bin/perl -w 2 3 package MyPack; 4 5 use strict; 6 use vars qw(@ISA); 7 use Net::Server (); 8 use IO::Socket (); 9 use IO::Prompt; 10 use File::Temp qw(tmpnam); 11 use Socket qw(SOCK_DGRAM SOCK_STREAM); 12 13 sub post_bind_hook { 14 my $self = shift; 15 foreach my $sock ( @{ $self->{server}->{sock} } ){ 16 $self->log(2,$sock->show); 17 } 18 } 19 20 sub process_request { 21 my $self = shift; 22 eval { 23 24 local $SIG{'ALRM'} = sub { die "Timed Out!\n" }; 25 my $timeout = 30; # give the user 30 seconds to type some lines 26 27 my $previous_alarm = alarm($timeout); 28 while (<STDIN>) { 29 s/\r?\n$//; 30 print "You said '$_'\r\n"; 31 alarm($timeout); 32 } 33 alarm($previous_alarm); 34 35 }; 36 37 if ($@ =~ /timed out/i) { 38 print STDOUT "Timed Out.\r\n"; 39 return; 40 } 41 } 42 43 my $socket_file = tmpnam(); 44 $socket_file =~ s|/[^/]+$|/mysocket.file|; 45 my $socket_file2 = $socket_file ."2"; 46 my $udp_port = 1024; 47 my $tcp_port = 1024; 48 my $host = 'mserver'; 49 50 print "\$Net::Server::VERSION = $Net::Server::VERSION\n"; 51 @ISA = qw(Net::Server); 52 53 if( @ARGV ){ 54 if( uc($ARGV[0]) eq 'UDP' ){ 55 my $sock = IO::Socket::INET->new(PeerAddr => $host, 56 PeerPort => $udp_port, 57 Proto => 'udp', 58 ) || die "Can't connect [$!]"; 59 ### send a packet, get a packet 60 $sock->send("Are you there?",0); 61 my $data = undef; 62 $sock->recv($data,4096,0); 63 print $data,"\n"; 64 exit; 65 } 66 67 if( uc($ARGV[0]) eq 'TCP' ){ 68 my $sock = IO::Socket::INET->new(PeerAddr => $host, 69 PeerPort => $tcp_port, 70 Proto => 'tcp', 71 ) || die "Can't connect [$!]"; 72 my $phrase = prompt "Write your phrase: "; 73 print $sock "$phrase\n"; 74 my $line = $sock->getline(); 75 print $line; 76 exit; 77 } 78 79 if( uc($ARGV[0]) eq 'UNIX' ){ 80 my $sock = IO::Socket::UNIX->new(Peer => $socket_file) || die "Can't connect [$!]"; 81 82 my $phrase = prompt "Write your phrase: "; 83 my $line = $sock->getline(); 84 print $line; 85 exit; 86 } 87 88 if( uc($ARGV[0]) eq 'UNIX_DGRAM' ){ 89 my $sock = IO::Socket::UNIX->new(Peer => $socket_file2, 90 Type => SOCK_DGRAM, 91 ) || die "Can't connect [$!]"; 92 93 ### send a packet, get a packet 94 $sock->send("Are you there?",0); 95 ### The server receives the data just fine 96 ### however, the default arguments don't seem to work for 97 ### sending it back. If anybody knows why, let me know. 98 my $data = undef; 99 $sock->recv($data,4096,0); 100 print $data,"\n"; 101 exit; 102 } 103 104 print "USAGE: $0 UDP|TCP|UNIX|UNIX_DGRAM 105 (If no arguments are passed, the server will start. 106 You should start the server in one window, and connect 107 in another window). 108 "; 109 exit; 110 } 111 112 ### set up servers doing 113 ## SOCK_DGRAM on INET (udp) 114 ## SOCK_STREAM on INET (tcp) 115 ## SOCK_DGRAM on UNIX 116 ## SOCK_STREAM on UNIX 117 118 MyPack->run(port => "$udp_port|udp", 119 port => "$tcp_port|tcp", 120 port => "$socket_file|unix", # default is SOCK_STREAM 121 port => join("|",$socket_file2,SOCK_DGRAM,"unix"), 122 log_level => 4, 123 );
casiano@mserver:~/src/perl/netserver$ ./connection_test.pl $Net::Server::VERSION = 0.96 2007/04/04-12:23:20 MyPack (type Net::Server) starting! pid(12312) Binding to UDP port 1024 on host * Binding to TCP port 1024 on host * Binding to UNIX socket file /tmp/mysocket.file using SOCK_STREAM Binding to UNIX socket file /tmp/mysocket.file2 using SOCK_DGRAM Ref = "Net::Server::Proto::UDP" NS_proto = "UDP" NS_port = "1024" NS_host = "*" Ref = "Net::Server::Proto::TCP" NS_proto = "TCP" NS_port = "1024" NS_host = "*" Ref = "Net::Server::Proto::UNIX" NS_proto = "UNIX" NS_unix_path = "/tmp/mysocket.file" NS_unix_type = SOCK_STREAM Ref = "Net::Server::Proto::UNIX" NS_proto = "UNIX" NS_unix_path = "/tmp/mysocket.file2" NS_unix_type = SOCK_DGRAM Group Not Defined. Defaulting to EGID '1001 1001' User Not Defined. Defaulting to EUID '1001' 2007/04/04-12:23:27 CONNECT TCP Peer: "189.132.105.252:42405" Local: "189.132.102.240:1024"
mcliente:/tmp> ./connection_test.pl TCP $Net::Server::VERSION = 0.96 Write your phrase: Hola mserver, mcliente te saluda! You said 'Hola mserver, mcliente te saluda!'
pp2@nereida:~/src/perl/NET_SERVER$ ./connection_test.pl UDP $Net::Server::VERSION = 0.97 Testing UDP You said "Are you there?"
pp2@nereida:~/src/perl/NET_SERVER$ ./connection_test.pl UNIX $Net::Server::VERSION = 0.97 Testing UNIX (File socket with SOCK_STREAM) Welcome to "MyPack" (29808)