Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Second background process is pausing the gui

by Ohad (Novice)
on Jun 10, 2020 at 10:06 UTC ( [id://11117902]=perlquestion: print w/replies, xml ) Need Help??

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

Hi, I'm using perl/Tk. I've created a background process to run a cmd and I want the main process to continue working. This is fine and works, until I invoke an additional background process. Than the GUI is stuck until the first process is done.

This is the first background process:

open (my $st_in, "<&STDIN"); open (my $out, '>&', STDOUT); open (my $err, '>&', STDERR); open (STDOUT, "> /dev/null"); open (STDERR, "> /dev/null"); open (STDIN, "< /dev/null"); my $status = open ($reg_out,"$cmd 2>&1 |") or die "can't fork: $!" +; if ($status) #Parent { open (STDOUT, '>&', $out); open (STDERR, '>&', $err); open (STDIN, '<', $st_in); } else { exit; } $Reg_r{$regl_name}{$nn}{'OutP'} =$reg_out; $Reg_r{$regl_name}{$nn}{'PID'} = $status; $Reg_r{$regl_name}{$nn}{'JobId'} = 0; $Reg_r{$regl_name}{$nn}{'IsRun'} = 1; $Reg_r{$regl_name}{$nn}{'WasRuning'} = 0; $book->raise("Sheet 1") if ($re_run_csv); $Sbook->raise("$regl_name $nn"); $mw->fileevent($reg_out, 'readable', [\&fill_text_widget,$regl_nam +e,$nn]);

Second can be anything, a simple xterm

 system("xterm -e '$viewer $log' &")

Any idea how to solve it? So the main process will not be stuck? As you see in the code, I tried many options, exec/system/`,I tried closing STDs.. Could really use some advice here

Replies are listed 'Best First'.
Re: Second background process is pausing the gui
by bliako (Monsignor) on Jun 10, 2020 at 19:04 UTC

    Is $reg_out global? If yes, could fileevent be cancelling the current bind and binding to new shell-out? Similar problem of "freezing" was solved here: Perl::TK - fileevent and script execution theory

    BTW, you certainly don't want exec because it replaces the current perl process and once finished, you program will exit.

    Outside the Tk realm, if you want to run a background process you could fork first and then spawn/shellout. Like:

    my $pid = fork() // die "fork: $!"; if( $pid ){ print "forked: i am shelling out\n"; spawn(); print "after shelling out.\n"; } print "I am now waiting for background process.\n"; waitpid $pid, 0; print "done.\n"; sub spawn { my $pid = open(my $xx, "sleep 1 2>&1|") or die "fork: $!"; print "implicitly waiting for child...\n"; # close($xx); }

    Also, I don't know what side-effects fileevent has on the above code, but usually when forking out to an external command you must wait for it to finish. Essentially, close($reg_out) acts as a waitpid $status, 0;. But if you don't, then perl will implicitly wait for it. If the code you posted is a sub, it will not exit until $cmd is dead (again, I don't know how fileevent interferes with this if at all).

    So, something like this:

    print "before spawn\n"; spawn(); print "after spawn\n"; sub spawn { my $pid = open(my $xx, "sleep 3 2>&1|") or die "fork: $!"; print "implicitly waiting for child...\n"; # the proper way to wait for the command to exit: # close($xx); } # output: before spawn implicitly waiting for child... # sleep... after spawn

    UPDATE: exec on the other hand is used in a trick where the program forks using open(my $xx, '|-'); and at the child branch the external command is spawned using exec (which offers finer control over open if one wants to avoid the shell). But that's different to calling exec() in your normal program flow (as an alternative to system()) as it will kill your program.

    bw, bliako

Re: Second background process is pausing the gui
by choroba (Cardinal) on Jun 11, 2020 at 20:58 UTC
    It seems fileevent is broken. Maybe current hardware can read much faster than when Tk was originally designed, so Tk can't manage to update before next line comes in?

    Fortunately, you can use repeat to read the data from the process:

    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

      At last some code to play with - thanks as I do not know where to start with Tk! Unfortunately it still blocks if the external process blocks, for example: sleep 10 && echo hello instead of find.

      I have modified your code to non-block with some help from PM's Re: Non blocking read on a filehandle. There is a simpler way though: change the filehandle to O_NONBLOCK after you open it using Fcntl::fcntl(). It does work but it reports weird file flags and I am unsure whether it is safe (Edit: I mean safe to be used with filehandles open'ed to external commands using -| . I think it's OK but this is the warning I get, notice that the reported $flags contain the command's output! Argument "\0sy^F>V\0\0\0\0\0\0\0\0\0\0output\0\0\0\0\0\0\0\0\0\0\0..." isn't numeric in bitwise or (|) Edit2Problem solved: I was reading an older example of fcntl, it should be: my $flags = fcntl($in, F_GETFL, 0) - for non-windows OSes.). Both versions below

      # non-blocking pipe using select use Tk; { my $in; sub stop { undef $in } # modified by bliako # non-blocking way to check if $fh has output ready sub has_output_ready { my ($fh, $nbytes) = @_; my $timeout = 0; my $rin = ''; vec($rin, fileno($fh), 1) = 1; if( select($rin, undef, undef, $timeout) ){ my ($buffer); read ($fh, $buffer, $nbytes); # fh has data and we are returning nbytes max # make $nbytes arbitrarily large or next time (if buffer holds +) return $buffer; } return; # no output at this time, return undef } sub run { my ($type, $entry) = @_; my $command = $entry->cget('-text'); if (1 == $type) { my $out = $_[2]; open $in, '-|', $command or die $!; my $repeat; $repeat = ($entry->repeat(1, sub { return $entry->afterCancel($repeat) if $repeat && ! defined $in; # modified by bliako: read blocks, # use has_output_ready() instead #read $in, my $buff, 100; my $buff = has_output_ready($in, 100, 0); if ($buff && length $buff) { # undef means no data yet $out->insert(end => $buff); $out->yview('end'); } })); } elsif (2 == $type) { system "$command&"; } } } ...

      Second method, using Fcntl::fcntl()

      # non-blocking pipe using O_NONBLOCK file flag, unsafe(?) ... open $in, '-|', $command or die $!; # modified by bliako to set the filehandle to non-block IO use Fcntl; # EDIT: commented below is not supported and outputs warning about ORi +ng non-numerical flags #my $flags = ""; #fcntl($in, F_GETFL, $flags) or die "failed to get flags, $!"; # use this instead: my $flags = fcntl($in, F_GETFL, 0); # reporting weird flags (linux)! print "FLAGS: '$flags'\n"; $flags |= O_NONBLOCK; fcntl($in, F_SETFL, $flags) or die "Couldn't set file flags: $!\n"; ... # and now read is non-block, # undef will be returned if no output ready read $in, my $buff, 100; if ($buff && length $buff) { # check if undef ... } ...

      bw, bliako

Re: Second background process is pausing the gui
by tybalt89 (Monsignor) on Jun 12, 2020 at 14:55 UTC

    Here's how I'd do it.

    #!/usr/bin/perl use strict; # https://perlmonks.org/?node_id=11117902 use warnings; use Tk; use Tk::IO; my $date = localtime(); my $mw = MainWindow->new; $mw->Button(-text => 'Start', -command => \&start, )->pack(-side => 'top', -fill => 'x'); $mw->Label(-textvariable => \$date, -fg => 'blue', )->pack(-side => 'top', -fill => 'x'); $mw->Button(-text => 'Exit', -command => sub {$mw->destroy}, )->pack(-side => 'bottom', -fill => 'x'); $_ = $mw->Text(-width => 10, -font => 14, )->pack(-side => 'left') for my( $one, $two ); $mw->repeat( 1000, sub { $date = localtime() } ); MainLoop; sub start { Tk::IO->new(-linecommand => sub { $one->insert(end => shift); $one->see('end');}, )->exec('for i in `seq 1 24` ; do sleep .5 ; echo $i ; done'); Tk::IO->new(-linecommand => sub { $two->insert(end => shift); $two->see('end');}, )->exec('for i in `seq 1 24` ; do sleep .7 ; echo $i ; done'); }

    Note that the date keeps advancing while the text widgets are being filled in, indicating that the gui is still responding.

      But if you replace one of the shell loops with find, it hangs again until the find finishes.
      map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]

        I don't see that on my system.

        I did replace the second shell command with xterm -e htop and it did pop up a new xterm running htop while still filling in the first text widget, exactly as expected.

Re: Second background process is pausing the gui
by perlfan (Vicar) on Jun 10, 2020 at 12:51 UTC
    I am unfamiliar with using Tk, but this looks odd to me, what is it providing to your application - open (STDIN, "< /dev/null"); ? Is that a Tk idiom?

      "Is that a Tk idiom?"

      No, though your favourite search engine will likely return an explanation.

Re: Second background process is pausing the gui
by Anonymous Monk on Jun 18, 2020 at 12:23 UTC

    Thanks for the answers.

    I want to keep it as simple as possible, also I would prefer it to have "real-time" update, not waiting for a buffer to fill up. This is my fileevent function:

    sub fill_text_widget { my $block = shift; my $numb = shift; my $widget = $Reg_r{$block}{$numb}{'Txt'}; my $out_rep = $Reg_r{$block}{$numb}{'OutP'}; if (eof($out_rep)) { $widget->fileevent($out_rep,"readable", undef); close $Reg_r{$block}{$numb}{'OutP'}; print "Got EOF\n" if ($DBG); $Reg_r{$block}{$numb}{'IsRun'} =0; &AddReRun($block, $numb); return; } $_ = <$out_rep>; $widget->insert('end', $_); $widget->yview('end'); }

    The annoying part, is that the gui keeps working fine after launching the open as if in real background, the gui is completely functional. Only when I invoke an additional process, let's say an xterm, the gui suddenly gets blocked, although both jobs are running. The gui will be free only when the initial open is done

    regrading the option to use FCNTL, can you elaborate on it? I tried using it, didnt made a difference, but I think I didn't do it properly. Can I keep using fileevent or do I have to move to read?

A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11117902]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (4)
As of 2024-03-29 09:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found