Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Perl tk gui hangs when large data thrown to it

by ghosh123 (Monk)
on Oct 15, 2013 at 04:28 UTC ( #1058264=perlquestion: print w/replies, xml ) Need Help??
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 ?

Replies are listed 'Best First'.
Re: Perl tk gui hangs when large data thrown to it
by BrowserUk (Pope) on Oct 15, 2013 at 05:03 UTC
    I continuosly want to change some 1000 rows on the gui at every millisecond.

    You want to perform 1 million updates per second to your gui ...

    I can not put the entire code here, but i am putting some snippets of it to explain you better

    And you've omitted the code for what is likely the most critical routine in the program: updateDisplay($databuf);

    I need to know what is the possible reason for the gui to get hung and how can this be overcomed ?

    And you want us to guess where the problem originates and how to fix it?

    In all probability your first problem is that it is extremely doubtful that your system is capable of achieving a 1 million tcp packets/sec throughput.

    The next is (probably) that if you ran a tight loop in your gui, that randomly generated your row/color/state messages and directly modified your gui accordingly, that it would only achieve a few thousands of updates per second at best.

    Both of the above are very easy tests for you to perform; and will likely convince you that your expectations are unrealistic.

    If you want help that is more than guesswork; you'll need to give us something that we can run.


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    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.
      can you give me any email address or the like so that I can send you some files otherwise the code is too huge to include here.
        the code is too huge to include here.

        Simplify it. That is, make a simplified version of it for testing. Just the single widget that displays your changing data, the timer routine that processes inbound packets and the updateDisplay() routine. This would be invaluable to you for testing the maximum throughput you can expect of Tk and your tcp code.


        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        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.
        NO!

        As others have recommended: Simplify; create an example which illustrates the problem with fewer than 20 lines; (and, p.s. - don't whine).

        It's an extremely rare problem in this class that can't be duplicated without more than a few lines of code; in any case, the exercise of creating a brief example may illuminate your problem for you.

        My 'oops': intended as first reply to request (at Re^2: Perl tk gui hangs when large data thrown to it) for an email address.

Re: Perl tk gui hangs when large data thrown to it
by kcott (Chancellor) on Oct 15, 2013 at 05:02 UTC

    G'day ghosh123,

    "I can not put the entire code here, but i am putting some snippets of it to explain you better :"

    Please post a minimal example which reproduces your problem. Creating such an example will often highlight the problem and possibly even present a solution.

    Putting bits of code here doesn't really help. For instance, I could say that "[ \&checkData, $self, $server, $readable_handles ]" is problematic because "sub checkData { ... }" doesn't accept any arguments. I have no way of knowing whether that subroutine really doesn't accept any arguments or if that was just some of the code you chose to omit.

    "It also using Tk's repeat to continuously check whether any data has arrived to update the gui."

    Tk::fileevent is probably a more appropriate tool for this task.

    -- Ken

      I am just including a very very simplified code which is just one perl file only. Please change the repeat frequency to test it. The gui would show better performance if the repeat frequency is increased to 1sec , currently it is 1ms only.
      My requirement is :

      1. what is the reason for the gui to get hung when we are trying to change some 100 rows on it every 1 ms . Can not perl tk handle this ? is this a limitation ?

      2. is their any other mechanism to make it work, provided i will repeat it every 1 ms and would try to change 100 rows of it randomly.

      use Tk; use Tk::HList; use Time::HiRes qw/usleep/; my $mw = MainWindow->new(); my $hlistframe = $mw->Frame()->pack( -fill => 'both', -expand => 1 ); my $font = "{helvetica} -12 bold"; my $hl = $hlistframe->Scrolled( 'HList', -scrollbars => 'ose', -columns => 7, -header => 1, #-height => 10, -width => 50, -command => sub { print "test\n"; }, )->pack( -fill => 'both', -expand => 1 ); my $num = $hl->Label( -text => "Number", -anchor => 'w', -font => $fon +t ); $hl->headerCreate( 0, -itemtype => 'window', -widget => $num ); my $name = $hl->Label( -text => "ID", -anchor => 'w', -font => $font ) +; $hl->headerCreate( 1, -itemtype => 'window', -widget => $name ); my $DOB = $hl->Label( -text => "Job", -anchor => 'w', -font => $font ) +; $hl->headerCreate( 2, -itemtype => 'window', -widget => $DOB ); my $Address = $hl->Label( -text => "status", -anchor => 'w', -font => +$font ); $hl->headerCreate( 3, -itemtype => 'window', -widget => $Address ); my $style1 = $hl->ItemStyle( 'text', -selectforeground => 'black', -anchor => 'nw', -background => 'green', -font => $font ); my $style2 = $hl->ItemStyle( 'text', -selectforeground => 'black', -anchor => 'nw', -background => 'red', -font => $font ); my $style3 = $hl->ItemStyle( 'text', -selectforeground => 'black', -anchor => 'nw', -background => 'blue', -font => $font ); sub populate { my $path = 0; foreach my $entry ( 1 .. 100 ) { insertData( $path, $entry ); $path++; } } &populate(); sub insertData { my ( $path, $entry ) = @_; $hl->add($path); # print "path $path \n"; $hl->itemCreate( $path, 0, -text => "$path" ); # , -style => $ +style1); $hl->itemCreate( $path, 1, -text => "someid" ); # , -style => $ +style1); $hl->itemCreate( $path, 2, -text => "test" ); #, -style => $s +tyle1); $hl->itemCreate( $path, 3, -text => "running", -style => $style1 ) +; } $mw->repeat( 1, \&changeItem ); my $flag; sub changeItem { my %flag; foreach ( 1 .. 100 ) { my $randRow = int( rand(20) ); print "randRow $randRow \n"; if ( $flag{$randRow} ) { $hl->itemConfigure( $randRow, 3, -text => "pending", -style => $style2 ); $hl->itemConfigure( $randRow, 3, -text => "waiting", -style => $style2 ); $flag{$randRow} = 0; print "if flag ", $flag{$randRow}, "\n"; } else { print "else flag 0\n"; $hl->itemConfigure( $randRow, 3, -text => "finished", -style => $style3 ); $hl->itemConfigure( $randRow, 3, -text => "aborted", -style => $style3 ); $flag{$randRow} = 1; print "else flag ", $flag{$randRow}, " \n"; } #usleep(100); #sleep 2 ; } } MainLoop;
      is there any place where i can put some sample code. even the sample code require 5-6 module files to be included for the gui, server and client.

        No, not a minimal example of your full application; just a minimal code example to reproduce your problem. As I already stated, this exercise will often highlight the problem and possibly present a solution.

        I see you've made more than one reply to a single response (in at least two places). Furthermore, more than one of those replies are either very close or exact duplicates. "How do I change/delete my post?" explains how to include additional information in a post you've already made. Repeatedly posting the same (long) nodes will only annoy people; it's unlikely to get you better answers. "What shortcuts can I use for linking to other information?" shows, among other things, how to link to information you've already provided in another node.

        -- Ken

Re: Perl tk gui hangs when large data thrown to it
by Anonymous Monk on Oct 15, 2013 at 04:42 UTC
    #forks a client process system("perl client.pl");

    "forks a client process" and waits for it to finish, system

Re: Perl tk gui hangs when large data thrown to it
by Anonymous Monk on Oct 15, 2013 at 13:15 UTC
    The bottom-line is very simple: you are asking for something that is both technically impossible, and visually useless. A gui-display update should be periodic, driven by some kind of a timer. Once every 5 seconds, perhaps. Maybe once a second. You do not update the display "every time the data changes." Instead, you update the display to reflect changes made to any currently-visible widgets since the last update cycle. You're going to have to redesign this part of the code. There is no other option.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1058264]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (4)
As of 2018-11-21 02:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My code is most likely broken because:
















    Results (236 votes). Check out past polls.

    Notices?