http://qs321.pair.com?node_id=1058264

ghosh123 has asked for the wisdom of the Perl Monks concerning the following question:

I have a Tk gui of Scrolled HList widget. It has three columns ID, Job, Status. Under that some 1000 rows are created. The third column (status) is having some coloured text on it by ItemStyle widget.
The flow is like
1. a perl script (launch.pl) first instantiate the Gui class and build the gui objects. The Gui class is basically having some methods to create the column header of the gui,the scrolled HList frame on the gui and the 1k rows on it.

2. launch.pl also starts a server which listens to some port to accept data from the client. It is using IO::Socket::INET to create the server socket. It also using Tk's repeat to continuously check whether any data has arrived to update the gui.
3. The launch.pl also forks a client process which is sending continuous messages to the server. These messages are just some row no. , text amnd colour informations randomly generated after a particular time delay.
4. The server receives this info and send it to the Gui updateDisplay() method and the updateDisplay() changes the gui values accordingly.
My requirement is, I continuosly want to change some 1000 rows on the gui at every millisecond. I am controlling this rate of changing the gui rows from the client process. Putting sleep or usleep (Time::HiRes) I am making the rate of sending packets of info to the server faster and slower. But faster rate of changing the gui is resulting in hanging the gui and not very easy to manage.
My question is, is not perl tk able to handle when loads of the extent i explained above being put to it ? where is the bottleneck ?
I can not put the entire code here, but i am putting some snippets of it to explain you better :

# launch.pl #
$gui = Gui->new ; $gui->buildGui(); $server = Server->new; $server->startServer() ; #forks a client process system("perl client.pl");
# Server.pm #
sub new { my $class = shift; my %args = @_; my $self = { guiObj => $args{guiObj}, }; $self->{buffer} = "" unless defined $self->{buffer}; bless $self, $class; return $self; } sub startServer { my $self = shift; my $guiobj = $self->{guiObj}; my $server = IO::Socket::INET->new( Proto => 'tcp', LocalPort => 55555, Listen => SOMAXCONN, Reuse => 1 ) or die "Server can't start: $!"; my $readable_handles = new IO::Select(); $readable_handles->add($server); $guiobj->{parentWnd}->after( 10000, [ \&dump_count, $self ] ); $guiobj->{parentWnd} ->repeat( 1, [ \&checkData, $self, $server, $readable_handles ] +); } sub checkData { # this function checking the socket and whenever it is #readable, read +s the data into $self->{buffer} and calls #the updateDisplay() of the Gui.pm with that read data if ( $sock->sysread( $buf, 16 * 1024 ) ) { $self->{buffer} .= $buf; my $databuf = $self->{buffer}; $self->{guiObj}->updateDisplay($databuf) } sub dumpCount { # dumps the data sent to the gui after every 10ms in a file #which sto +res it in a hash structure where hash keys are #timestamps }
## Client.pl #
$cl = ClinetModule->new(); $cl->startClient()
# ClientModule.pm #
sub new { my $class = shift; my $self = { }; bless $self, $class; return $self; } sub startClient { my $self = shift; my $client = IO::Socket::INET->new( Proto => 'tcp', PeerAddr => 'localhost', PeerPort => 55555 ) or die "Client can't connect: $!"; $self->{client} = $client; $client->blocking(0); $client->autoflush(1); while (1) { my @color = qw(red green yellow magenta skyblue ); my @status = qw(pending queued running finished stopped); foreach ( 1 .. 1000 ) { my $randRow = int( rand($range) ) + 1; my $color = $color[ rand(@color) ]; my $state = $status[ rand(@status) ]; my $data = $randRow . " " . $state . " " . $color . " "; my $bytes = $self->{client}->syswrite($data); + } usleep(100000); # hangs # usleep(500000); #better #sleep 1; #works fine } }
Please notice the usleep and sleep at the end of the client module how am I controlling the rate of changing the gui objects. I need to know what is the possible reason for the gui to get hung and how can this be overcomed ?