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

Dear monks,

I have a script (TK) doing a database import. When loading a database into a TK-table, a notification window pops up telling the user that the script is processing the database. I’d like the windows pops up only after x-seconds of loading processing (just not to annoy the user if the process lasts only milliseconds). Unfortunately I have no idea how to implement this. So far I have:

sub import { #pop-up notification of import our $notification = $mw->Toplevel(); $notification->geometry('+400+400'); $notification->overrideredirect(1); $notification->withdraw; $notification->Label( -text => " Please wait, I am working... ", -foreground => 'white', -background => 'black', -height => 5 )->pack; display_notification(); #------------------------------------- # DOING THE LOADING HERE #------------------------------------- hide_notification(); } sub display_notification { $notification->deiconify; $notification->raise; } sub hide_notification { $notification->withdraw; }

How can I delay the pop-up window, let’s say I want to show it only if the loading time is more than 2 seconds? Should I use fork? Any idea would be very much appreciated. Thanks, Cla

Replies are listed 'Best First'.
Re: Showing pop-up window after x-seconds processing
by Corion (Patriarch) on Aug 07, 2010 at 09:16 UTC

    The basic problem is that while your program is busy importing the data, it cannot tell Tk to do updates to its windows.

    The easiest solution if you can manage that is to spawn off a separate program to do the actual data import. That way, you can even create a way to do fully unattended data imports without a GUI.

    Another way would be to spawn a thread which does the importing, but using Tk with threads is likely to cause you no end of fancy problems because the resources allocated to Tk in the main thread will (or will not) get shared or recreated in the spawned thread. The same likely holds true when forking a child process.

    Another thing you could do is to modify your data import loop to look like this:

    my $start_time = time(); # remember when we started my $progress; while (<$input_file>) { ... if (time - $start_time > 2) { # 2 seconds have passed $progress = create_progress_dialog(); Tk->update(); # I don't know if there is such a thing or wheth +er Tk needs it }; }; undef $progress; # hide progress dialog if we have one

    Alternatively, you can try to use the Tk facilities like Tk->after():

    use Time::HiRes qw(time); my $progress; my $popup = Tk->after( 2, sub { $progress = create_progress_dialog } ) +; my $last_poll = time(); while (<$input_file>) { # let Tk process its events every 0.1 seconds: if (time - $last_poll > 0.1) { Tk->process_one_event(); }; ... }; if ($progress) { undef $progress; }; undef $popup; # cancel our Tk->after() timeout

    That way, Tk can also respond when the user clicks on a window or tries to minimize/move it.

      Thank you. Your method "Modifying your data import loop" works great. I noticed now, that much of the importing time in my script is due to a "sort" I must due during importing. Any way to keep track also of this time? What I have so far is following (after implementig your idea):

      sub import { $dbh = DBI->connect( "dbi:SQLite:files/database/data3.db" ) || die "Ca +nnot connect: $DBI::errstr"; my $start_time = time(); # remember when we started foreach my $row_db ( sort { deaccent($a->[($selected_order+2)]) cmp de +accent($b->[($selected_order+2)]) or $a->[($selected_order+2)] cmp $b +->[($selected_order+2)] } @$all_select_glossary_orderd ) { my ($ID, $a, $b,$c, $d, $e, $f) = @$row_db; ### DOING HERE SOMETIHN WITH MY DATA (IMPORT/PRINTING) if (time - $start_time > 2) { # 2 seconds have passed display_note(); $mw->update(); } } $dbh->disconnect; } #subrutine for better alphab. sorting sub deaccent { my $in = $_[0]; return lc($in) unless ( $in =~ y/\xC0-\xFF// ); #short circuit if +no upper chars # translterate what we can (for speed) $in =~ tr/ÀÁÂÃÄÅàáâãäåÇçÈÉÊËèéêëÌÍÎÏìíîïÒÓÔÕÖØòóôõöøÑñÙÚÛÜùúûüÝÿý/ +AAAAAAaaaaaaCcEEEEeeeeIIIIiiiiOOOOOOooooooNnUUUUuuuuYyy/; # and substitute the rest #my %trans = qw(Æ AE æ ae Þ TH þ th Ð TH ð th ß ss); #$in =~ s/([ÆæÞþÐðß])/$trans{$1}/g; $in =~ tr/'//d; # d for delete return lc($in); }

        You can also move your updating right into the block passed to sort:

        my $last_time = time; sort { if (time - $last_time > 1) { $mw->update(); }; $a <=> $b } @list;

        Alternatively, think about caching the search comparisons or creating a string key to sort on. That might be much faster than repeated field accesses:

        for (@items) { push @$_, deaccent( $_->[$selected+2] ) . $_->[$selected+2]; }; @items = sort { $a->[-1] cmp $b->[-1] } @items;