http://www.perlmonks.org?node_id=945249

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

Please Suggest a option for parallel communication between 2 subroutine.

I need to start a 2nd subroutine operation at middle of subroutine A and want to run parallel with subroutine A. ALso Subroutine B need to stop at the completion of Subroutine A.

I tried to fork the process in Subroutine A and called the subroutine B from the child but didn't worked.

Sub A { 1. 2. 3. &sub B(); 4. 5.} Sub B { 1. 2. 3. 4. 5. }

Replies are listed 'Best First'.
Re: How to create a parallel communication with 2 subroutine
by BrowserUk (Patriarch) on Dec 27, 2011 at 22:32 UTC
    1. I see no attempt in your minimal pseudo-code to explain when & where & what you want the two subroutines to communicate?

      Should B communicate to A? Or A to B? Or both ways?

      And what should be communicated?

    2. You say "ALso Subroutine B need to stop at the completion of Subroutine A."

      Is that what you mean by communicate? Should A somehow tell B to stop what is it doing when A is about to end?

      What will B be doing when it is asked to end? Waiting for the communication? Or in the middle of something that can be abandoned?

    3. "I tried to fork the process in Subroutine A and called the subroutine B from the child but didn't worked."

      Unless you show us what you actually tried; and how it failed to meet your expectations, how can we suggest where the cause was because you implemented your approach incorrectly; or because the approach itself could never succeed?

    As is, any attempt to answer your question will be based soley on speculation as to your meaning and goals. It could only be correct by luck.


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

    The start of some sanity?

      Sorry if my explanation is minimal,

      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 server
Re: How to create a parallel communication with 2 subroutine
by Eliya (Vicar) on Dec 27, 2011 at 23:06 UTC
    I tried to fork the process in Subroutine A and called the subroutine B from the child but didn't worked.

    You haven't shown how you tried using fork, so it's hard to tell why it failed...

    Anyhow, here's a way using it that should fit your specs:

    #!/usr/local/bin/perl -w use strict; use Time::HiRes qw(usleep time); sub doit { my $n = shift; printf STDERR "%.3f: $n. [$$] %s doing something...\n", time(), (caller(1))[3]; usleep(5e5); } sub A { doit(1); doit(2); doit(3); my $pid = fork(); die $! unless defined $pid; if (!$pid) { B(); exit; } doit(4); doit(5); kill 9, $pid; # stop parallel process wait; } sub B { doit(1); doit(2); doit(3); doit(4); doit(5); } A(); __END__ 1325026859.241: 1. [24625] main::A doing something... 1325026859.741: 2. [24625] main::A doing something... 1325026860.241: 3. [24625] main::A doing something... 1325026860.742: 1. [24626] main::B doing something... 1325026860.743: 4. [24625] main::A doing something... 1325026861.243: 2. [24626] main::B doing something... 1325026861.243: 5. [24625] main::A doing something... 1325026861.743: 3. [24626] main::B doing something...

    (Of course, you could also send a less drastic signal than "9" to stop the other process.)

Re: How to create a parallel communication with 2 subroutine
by Anonymous Monk on Dec 27, 2011 at 22:33 UTC

    See threads, Proc::Background, Proc::Fork, Sub::Fork

    Basically, fooA controls fooB, when fooA is about the end, it interrupts, stops, kills... fooB before returning

    sub fooA { ... my $fooB = oneOfTheAboveModules( \&fooB ); ... $fooB->stop; return }