Véase IO::Multiplex
pp2@nereida:~/src/perl/testing$ cat -n iomultiplextelnet.pl 1 use IO::Socket; 2 use IO::Multiplex; 3 4 # Create a multiplex object 5 my $mux = new IO::Multiplex; 6 # Connect to the host/port specified on the command line, 7 # or localhost:23 8 my $sock = new IO::Socket::INET(Proto => 'tcp', 9 PeerAddr => shift || 'localhost', 10 PeerPort => shift || 23) 11 or die "socket: $@"; 12 13 # add the relevant file handles to the mux 14 $mux->add($sock); 15 $mux->add(\*STDIN); 16 # We want to buffer output to the terminal. This prevents the program 17 # from blocking if the user hits CTRL-S for example. 18 $mux->add(\*STDOUT); 19 20 # We're not object oriented, so just request callbacks to the 21 # current package 22 $mux->set_callback_object(__PACKAGE__); 23 24 # Enter the main mux loop. 25 $mux->loop; 26 27 # mux_input is called when input is available on one of 28 # the descriptors. 29 sub mux_input { 30 my $package = shift; 31 my $mux = shift; 32 my $fh = shift; 33 my $input = shift; 34 35 # Figure out whence the input came, and send it on to the 36 # other place. 37 if ($fh == $sock) { 38 print STDOUT $$input; 39 } else { 40 print $sock $$input; 41 } 42 # Remove the input from the input buffer. 43 $$input = ''; 44 } 45 46 # This gets called if the other end closes the connection. 47 sub mux_close { 48 print STDERR "Connection Closed\n"; 49 exit; 50 }
pp2@nereida:~/src/perl/testing$ cat -n iomultiplexserver.pl 1 use IO::Socket; 2 use IO::Multiplex; 3 4 my $mux = new IO::Multiplex; 5 6 # Create a listening socket 7 my $sock = new IO::Socket::INET(Proto => 'tcp', 8 LocalPort => shift || 2300, 9 Listen => 4) 10 or die "socket: $@"; 11 12 # We use the listen method instead of the add method. 13 $mux->listen($sock); 14 15 $mux->set_callback_object(__PACKAGE__); 16 $mux->loop; 17 18 sub mux_input { 19 my $package = shift; 20 my $mux = shift; 21 my $fh = shift; 22 my $input = shift; 23 24 # The handles method returns a list of references to handles which 25 # we have registered, except for listen sockets. 26 foreach $c ($mux->handles) { 27 print $c $$input; 28 } 29 $$input = ''; 30 }