can I call a tk fileevent with a delay

[Anonymous Monk]

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;
    }

[kcott]

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.

[Anonymous Monk]

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.

[kcott]

"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.

[keszler]

Time::HiRes

usleep 100;