Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

can I call a tk fileevent with a delay

by Anonymous Monk
on Sep 12, 2013 at 15:34 UTC ( #1053748=perlquestion: print w/ replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks
How can I change a Tk main window fileevent to go for reading the incoming data every 100ms. Below is my code.
You may even give other small example as well to show this.

use Tk; open(CHILD, "./fileevent2piper 2>&1 |") or die "Can't open: $!"; my $mw = new MainWindow; my $t = $mw->Scrolled("Text",-width => 80, -height => 25, -wrap => 'no +ne'); $t->pack(-expand => 1); $mw->fileevent('CHILD', 'readable', [\&fill_text_widget, $mw]); MainLoop; sub fill_text_widget { my ($widget) = @_; if (eof(CHILD)) { $widget->fileevent('CHILD', "readable", undef); # cancel bindi +ng return ; } else { if (sysread ('CHILD', $_, 128)) { print "here $_ \n"; $t->insert('end', $_); # Append the data read $t->yview('end'); } else { $t->insert('end', times); $t->yview('end'); $widget->fileevent('CHILD', "readable", undef); # cancel b +inding return; } } }

The fileevent2piper code is

$|++; for my $i ( 0 .. 5) { print $i, "\n"; print `ls -la`; sleep 1; }

Comment on can I call a tk fileevent with a delay
Select or Download Code
Re: can I call a tk fileevent with a delay
by keszler (Priest) on Sep 12, 2013 at 15:56 UTC
Re: can I call a tk fileevent with a delay
by kcott (Abbot) on Sep 12, 2013 at 21:14 UTC

    I'd use Tk::after - it has millisecond granularity.

    While I appreciate that the code you posted may well be a highly simplified version of your real application, you may not need Tk::fileevent at all. See my example code where it wasn't needed.

    #!/usr/bin/env perl use strict; use warnings; use Tk; my $mw = MainWindow->new(); my $action_F = $mw->Frame()->pack(-side => 'bottom'); $action_F->Button(-text => 'Exit', -command => sub { exit })->pack; my $text_F = $mw->Frame()->pack(-fill => 'both', -expand => 1); my $ls_T = $text_F->Scrolled('Text', -scrollbars => 'osoe', -wrap => ' +none'); $ls_T->pack(-fill => 'both', -expand => 1); my $out_win = $ls_T; my $tid; my $cmd = 'ls -al 2>&1'; my $repeat = 6; my $delay = 100; $tid = $mw->repeat($delay => [\&update_ls, \$out_win, \$tid, \$cmd, \$ +repeat]); MainLoop; { my $updates = 0; sub update_ls { my ($text_ref, $tid_ref, $cmd_ref, $repeat_ref) = @_; $$text_ref->insert(end => scalar(localtime) . "\n" . qx{$$cmd_ +ref}); if (++$updates >= $$repeat_ref) { my $times_format = '(Usr: %d, Sys: %d, ChUsr: %d, ChSys: % +d)'; $$text_ref->insert(end => sprintf $times_format => times); $$tid_ref->cancel; } $$text_ref->yview('end'); return; } }

    Notes:

    • From Tk::after, I've used the repeat() method to set it up; and the cancel() method when the callback's been called 6 times. [Beyond mirroring the "for my $i ( 0 .. 5) ..." (in your posted code), the 6 is not special.]
    • Notice how all the callback arguments are references. This gives you a lot more flexibility: you could, for instance, change the delay, the command, or even the Tk::Text widget displaying the output.
    • The defaults for -width and -height are 80 and 24, respectively: I've left those two out. I've made the -scrollbars optional (osoe).
    • The code I've posted is complete, working and tested on a directory with 412 entries.

    -- Ken

      Hi Ken,
      Good day!
      The code that you've posted definitely helps me know how to get away with fileevent and handle the problem in a much better and nicer (flexible as everything is passed as reference).

      However, your assumption is right. My code is a much simplified version of my real application. In my application, it is like

      $mainWin->fileevent($socket, 'readable', sub {$self->dataAvailable()} +);
      Here $mainWin is the Tk::MainWindow widget and $socket is a IO::Socket::INET object. I am not sure how can I insert the delay here as it is so easily done by $mw->repeat.
        "I am not sure how can I insert the delay here as it is so easily done by $mw->repeat."

        Here's one way to do it:

        GUI Server (pm_tk_repeat_server.pl):

        #!/usr/bin/env perl use strict; use warnings; use Tk; use IO::Socket; my $mw = MainWindow->new; my $control_F = $mw->Frame()->pack(-side => 'bottom'); my $out_F = $mw->Frame()->pack(-side => 'top', -fill => 'both', -expan +d => 1); my $out_T = $out_F->Scrolled('Text', -scrollbars => 'osoe', -wrap => ' +none'); $out_T->pack(-fill => 'both', -expand => 1); my $out_win = $out_T; my $delay = 100; my ($client, $tid); my @button_pack_opts = (-side => 'left', -padx => 10); $control_F->Button(-text => 'Start Server', -command => [\&start_server, \$client] )->pack(@button_pack_opts); $control_F->Button(-text => 'Start Listening', -command => [\&start_listen, \$mw, \$client, \$tid, \$delay, \$out +_win] )->pack(@button_pack_opts); $control_F->Button(-text => 'Stop Listening', -command => [\&stop_listen, \$out_win, \$tid] )->pack(@button_pack_opts); $control_F->Button(-text => 'Quit', -command => sub { exit } )->pack(@button_pack_opts); MainLoop; sub start_server { my ($client_ref) = @_; my $server = IO::Socket::INET::->new( Proto => 'tcp', LocalPort => 55555, Listen => SOMAXCONN, Reuse => 1 ) or die "Server can't start: $!"; $$client_ref = $server->accept(); $$client_ref->autoflush; return; } sub start_listen { my ($mw_ref, $client_ref, $tid_ref, $delay_ref, $out_ref) = @_; $$tid_ref = $$mw_ref->repeat( $$delay_ref => [\&read_client, $mw_ref, $client_ref, $out_ref] + ); return; } sub stop_listen { my ($out_ref, $tid_ref) = @_; my $times_format = "(Usr: %d, Sys: %d, ChUsr: %d, ChSys: %d)\n"; $$out_ref->insert(end => sprintf $times_format => times); $$out_ref->yview('end'); $$tid_ref->cancel; return; } sub read_client { my ($mw_ref, $client_ref, $out_ref) = @_; $$mw_ref->fileevent($$client_ref, 'readable', sub { if (defined(my $read = readline *$$client_ref)) { $$out_ref->insert(end => $read); $$out_ref->yview('end'); } else { $$mw_ref->fileevent($$client_ref, 'readable', ''); } }); return; }

        Dummy Client (pm_tk_repeat_client.pl):

        #!/usr/bin/env perl use strict; use warnings; use IO::Socket; my $client = IO::Socket::INET::->new( Proto => 'tcp', PeerAddr => 'localhost', PeerPort => 55555 ) or die "Client can't connect: $!"; my $max_iterations = 3; my $sleep_time = 10; for (1 .. $max_iterations) { print $client qx{ls -al 2>&1}; sleep $sleep_time; }

        Notes:

        • Run the GUI Server code and click the Start Server button.
        • Run the Dummy Client code.
        • Go back to the GUI Server and click the Start Listening button: output should appear in the Tk::Text window.
        • You can stop the output with the Stop Listening button. (You can Start/Stop Listening as often as you want.) The repeat() and cancel() methods are in the callbacks for these two buttons.
        • The callback for the repeat event is read_client(). The file event handler is both created and deleted within this subroutine.
        • See perlipc if you have any questions about the Client/Server IO::Socket code: it mostly came from there pretty much unchanged.

        -- Ken

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1053748]
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (7)
As of 2015-07-07 06:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (87 votes), past polls