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);

sub broadcast {
    my $text = shift;
    foreach my $user(keys %chatters) {
        my $chatter = $chatters{$user}->{client};
        if($chatter ne $client) {
            print $chatter "$text\n";
        }
    }
}

#!perl -w
require 5.002;
use strict;
use IO::Socket;
use IO::Select;

my $port = scalar(@ARGV) > 0 ? $ARGV[0] : 2323;

$| = 1;
my $listen = IO::Socket::INET->new(Proto => 'tcp',
				   LocalPort => $port,
				   Listen => 1,
				   Reuse => 1) 
    or die $!;

warn "started on $port\n";
my $select = IO::Select->new($listen);
my @chatters;

# comment out this line on win32
$SIG{'PIPE'} = 'IGNORE';

while(my @ready = $select->can_read) {
#    print "going: ".join(', ',map {$_->fileno} @ready) . "\n";
    for my $socket (@ready) {
	print "$socket ready\n";
	if($socket == $listen) {
	    my $new_socket = $listen->accept;
	    Chatter->new($new_socket, $select, \@chatters);
	} # if
	else {
	    my $chatter = $chatters[$socket->fileno];
	    if(defined $chatter) {
		&{$chatter->nextsub}();
	    } 
	    else {
		print "unknown chatter\n";
	    }
	} # else
    } # for
} # while
# ************************************************************
package Chatter;
use strict;

# create new chatter
sub new {
    my($class, $socket, $select, $chatters) = @_;
    
    my $self = {
	'socket' => $socket,
	'select' => $select,
	'chatters' => $chatters
	};
    bless $self,$class;
    
    $chatters->[$socket->fileno] = $self;
    $self->select->add($socket);
    
    $self->log("connected");
    $self->ask_for_handle;

    return $self;
} # new
# ------------------------------------------------------------
sub socket { $_[0]->{'socket'} }
sub select { $_[0]->{'select'} }
sub chatters { $_[0]->{'chatters'} }
sub handle { $_[0]->{'handle'} }
sub nextsub { $_[0]->{'nextsub'} }
# ------------------------------------------------------------
sub ask_for_handle {
    my($self) = @_;
    
    my $welcome = <<END;

Welcome to my chat server.

IMPORTANT DIRECTIONS FOR TELNET USERS:

This server doesn\'t speak telnet correctly, so not all telnet clients 
will work. If each character you type appears on a separate line, log out 
and try a different client. I\'ve tried these clients and they are ok:
  - "telnet" on Solaris, Linux, IRIX
  - CRT on Windows 95/NT
Microsoft Telnet and Tera Term Pro don\'t work.

To quit, type "/exit" or close your telnet window.  Or if you\'re running 
telnet from the Unix command line, hit Control-] and then type "close" at
the prompt.

You can get help with "/help"

END
    ;
    $welcome =~ s:\n:\r\n:g;
    $self->write($welcome);

    $self->write("choose a handle> ");

    $self->{'nextsub'} = sub { $self->get_handle };
} # ask_for_handle
# ------------------------------------------------------------
sub get_handle {
    my($self) = @_;

    # if no nick entered, don't block but return
    my $handle = $self->read or return;
    $handle =~ tr/ -~//cd;

    # check if handle is still available
    my $handleFree = 1;
    for my $socket ($self->select->handles){
	my $chatter = $self->chatters->[$socket->fileno];
	if (lc($handle) eq lc($chatter->{handle})){
	    $handleFree = 0;
	} # if
    } # for
    
    # selected handle is available
    if ($handleFree){
	$self->{'handle'} = $handle;
	$self->broadcast("*** $handle has connected");
	$self->log("handle: $handle");
	$self->{'nextsub'} = sub { $self->chat };
    } # if

    # selected handle is not available any more
    else {
	$self->write("ERROR: handle $handle is already in use");
	$self->write("choose a handle> ");
	$self->{'nextsub'} = sub { $self->get_handle };
    } # else

} # get_handle
# ------------------------------------------------------------
sub read {
    my($self) = @_;

    my $buf="";
    $self->socket->recv($buf,80);
    $self->leave if($buf eq "");

    return $buf;
} # read
# ------------------------------------------------------------
sub write {
    my($self,$buf) = @_;

    $self->socket->send($buf."\r\n") or $self->leave;
} # write
# ------------------------------------------------------------
sub log {
    my($self,$msg) = @_;
    my ($logfile) = "chat.log";
    my $fileno = $self->socket->fileno;

#    print "$fileno: $msg\n";
    open (LOG, ">>$logfile") or die ("ERROR: could not open LOG $logfile\n");
    print (LOG "$fileno: ".($self->{handle} || "").": $msg\n");
    close(LOG);

} # log
# ------------------------------------------------------------
sub broadcast {
    my($self,$msg) = @_;

    for my $socket ($self->select->handles) {
	my $chatter = $self->chatters->[$socket->fileno];
	$chatter->write("$msg") if(defined $chatter);
    } # for

} # broadcast
# ------------------------------------------------------------
sub chat {
    my($self) = @_;

    my $line = $self->read;
    return if ($line eq "");
    return if ($line eq "\r\n");
    $line =~ tr/ -~//cd;
    $self->ParseLine($line);

} # chat
# ------------------------------------------------------------
sub ParseLine {
    my ($self, $line) = @_;

    my $handle = $self->handle;
    my ($cmd, @args) = split(/ +/, $line);
    $cmd = lc($cmd);
    if ($cmd =~ /^\#/){
	my (@args) = ($cmd, @args);	$self->msg (\@args);
	return;
    } # if
    
    if ($cmd !~ s|^/||){
	$self->write("** Unknown command. Type /help for help");
#	$self->broadcast("$self->{handle}> $line");
	return;
    } # if
    if ($cmd eq "help"){
	$self->printHelp(\@args);
    }
    elsif ($cmd eq "nick"){
	$self->changeNick($self->handle, $args[0] || $self->handle);
    } # if
    elsif (($cmd eq "me") || ($cmd eq "act")){
	$self->act($self->handle, join (" ", @args)); 
    } # elsif
    elsif ($cmd eq "who"){
	$self->who( join (" ", @args));
    } # elsif
    elsif ($cmd eq "msg"){
	$self->msg(\@args);
    } # elsif
    elsif ($cmd eq "exit"){
	$self->leave;
    } # elsif
    elsif ($cmd eq "join"){
	$self->joinChannel($args[0]);
    } # elsif
    elsif ($cmd eq "part"){
	$self->leaveChannel($args[0]);
    } # elsif
    elsif ($cmd eq "list"){
	$self->listChannels;
    } # elsif

    else {
	$self->write("ERROR: unknown command: /$cmd");
    } # else

} # ParseLine
# ------------------------------------------------------------
sub printHelp {
    my ($self, $argsRef) = @_;
    
    my ($helpLine) = <<"EOH";
Available commands:
- /help                   displays this help

- /exit                   leaves the chat
- /join \#channel          joins channel with name \#channel
- /list                   list all existing channels
- /me message             ->*** nickname message
- /msg nick message       private message to nick
- /msg \#channel message   sends a message to all people on a channel
- /nick newnick           changes your handle: /nick newnick
- /part \#channel          leaves channel with name \#channel
- /who                    lists all users in chat
- /who \#channel           lists all users on channel \#channel
EOH
    ;
    $helpLine =~ s:\n:\r\n:g;
    $self->write($helpLine);
    
} # printHelp
# ------------------------------------------------------------
sub act {
    my ($self, $handle, $line) = @_;

    unless ($line){
	$self->write("** Usage: /me message");
	return;
    } # unless
    $self->log("act");
    $self->broadcast("*** $handle $line");
} # act
# ------------------------------------------------------------
sub changeNick {
    my ($self, $nick, $newNick) = @_;
    
    # if no nick specified
    unless ($newNick){
	$self->write("** Usage: /nick newnick");
	return;
    } # unless
    
    # check if handle is available
    my $handleIsFree = 1;
    for my $socket ($self->select->handles){
	my $chatter = $self->chatters->[$socket->fileno];
	if (lc($newNick) eq lc($chatter->{handle})){
	    $handleIsFree = 0;
	} # if
    } # for
    
    # if yes
    if ($handleIsFree){
	$self->{'handle'} = $newNick;
	$self->broadcast("** $nick is now known as $newNick");
	$self->log("/nick $nick $newNick");
    } # if
    
    # if not
    else {
	$self->write("** ERROR: $newNick already in use");
    } # else
} # changeNick
# ------------------------------------------------------------
sub joinChannel {
    my ($self, $channel) = @_;
    
    if ((! defined($channel)) || ($channel !~ /^\#/)){
        $self->write("** Usage: /join \#channelname");
	return;
    } # if
    
    my (@users) = ();
    if (defined $main::channels{$channel}){
	(@users) = @{ $main::channels{$channel} };
    } # if

    if (grep(/^$self->{handle}$/, @users)){
	$self->write("** You are already on channel $channel");
	return;
    } # if
    push (@users, $self->{handle});
    $main::channels{$channel} = \@users;
    $self->who($channel);
    
} # joinChannel
# ------------------------------------------------------------
sub leave {
    my($self) = @_;
    
    print "leave called\n";
    my $handle = $self->handle;

    # leave all channels
    foreach (keys %main::channels){
	$self->leaveChannel($_);
    } # foreach

    $self->chatters->[$self->socket->fileno] = undef;
    $self->select->remove($self->socket);
    $self->broadcast("[$handle left]") if(defined $handle);
    $self->log("disconnected");
    $self->socket->close;
} # leave
# ------------------------------------------------------------
sub leaveChannel {
    my ($self, $channel) = @_;

    return unless $channel;
    my @users = @{ $main::channels{$channel} };
    if (grep (s/^$self->{handle}$//i, @users)){
	@users = sort(@users);
	shift(@users) if $users[0] eq "";
	$main::channels{$channel} = \@users;
	$self->broadcast("*** $self->{handle} has left channel $channel");
    } # if    
} # leaveChannel
# ------------------------------------------------------------
sub listChannels {
    my ($self) = @_;

    $self->write(join(" ", keys %main::channels));

} # listchannels
# ------------------------------------------------------------
sub msg {
    my ($self, $wordsRef) = @_;
    my ($target, @words) = @$wordsRef;
    my $err = 1;
    my $targetChatter;

    unless ($target && $words[0]){
	$self->write("** Usage: /msg nick message");
	return;
    } # unless
    $self->log("msg");

    # message to a channel
    if ($target =~ /^\#/){
	unless (defined $main::channels{$target}){
	    $self->write("** ERROR: no such channel");
	    return;
	} # unless    
	my @users = @{ $main::channels{$target} };
	foreach (@users){
	    for my $socket ($self->select->handles){
		my $chatter = $self->chatters->[$socket->fileno];
		if (lc($chatter->{handle}) eq lc($_)){
		    $chatter->write("$target/$self->{handle}> ".join(" ", @words));
		} # if
	    } # for	
	} # foreach
    } # if

    # private message
    else {
	for my $socket ($self->select->handles){
	    my $chatter = $self->chatters->[$socket->fileno];
	    if (lc($target) eq lc($chatter->{handle})){
		$err = 0;
		$targetChatter = $chatter;
	    } # if
	} # for
	
	if ($err){
	    $self->write("*** no such nick: $target");
	} # if
	else {
	    $self->log("msg from $self->{handle} to $targetChatter->{handle}: ".join(" ", @words));
	    $targetChatter->write("Msg/$self->{handle}: ".join(" ", @words));
	} # else
    } # else
} # msg
# ------------------------------------------------------------
sub who {
    my ($self, $channel) = @_;
    $self->log("who");

    # if no channel given
    unless ($channel){
	for my $socket ($self->select->handles){
	    my $chatter = $self->chatters->[$socket->fileno];
	    $self->write($chatter->{handle}) if defined $chatter->{handle};
	} # for
	return;
    } # for

    # if invalid channel given
    if ($channel !~ /^\#/){
	$self->write("** Usage: /who  or /who \#channelname");
	return;
    } # if

    # if non-existing channel given
    unless (defined $main::channels{$channel}){
	$self->write("** No such channel $channel found");
    } # unless

    # channel must be valid
    else {
	my @users = @{ $main::channels{$channel} };
	if (@users){
	    $self->write("Users on channel $channel:");
	    $self->write(join(" ", sort (@users)));
	} # if
    } # else
} # who
# ------------------------------------------------------------

if($action eq "messages")  {
print $client "Moin Du";
sleep(5); # Hier hält der ganze Server, aber es soll nur für den aktuellen Clienten blocken
}