http://qs1969.pair.com?node_id=476993

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

I scarfed the Tk code Im presenting here from Re: Tk perl much thanks to Jouke.

My question is though, how to make the nodes appear in realtime as they are processing instead of all at once when they are done. This particular code is being run on a w2k workstation, if that matters.

the code 
use strict;
use mship;
use Tk;

my $host;
$|++;

#First create a new mainwindow
my $mainwindow = new Tk::MainWindow();

#Then create a textwidget (called 'Scrolled', with subtype 'Text")
my $text = $mainwindow->Scrolled("Text", -scrollbars => 'se')->pack(-e
+xpand => 1, -fill => 'both');

for ( 0 .. 54 )
{ 
    get($_);
    last if ($_ == 53 )
}


# create a closebutton
my $button = $mainwindow->Button(-text => "close", -command => sub {$m
+ainwindow->destroy()})->pack();

# start the main loop!
MainLoop;
sub get
{
    my $node = shift;
    $host = sprintf ("%02d", $node) ;
    my %status = mship::connection("192.9.210.1$host", "13");
    my $stats=($status{status} == 0) ? "Up" : "Down";
    $text->insert('end', "$status{remote_name} is $stats\n");
}

[download]
the code for mship.pm is here 
use strict;
use warnings;

package mship;

use IO::Socket::INET;
use Socket;
use Carp;
=head1 NAME

mship - The mothership connection or 
        how I learned to stop worrying 
        and trust the script.

=head1 VERSION

Version 0.04

=cut

our $VERSION = '0.04';

=head1 SYNOPSIS

    use mship;
    
    my %status=mship::connection('IP', 'TCP_PORT');

    my $status=mship::mstat('HOST', 'TCP_PORT') ? "Up" : "Down";

    ...

=head1 FUNCTIONS

=head2 connection

=cut

##############
sub connection
##############
{
    my $IP          = shift;
    my $TCP_PORT    = shift;

    my ( $ipadd, $port_name, $remote_name );

    $ipadd       = Socket::inet_aton($IP) or
                      croak "$IP is not valid\n";

    $port_name   = getservbyport($TCP_PORT, 'tcp') or
                      $port_name = "unknown";

    $remote_name = gethostbyaddr( $ipadd, 2 ) or
                      print "Unable to resolve hostname for $IP\n";

    my %stats = ( 'IP'          => $IP,
                  'PORT'        => $TCP_PORT,
                  'port_name'   => $port_name,
                  'remote_name' => $remote_name,
                  'status'      => &mstat($IP, $TCP_PORT) );

    return %stats or
        carp "unable to return the value of \%stats\n";;
}

=head2 mstat

=cut

#############
sub mstat
#############
{
    my ( $host, $tcp_port ) = @_;
    
    my $isvalid  = Socket::inet_aton($host) or
                     croak "$host is not valid\n";
    
    my $sock     = IO::Socket::INET ->new(
                                      Timeout  => 2,
                                      PeerAddr => $host,
                                      PeerPort => $tcp_port,
                                      Proto    => 'tcp' );

    return $sock ? 1 : 0; 
    carp "Unable to return $sock\n";
}

=head1 AUTHOR

Ted Fiedler, C<< <fiedlert@gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to
C<fiedlert@gmail.com>

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2003, 2004, 2005 Ted Fiedler, All Rights Reserved.

This program is free software; you can redistribute it and/or modify i
+t
under the same terms as Perl itself.

=cut

1; # End of mship

[download]


Thanks in advance
Ted
--
"That which we persist in doing becomes easier, not that the task itself has become easier, but that our ability to perform it has improved."
  --Ralph Waldo Emerson

Replies are listed 'Best First'.
Re: Updating Tk window in real time
by TGI (Parson) on Jul 21, 2005 at 21:23 UTC
    You need to set up a routine to call get() after you have run MainLoop(). The easiest way to manage that is to schedule it with after(). 
    # Delete this from your code:
#for ( 0 .. 54 )
#{ 
#    get($_);
#    last if ($_ == 53 )
#}
# Replace with:

# Make  a closure with $counter.
{   my $counter = 1;
    $fetch_data_point = sub {
        get($counter++);  #collect a data point
        $mainwindow->after(100, $fetch_data_point) unless $counter > 5
+4; # schedule the next run, if necessary.
    };
}
$mainwindow->after(100, $fetch_data_point );  # wait 100 ms then call 
+function ref.

    [download]


    TGI says moo

[reply]
[d/l]
Re: Updating Tk window in real time
by BrowserUk (Patriarch) on Jul 21, 2005 at 22:05 UTC

    Using DoOneEvent() with DONT_WAIT inside your get() sub allows the window to be built and updated in real time. (I've simulated your module with a random sleep) 

    use strict;
#use mship;
use Tk qw[ MainLoop DoOneEvent DONT_WAIT ];

my $host;
$|++;

my $mainwindow = new Tk::MainWindow();

my $text = $mainwindow->Scrolled(
    "Text", -scrollbars => 'se'
)->pack(
    -expand => 1 , -fill => 'both'
);

for ( 0 .. 53 ) {
    DoOneEvent( DONT_WAIT ) for 1 .. 100; ## process pending events;
    get($_);
}


# create a closebutton
my $button = $mainwindow->Button(
    -text => "close",
    -command => sub{ $mainwindow->destroy() }
)->pack();

# start the main loop!
MainLoop;

sub get {
    sleep rand 3;
    my $remote_name = "remote: $_[ 0 ]";
    my $stats= rand() > 0.5 ? "Up" : "Down";
    $text->insert( 'end', "$remote_name is $stats\n");
}

    [download]

    My choice of  for 1 .. 100; is somewhat arbitrary. It would be nice if you could say DoPendingEvents() or DoOneEvent() while EventsPending();, but I never found anything like that.

    Update: Wadda ya know--seems DoPendingEvents() is called update(): 

    use strict;
#use mship;
use Tk;

my $host;
$|++;

my $mainwindow = new Tk::MainWindow();

my $text = $mainwindow->Scrolled(
    "Text", -scrollbars => 'se'
)->pack(
    -expand => 1 , -fill => 'both'
);

for ( 0 .. 53 ) {
    $mainwindow->update;
    get($_);
}
my $button = $mainwindow->Button(
    -text => "close",
    -command => sub{ $mainwindow->destroy() }
)->pack();

MainLoop;

sub get {
    sleep rand 3;
    my $remote_name = "remote: $_[ 0 ]";
    my $stats= rand() > 0.5 ? "Up" : "Down";
    $text->insert( 'end', "$remote_name is $stats\n");
}

    [download]
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom