new attempt:

This is WHOLE code of my server.pl at now

## my server
## 2010.03.05

#!/usr/bin/perl -w

use strict;
use IO::Socket;
use threads;
use threads::shared;
##use POSIX 'WNOHANG'; # for SIGNAL
use constant BUFSIZE => 1024;


our %clients:shared;
my( $addr, $port );


$addr = &get_ip(); # get IP from interface

## get port
print "enter port: ";
while( <STDIN> ) {
        chomp($_);
        $port = $_;
        if ( /[0-9]{4,5}/ && $_ > 1024 ) { last; }
        print "either wrong value or port is deny, enter new value: ";
}

my $server = IO::Socket::INET -> new( LocalAddr => $addr,
                                        LocalPort => $port,
                                        Listen => 255,
                                        Type => SOCK_STREAM,
                                        Proto => 'tcp',
                                        Reuse => 1 );
die "can't create, bind or listen: $!\n" unless $server ;
print "socket OK\n bind OK\n listen OK\n Server started at $addr:$port
+\n";
warn "Server ready. Waiting for connections... \n";

threads -> create( \&to_client ) || die "$! \n"; # STDIN

## start threads to treat querys
while( my $client = $server -> accept ) {
        my $client_ip = $client -> peerhost();
        my $client_port = $client -> peerport();

        $clients{ "$client_ip:$client_port" } = fileno( $client ); # a
+dd new socket to %client

        print "got a connection from: $client_ip:$client_port $client\
+n";
        $client -> autoflush;

        threads -> create( \&from_client, $client, $client_ip, $client
+_port ) || die "$! \n"; #STDOUT

}
exit 0;


## ******************************************************
## get local machine IP from interface
sub get_ip {
        my ($name, $aliases, $addrtype, $length, @addrs) = gethostbyna
+me( 'localhost' );
        my ($name1, $aliases1, $addrtype1, $length1, @addrs1) = gethos
+tbyname( $name );
        my $addr1 = inet_ntoa( $addrs1[0] );
        return $addr1;
}

## ******************************************************
## send message to client or see list of client
sub to_client {
        my ( $clnt_ip_port, $msg_t, $tmp );

        while( sysread(STDIN, $tmp, BUFSIZE) ) {
                chomp $tmp;
                if( $tmp eq "list" ) {
                        print "connect to this server:\n";
                        foreach my $z ( keys %clients ) { print "clien
+t: $z  $clients{$z}\n"; }
                }
                elsif ( $tmp =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d
+{4,5}\s.*/ ) {
                        ( $clnt_ip_port, $msg_t ) = ( $tmp =~ /(\d{1,3
+}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{4,5})\s(.*)/ );
                        if ( exists $clients{$clnt_ip_port} ) {
                                ## try to send message
                                my $client;
                                my $fileno = $clients{$clnt_ip_port};
                                open $client, "+<$fileno" || die "$!\n
+";
##print "syswrite $clients{$clnt_ip_port} {$msg_t} \n";
                                syswrite( $client, $msg_t ) || die ": 
+$!\n";
                        } else { print "don't exist client or empty me
+ssage!\n"; }
                } else { print "wrong value, check and see \"list\" of
+ clients!\n"; }
        }
}


## ******************************************************
## recive message from client
sub from_client {
        my ( $sock, $clnt_ip, $clnt_port ) = @_;;
        my $msg_f;

        syswrite( STDOUT, "from $clnt_ip:$clnt_port: $msg_f" ) while s
+ysread( $sock, $msg_f, BUFSIZE );
        print "client at $clnt_ip:$clnt_port closed connection \n";
        delete $clients{"$clnt_ip:$clnt_port"}; # delete socket from %
+client

        $sock -> close;
}
[download]

OUTPUT of my server.pl:

enter port: 1234
socket OK
 bind OK
 listen OK
 Server started at 127.0.0.1:1234
Server ready. Waiting for connections... 
got a connection from: 127.0.0.1:37725 IO::Socket::INET=GLOB(0x8d1ea38
+)
list
connect to this server:
client: 127.0.0.1:37725  5
127.0.0.1:37725 qwerty
Thread 1 terminated abnormally: : Bad file descriptor
[download]

it is better ?? sorry for my illiteracy =) yeap, i have not any locking, cause it will... in future ))

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.