in reply to Re^2: threads with shared variables across multiple instances of a module
in thread threads with shared variables across multiple instances of a module

Yes, you can share individual elements of a hash (using share()): 

use strict; 
use warnings; 
use threads; 
use threads::shared; 

my %h; 
share $h{ fred };
$h{fred} = 2; 

async{ 
    my $a='bill'; 
    lock $h{fred}; 
    $h{fred}=$a;
}->join; 

print $h{fred};

bill

[download]
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
"I'd rather go naked than blow up my ass"

Replies are listed 'Best First'.
Re^4: threads with shared variables across multiple instances of a module
by zerg13new (Initiate) on Mar 26, 2010 at 07:40 UTC

    can i share the whole hash ?? a can't push in my shared hash pair like this:

    "192.168.0.1:3128" => $client

    $client is a local (defined with "my") variable (socket)

    part of my code:

    .....
use strict;
use Socket;
use threads;
use threads::shared;
.......
my %clients :shared;
......
my $server = IO::Socket::INET -> new(.....);
.....
while( my $client = $server -> accept ) {
.....
###############
in next 2 strings i'm wall!!! i don't know how push $socket (it's refe
+rence to NANDLE, isn't it?!) in shared hash %clients, and then get it
+ back like a handle!!
the best error i've had, was "Bad file descriptor"
################
$clients{ "$client_ip:$client_port" } = *client{IO}; # add new socket 
+to %client
syswrite( $$qwe{IO}, "hi, how are you??") || die ":$! _ $@";
.....
}

    [download]

    help me please, desparing

[reply]
[d/l]
[select]

      This  *client{IO}; is invalid syntax when $client is a lexical.

      It would have to be *{ $client }{IO}.

      But that still won't help you because of an (unnecessary) restriction that doesn't allow you to store globs, (or references to globs) into shared scalars.

      There are two ways to share globs (filehandles sockets etc.) between threads:

      1. Share the file number between threads and dup() the associated filehandle into existance in teh target thread(s): 
        my %clients :shared;
while( my $client = $server->accept;
    $clients{ client } = fileno( $client );
}
...
## within the threads
my $client;
my $fileno = $clients{ client };
open $client, "+<&$fileno" or die ... ## dup() the the glob from the f
+ileno
## use $client

        [download]
      2. Allow the thread access to the client handle via cloned closure: 
        while( my $client = $server->accept ) {
    async{
        while( my $in = <$client> ) {
            print $client $in; ### simple echo server
        }
    }->detach;
}

        [download]

      I've never understood this restriction. The fact that a glob can be successfully shared via the latter method suggests strongly that the restriction both artifical (they just decided to reject glob(ref) assignments to shared scalars--and the code supports this); and unnecessary.

      But those that should know the answer to why this restriction was established and persists, have chosen not to answer that question.

      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
Re^6: threads with shared variables across multiple instances of a module
by zerg13new (Initiate) on Mar 27, 2010 at 07:52 UTC

    perhaps i didn't understand, but i have the same error "Thread 1 terminated abnormally: : Bad file descriptor". can explain to me ?

          6 use strict;
      7 use IO::Socket;
      9 use threads;
     10 use threads::shared;
     12 use constant BUFSIZE => 1024;
.........
# create port, also "new" try bind, listen
     31 my $server = IO::Socket::INET -> new(
.............
     41 threads -> create( \&to_client ) || die "$! \n"; # STDIN, send
+ writed to client you point, like this "192.168.0.1:3128 my message",
+ also have "list" command
 # start threads to treat querys
     44 while( my $client = $server -> accept ) {
     45         my $client_ip = $client -> peerhost();
     46         my $client_port = $client -> peerport();
     47         my $tmp = "$client_ip:$client_port";
     48         ## ????? IN THIS PLACE I WANT TO PUSH SOCKET $client a
+s value in hash %clients with key "$client_ip:$client_port" ????
     49         %clients = ( %clients, "$client_ip:$client_port" => fi
+leno($client) ) ; # add new socket to %clients
     50 
     54         print "got a connection from: $client_ip:$client_port 
+$client\n";
     55         $client -> autoflush; # don't buffer
     56 
     57         threads -> create( \&from_client, $client, $client_ip,
+ $client_port ) || die "$! \n"; #STDOUT, get message from client
     58 
     59 }
     60 exit 0;

 # ******************************************************
     79 # send message to client, or get list of clients
     80 sub to_client {
     81         my ( $clnt_ip_port, $msg_t, $tmp );
     82 
     83         while( sysread(STDIN, $tmp, BUFSIZE) ) {
     84 #print "debug1 $tmp";
     85                 chomp $tmp; # very-very need, difficult to exp
+lain =)
     86                 if( $tmp eq "list" ) { # show list of clients
     87                         print "connect to this server:\n";
     88                         foreach my $z ( keys %clients ) { prin
+t "client: $z  $clients{$z}\n"; }
     89                 }
     90                 elsif ( $tmp =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d
+{1,3}:\d{4,5}\s.*/ ) { # find in STDIN blank
     91                         ( $clnt_ip_port, $msg_t ) = ( $tmp =~ 
+/(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{4,5})\s(.*)/ ); # split messa
+ge to addres like "192.168.0.1:3128" (it is key fo        r %clients)
+ and message
     92 #print "debug1 blank {$clnt_ip_port} {$msg_t}\n";
     93                         if ( exists $clients{$clnt_ip_port} ) 
+{ # if key exist in %clients then send
     94 #print "syswrite $clients{$clnt_ip_port} {$msg_t} \n";
        ????? IN THIS PLACE I WANT TO GET IT BACK ( SOCKET $client as 
+value from hash %clients with key "$client_ip:$client_port" ) ????
     95                                 my $client;
     96                                 my $fileno = $clients{$clnt_ip
+_port};
     97                                 open $client, "+<$fileno" || d
+ie "open: $!\n";
     98                                 syswrite( $client, $msg_t ) ||
+ die ": $! __ $@\n";
     99                                 close $client;
    100                         } else { print "don't exist client or 
+empty message!\n"; }
    101                 } else { print "wrong value, check and see \"l
+ist\" of clients!\n"; }
    102         }
    103 }


    106 # ******************************************************
    107 # STDOUT, get message from client
    108 sub from_client {
    109         my ( $sock, $clnt_ip, $clnt_port ) = @_;;
    110         my $msg_f;
    111 
    112         syswrite( STDOUT, "from $clnt_ip:$clnt_port: $msg_f" )
+ while sysread( $sock, $msg_f, BUFSIZE );
    113         print "client at $clnt_ip:$clnt_port closed connection
+ \n";
    114         delete $clients{"$clnt_ip:$clnt_port"}; # delete socke
+t from %client
    115 
    116         $sock -> close;
    117 }

    [download]
[reply]
[d/l]

      If you included the full error message (including the line number), I'd have a chance of knowing which thread terminated abnormally.

      If you included all the source code, I might stand a chance of trying it out for myself.

      If you posted the code without the line numbers, I wouldn't have to strip them off.

      And your code would be far easier (for you and me) to read and analyse if it was formatted consistently.

      As it is, the most obvious problem is that %clients isn't declared (or shared) anywhere.

      And BTW, this %clients = ( %clients, "$client_ip:$client_port" => fileno($client) ) ; is a really horrible way to add a new key/value pair to a hash. A simple: 

      $clients{ "$client_ip:$client_port" } = fileno($client);

      [download]

      is much easier to read and far more efficient.

      You've also failed to do any locking of your shared hash. (Assuming it is actually declared & shared somewhere in the code you've omitted!)

      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]

        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 "not exist client or empty mess
+age!\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 =)
[reply]
[d/l]
[select]

        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 ))
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom