1. I see no attempt in your minimal pseudo-code to explain when & where & what you want the two subroutines to communicate?
I wrote a Tk Program that wait for the user input detail from the server. While the program tring to fetch the details I want to run a Progress bar to show an activity is going on.
The First Subroutine perform the fetching the user input details from the server while the second subroutine try to run the Progress bar and complete it when the First Subroutine finish its operation.
You say "ALso Subroutine B need to stop at the completion of Subroutine A."
As Mentioned in the above the subroutine B is basically doing nothing other than running a progress bar till subroutine A complete its function
3. "I tried to fork the process in Subroutine A and called the subroutine B from the child but didn't worked."
Below is the code I tried to work#!/usr/bin/perl -w use strict; use 5.010; use Tk; use WWW::Mechanize; use Tk::ProgressBar; my $barcode = '1111111118'; my $barcode_text = 'Enter your Barcode'; my $wash_count; my $percent_done; my $main = MainWindow->new(-background=>'black'); my $top = $main->Frame(-background=>'cyan')->pack(-side=>'top',-fill= +>'x'); my $Heading = $top->Frame(-background=>'red')->pack(-side =>"top",-fil +l=>'x'); my $frame1 = $main->Frame(-background=>'yellow')->pack(-side =>"left" +,-fill=>'x'); my $frame2 = $main->Frame(-background=>'black')->pack(-side =>"top",- +fill=>'x',-padx=>250,-pady=>100); my $frame3 = $main->Frame(-background=>'black')->pack(-side =>"top",- +fill=>'x',-padx=>250,-pady=>100); $main->title('Linen Tracker'); $main->geometry("1000x800"); my $label = $Heading->Label(-text => "Linen Barcode Tracker", -font => "Verdana 16 bold",-background=>'orange' )->pack(-side=>'left',-ipady=>5,-fill=>'x',-expand=>1,-anc +hor=>'center',-padx=>25); #my $entry = $frame1->Entry(-width=>18,-justify => 'center',-backgroun +d=>'green',-textvariable =>\$barcode_text)->pack(-side=>'left',-fill= +>'x',-ipady=>10,-anchor=>'center'); my $entry1 = $frame2->Entry(-width=>18,-justify => 'center',-backgroun +d=>'green',-textvariable =>\$barcode)->pack(-side=>'left',-fill=>'x', +-ipady=>10,-padx=>50,-ipadx=>40); #my $exit = $frame2->Button(-text => 'Track',-background=>'white',-com +mand => [$main => 'destroy'])->pack(-side=>'left',-ipady=>10,-fill=>' +x'); my $exit = $frame2->Button(-text => 'Track',-background=>'white',-comm +and => [\&track])->pack(-side=>'left',-ipady=>10,-fill=>'x'); ################################################### # Start the Net Connection Test #################################################### #my $net = `ifconfig`; #say "net connection result : $net"; #my $true =~ (m/inet\saddr*/i); #if($net =~ /inet\saddr:192/i) { # say "true"; #} #else { # say "wrong"; #} #say "Ture = $true"; MainLoop; my $progressbar; my $overall; sub track { say "checking the internet Connection"; my $net = `ifconfig`; say "net connection result : $net"; #my $true =~ (m/inet\saddr*/i); if($net =~ /inet\saddr:192/i) { say "true"; $frame3->packForget(); $frame3 = $main->Frame(-background=>'black')->pack(-side =>"top", +-fill=>'x',-padx=>250,-pady=>100); #my $progressbar = $frame3->ProgressBar(-anchor=>'w',-width=>50,-l +ength=>800,-from=>0,-to=>100,-gap=>1,-variable=>\$temp,-colors=>[0,'r +ed',25,'yellow',75,'green'],-blocks=>50)->pack(-pady=>150,-padx=>10,- +ipady=>100); my $progress = $frame3->ProgressBar( -width => 30, -from => 0, -to => 100, -blocks => 50, -colors => [0, 'red', 50, 'yellow' , 80, 'green'], -variable => \$percent_done )->pack(-fill => 'x',-pady=>20); my $child = fork(); if($child > 0) { #&run(); ###################################################################### +######################################## # Web Craweling Start Here ###################################################################### +######################################## # create a new Mechanize Object my $mech = WWW::Mechanize->new(agent => 'Linux Mozilla'); $mech->cookie_jar(HTTP::Cookies->new()); $mech->get("http://romy-laptop.no-ip.org:8080/linen_tracking/l +ogin.html"); if($mech->success()) { say "sucessfully fetched the login page"; my $output_page = $mech->content(); # say "Page output =", $output_page; # say "current url of the page is ",$mech->uri(); my @links = $mech->links(); say "Total number of links found : ",scalar @links; say "title :", $mech->title(); my @total_forms = $mech->forms(); say "total number of forms found", scalar @total_forms; #$mech->field(username => 'demo'); #$mech->field(password => 'demo'); #$mech->click(); # say "current url of the page is ",$mech->uri(); #my %fields = { # username => 'demo', # password => 'demo', #}; $mech->submit_form( form_name => 'login', fields=> { username => 'demo', password=> 'demo' }, ); say "title :", $mech->title(); # $output_page = $mech->content(); # say "Page output =", $output_page; $mech->follow_link(url_regex => qr/bed_linen_read/); # $output_page = $mech->content(); # say "Page output =", $output_page; say "title :", $mech->title(); $mech->submit_form( form_name => 'read_barcode', fields=> { read_code => $barcode }, ); say "current url of the page is ",$mech->uri(); $output_page = $mech->content(); say "Page output =", $output_page; if($output_page =~ /.*name="wash_count"\svalue="(.*)"/) { say "output is $1"; $wash_count = $1; } } else { say "Error in connecting the server"; } ##################### Web Crawling Ends Here ######################### +######################################### #my $result = $frame3->Label(-text => "Sucessfuly Stored", # -font => "Verdana 16 bold",-background=>'orange' # )->pack(-side=>'top',-ipady=>5,-fill=>'x',-expand=>1,-anc +hor=>'center'); my $wash_count_label = $frame3->Label(-text => "Wash Count", -font => "Verdana 16 bold",-background=>'orange' )->pack(-side=>'left',-ipady=>5,-fill=>'x',-pady=>5,-expan +d=>1,-anchor=>'center'); my $entry2 = $frame3->Entry(-width=>18,-justify => 'center',-backg +round=>'green',-textvariable =>\$wash_count)->pack(-side=>'left',-fil +l=>'x',-ipady=>10,-padx=>20,-pady=>25); kill(9,$child); } else { &run(); # run the Child Process of Progress Bar } } else { say "wrong"; $frame3->packForget(); $frame3 = $main->Frame(-background=>'black')->pack(-side =>"top", +-fill=>'x',-padx=>250,-pady=>100); my $result = $frame3->Label(-text => "No Internet Connection", -font => "Verdana 16 bold",-background=>'orange' )->pack(-side=>'top',-ipady=>5,-fill=>'x',-expand=>1,-anch +or=>'center'); } ###################################################################### +########## #exit 0; } sub run { for (my $i = 0; $i < 1000; $i++) { $percent_done = $i/10; $frame3->update; # otherwise we don't see how far we + are. } }
My Error Message X Error of failed request: BadIDChoice (invalid resource ID chosen for this connection) Major opcode of failed request: 55 (X_CreateGC) Resource id in failed request: 0x400002a Serial number of failed request: 9735 Current serial number in output stream: 351
I am Getting the expected result in the Termninal but the Tk program crashes after fetching the user Input from the serverIn reply to Re^2: How to create a parallel communication with 2 subroutine
by romy_mathew
in thread How to create a parallel communication with 2 subroutine
by romy_mathew
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |