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

Hello Monks, This is the first time i'm using Tk module. My program works fine without using Tk. When using Tk, as soon as i click on the command button, the program runs fine in command prompt, but the Tk GUI freezes. The program takes quite a long time to execute, and returns result every 5 seconds which is to be updated in the TableMatrix. But the GUI freezes and finally when the program is complete, everything is updated in the GUI. Is there a way to make the GUI interactive as in VB??? BTW, the program has only 4 widgets - label, text, table (TableMatrix) and a command button. Thanks in advance monks! Sample code:

my $lbl_var_1 = $window -> Label(-text=>"Enter the keyword: ")->pack() +; my $txt_var_1 = $window -> Entry()->pack(-pady=>20); my $btn_var_1 = $window -> Button(-text => "Get the URL !", -command = +> \&Geturl)->pack(); my $table = $window->Scrolled('TableMatrix', -cols=>4, -drawmode=>'fas +t', -variable => $array_var,-state=>"disabled", -resizeborders => 'bo +th',-colstretchmode => 'unset', -rowstretchmode => 'last')->pack(-pad +y=>20, -fill=>'x');

When $btn_var_1 is clicked, the Geturl function, navigates through many sites and takes out a particular URL and returns it. Question updated and exclamations removed as told by Marto. Awaiting your reply. Thanks.

Replies are listed 'Best First'.
Re: Perl Tk freezes when command button is clicked !
by marto (Cardinal) on Feb 17, 2010 at 11:52 UTC

    The fault lies on line 42 of your code. Seriously though, read and understand How do I post a question effectively?, update your post with example code (a mimimum example which demonstrates the problem), sample data and any output.

    Also, there is no need for multiple exclamation marks.

Re: Perl Tk freezes when command button is clicked !
by biohisham (Priest) on Feb 17, 2010 at 12:14 UTC
    I can only speculate, since your question is not so clear that this could be because of buffering...

    Try this at the top of the code or show a demonstration of your problem in code so we can help you better..

    $|++;

    Update: the OP pasted no code initially ergo the above response. zentara's reply rocks!


    Excellence is an Endeavor of Persistence. Chance Favors a Prepared Mind.

      Its a quite big program and i thought it'll mess up the forum. Anyways i'll post the entire program now.

      my $i=1; my $array_var; my $window = MainWindow->new; $window->title("Breadcrumb Buster"); $window->geometry("600x850"); #my $window=$window->Frame()->pack(); my $lbl_var_1 = $window -> Label(-text=>"Enter the keyword: ")->pack() +; my $txt_var_1 = $window -> Entry()->pack(-pady=>20); my $btn_var_1 = $window -> Button(-text => "Get Breadcrumb !", -comman +d => \&Getbread)->pack(); $array_var->{"0,0"} = "Sno"; $array_var->{"0,1"} = "Manufacturer Name"; $array_var->{"0,2"} = "Manufacturer URL"; $array_var->{"0,3"} = "Breadcrumb"; my $table = $window->Scrolled('TableMatrix', -cols=>4, -drawmode=>'fas +t', -variable => $array_var,-state=>"disabled", -flashtime=>0.25,-fla +shmode=>1,-resizeborders => 'both',-colstretchmode => 'unset', -rowst +retchmode => 'last')->pack(-pady=>20, -fill=>'x'); $table->configure(-height=>"200"); #$table->rowHeight(0,1); $table->tagRow('title',0); $table->tagConfigure('title', -bd=>2, -relief=>'raised'); $table->tagConfigure('OddRow', -bg => 'white', -fg => 'purple'); #$table->colWidth(0,5,3,6,4,10); sub Getbread() { my $bread; my $input_keyword=$txt_var_1->get(); print "$input_keyword\n"; my $query_url="http://www.google.com/products?as_q=$input_keyword& +as_epq=&as_oq=&as_eq=&num=100&scoring=r&as_occt=any&price1=&price2=&s +how=dd&safe=active"; loop: my $content=&Geturl($query_url); while($content=~m/<li\s*class\=\"result\"[^>]*?>([\w\W]*?)<\/li>/i +gs) { my ($temp_content, $cse_url, $cse_url_temp, $cse_url_old, $pro +duct_title, $new_price, $used_price, $number_sellers, $cse_content, $ +mer_url, $merchant_name); $temp_content=$1; if($temp_content=~m/\"result\-seller\">\s*from\s*[\d]+\s*selle +rs/is) { if($temp_content=~m/<h3\s*class\=\"result\-title\">\s*<a\s +*href\=\"([^>]*?)\"\s*>\s*([\w\W]*?)\s*<\/h3>/is) { $cse_url_temp=$1; $product_title=$2; $cse_url="http://www.google.com".$cse_url_temp; decode_entities($cse_url); $product_title=~s/<[^>]*?>//igs; decode_entities($product_title); $product_title=~s/\'/\'\'/igs; } $cse_url=~s/\#p/\&os\=sellers\#p/igs; $cse_url_old=$cse_url; paging: $cse_content=&Geturl($cse_url); while($cse_content=~m/(<tr[^>]*?id\=\"[^>]*?>[\w\W]*?<\/sp +an>\s*<\/td>\s*<\/tr>)/igs) { my ($yahoo_store, $meta_keyword, $meta_description, $m +erchant_content, $online_since, $alexa_rank, $merchant_status, $merc +hant_url_temp, $merchant_url, $merchant_name, $temp_cse_content); $temp_cse_content=$1; if($temp_cse_content=~m/\"seller\-name\"><a\s*href\=\" +[^>]*?\?q\=(http(?:s)?\:\/\/[^>]*?\/[^>]*?)\&fr[^>]*?\"\s*>([\w\W]*?) +<\/a>/is) { $mer_url=$1; $merchant_name=$2; $merchant_name=decode_entities($merchant_name); $merchant_name=~s/\'/\'\'/igs; $mer_url=uri_unescape($mer_url); + } $bread=&Get_merchant($mer_url); } } elsif($temp_content=~m/<h3\s*class\=\"result\-title\">\s*<a\s* +href\=\"([^>]*?)\"\s*>\s*([\w\W]*?)\s*<\/h3>/is) { $cse_url_temp=$1; $cse_url_temp=uri_unescape($cse_url_temp); $merchant_name=$2; if($cse_url_temp=~m/q\=([^>]*?)\&fr/is) { $mer_url=$1; $mer_url=uri_unescape($mer_url); } $merchant_name=~s/<[^>]*?>/ /igs; $bread=&Get_merchant($mer_url); } if($bread ne "") { $array_var->{"$i,0"} = $i ; $array_var->{"$i,1"} = "$merchant_name"; $array_var->{"$i,2"} = "$mer_url"; $array_var->{"$i,3"} = "$bread"; $i++; print "\n$merchant_name"; last if $i==6; } } } sub Geturl() { my $url=shift; $url=uri_unescape(uri_unescape(uri_unescape($url))); start: my $req=HTTP::Request->new(GET => "$url"); $req->header("Content-Type"=> "application/x-www-form-urlencoded") +; my $res=$ua->request($req); my $con=$res->content(); if($con=~m/<form\s*action\=\"Captcha\"/is) { print "\nGoogle Blocked - Now Sleeping..."; sleep(1200); goto start; } return $con; } sub Get_merchant() { my $merchant_url=shift; my $breadcrumb; my $merchant_content=&Geturl($merchant_url); if($merchant_content=~m/<h1\s*class\=\"breadcrumbfull\">\s*([\w\W] +*?)\s*<\/h1>/is) { $breadcrumb=$1; } elsif($merchant_content=~m/<div[^>]*?(?:bread|crumb)[^>]*?>\s*([\w +\W]*?)\s*<\/div>/is) { $breadcrumb=$1; } elsif($merchant_content=~m/<td[^>]*?NavPath[^>]*?>\s*([\w\W]*?)\s* +<\/td>/is) { $breadcrumb=$1; } $breadcrumb=~s/<[^>]*?>//igs; decode_entities($breadcrumb); $breadcrumb=~s/\'/\'\'/igs; chomp($breadcrumb); return $breadcrumb; } MainLoop;
        Your problem is a common one, in all gui toolkits, it's called "blocking the event loop". All gui's use an event loop, that is why they can be responsive to button clicks, etc. When you put a sleep statement, or do something which is long and intensive like getting a url thru a slow netlink, the event loop will freeze until it regains control. This can be shown is the following example. After 2.5 seconds, it will freeze for 5 seconds
        #!/usr/bin/perl use Tk; my $mw = MainWindow->new; $mw->geometry('100x100+100+100'); #$mw->overrideredirect(1); my @color = qw/red green/; my $bits = pack("b8"x8, "...11...", "..1111..", ".111111.", "11111111", "11111111", ".111111.", "..1111..", "...11...",); $mw->DefineBitmap('indicator' => 8,8, $bits); my $label = $mw->Label( -bitmap=>'indicator', -bg=>'black', -fg=>'red', )->pack; $mw->repeat(500,sub{$label->configure( -fg=>$color[0]); @color=reverse(@color); }); # put in simulated eventloop blocker after 2.5 seconds # to freeze tk for 5 seconds $mw->after(2500,sub{ sleep (5) }); MainLoop;
        There are many ways around this problem. First never use sleep in a gui app, unless it's in a thread. Second, put your url_fetching operations into threads or fork them off. You can try to manually pump the loop by liberally sprinkingly DoOneEvent(); in areas where the code is in a delay loop( like your in while( $fh ). Finally, use Tk::fileevent to read your filehandles, instead of a while loop. Use timers when needing delays, like Tk::repeat.

        There are many examples out there on google for using Tk with threads and shared variables. See Tk events by Lidie and a few examples of using threads and fileno's with Tk ztk-BBC-World-News-Rss-TickerTape and Re^3: Passing globs between threads


        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku