Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Re^2: Second background process is pausing the gui

by bliako (Monsignor)
on Jun 12, 2020 at 10:39 UTC ( [id://11117969]=note: print w/replies, xml ) Need Help??


in reply to Re: Second background process is pausing the gui
in thread Second background process is pausing the gui

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

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (5)
As of 2024-03-28 08:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found