my %socket;   # für die Registrierung der Socketverbindungen # Socketschleife my $exit_flag; until($exit_flag) { # warten, auf Verbindung oder Daten (Timeout, daß nichtblockierend)   if (my @ready = $select->can_read(1))   { # für alle Sockets, die bereit sind loop:     foreach my $socket (@ready)     { # wenn Listener, dann neue Verbindung akzeptieren       if ($socket == $listen)       { my $new = $listen->accept;         # neuen Socket zum Select-Objekt hinzufügen         $select->add($new);         # Verbindungsinformationen einsammeln         my ($port, $ip) = sockaddr_in getpeername $new;         $ip = inet_ntoa $ip;         # Socket registrieren und Puffer für Verbindung bereitstellen         $socket{$new} =         { handle => $new,           ip => $ip,           port => $port,           inbuf => '',           outbuf => '',         };         print_dos qq~Client "$socket{$new}->{ip}" verbunden. ~;         # Dauerfehlerlog verhindern         unless (continue_socket $new)         { print_dos qq~Client "$socket{$new}->{ip}" durch Server abgewiesen. ~;           destroy_socket $new, nolog => 1;         }       }       elsif (exists $socket{$socket})       { # sonst Daten lesen         for (my $buf)         { $socket->recv($_, 512);           length $_ and continue_socket($socket) or do           { # nichts gelesen, Verbindung verloren             # oder             # Dauerfehlerlog verhindern             # Socket beenden, wenn neue Daten von ihm kommen und             # bei der letzten Transaktion ein Fehler aufgetreten ist             destroy_socket $socket, nolog => 1, by_client => 1;             next loop;           };           # gelesene Daten an Puffer hängen           $socket{$socket}->{inbuf} = "$socket{$socket}->{inbuf}$_";           # Daten anzeigen           print_dos "<<<@{[ctrl2hex $_]}<<< " if PRINT_DATA;         }         # Daten verarbeiten         data_proc $socket;       }     }   }   if (my @ready = $select->can_write(0))   { # für alle Sockets, die bereit sind loop:     foreach my $socket (@ready)     { # Socket ist bekannt und hat Daten zum Senden       if (exists $socket{$socket} and length $socket{$socket}->{outbuf})       { $socket->send($socket{$socket}->{outbuf}) or do         { # konnte nichts senden, Verbindung verloren           destroy_socket $socket, nolog => 1, by_client => 1;           next loop;         };         # Daten anzeigen         print_dos ">>>@{[ctrl2hex $socket{$socket}->{outbuf}]}>>> " if PRINT_DATA;         # gesendete Daten löschen         $socket{$socket}->{outbuf} = '';       }     }   } } if ($exit_flag) { # alle Verbindungen beenden   destroy_socket $socket{$_}->{handle}, nolog => 1 for keys %socket; } exit(0);