Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re: Race when redirecting output.

by ikegami (Patriarch)
on May 21, 2025 at 23:19 UTC ( [id://11165075]=note: print w/replies, xml ) Need Help??


in reply to Race when redirecting output.

You should use a pipe, but that might introduce a deadlock since you're using synchronous IO to print.

Since you don't seem to care if it's a system handle or not, use a tied handle. You wouldn't even have to poll; the output could be added to Tickit as soon as it's printed.

Replies are listed 'Best First'.
Re^2: Race when redirecting output.
by gnosti (Chaplain) on May 22, 2025 at 00:01 UTC
    Tied handle: That's just what I needed to hear. Thanks! From Tie::Simple, it's looking like the easiest to implement might be to tie to the $command_output variable in the example above. I'll only need to define two methods:
    use Tie::Simple; tie $scalar, 'Tie::Simple', $data, FETCH => sub { ... }, STORE => sub { ... };
Re^2: Race when redirecting output.
by gnosti (Chaplain) on May 22, 2025 at 17:18 UTC
    My naive test case using 'tie' still suffers some racelike issues, causing missing and (after about 10s) duplicate outputs. Should I be tieing a handle directly instead of opening a handle on a variable and tieing that?

    Edit: Answer: yes (working code below)

    #!/usr/bin/env perl use v5.36; =comment vbox - root scrollbox vbox static static ... entry =cut use Tie::Simple; use Tickit::Async; use Tickit::Widgets qw(ScrollBox Static VBox Entry); #use Tickit::Widget::Entry::Plugin::History; use Tickit::Widget::Entry::Plugin::Completion; use IO::Async::Loop; use IO::Async::Timer::Periodic; use IO::Async::Timer::Countdown; use IO::Async::Loop::Select; STDOUT->autoflush; my $loop = IO::Async::Loop->new; my $root = Tickit::Widget::VBox->new; my $vbox = Tickit::Widget::VBox->new; # contains multiple item +s to scroll through my $scrollbox = Tickit::Widget::ScrollBox->new->set_child( $vbox ); for (1..100){ my $a = 100 - $_; $vbox->add( Tickit::Widget::Static->new( text => "a hundred bottles +minus $_ is $a \n" )) } my $tickit = Tickit::Async->new( root => $root); my $term = $tickit->term; my $lines = $term->lines; $root->add($scrollbox, force_size => $lines - 1); # , expand => 1); my $entry = Tickit::Widget::Entry->new( text => "enter command > ", on_enter => sub { my ( $self, $line ) = @_; print_to_terminal($line); $scrollbox->scroll_to(1e5); $line =~ s/^.+?>\s*//; $self->set_text(''); my $prompt = 'enter command > '; $self->set_text($prompt); $self->set_position(99); } ); my $prompt = 'enter command > '; $entry->set_text($prompt); $entry->set_position(99); $root->add($entry); my $i; redirect_stdout(); timer(0.5,0.5, sub{ ++$i; say(join'',$i,'-','X'x40)}); $tickit->run; sub prompt { my $prompt = 'enter command > '; $entry->set_text($prompt); $entry->set_position(99); } our ($command_output, $output_fh, $old_output_fh); sub redirect_stdout { open(FH, '>', '/dev/null') or die; FH->autoflush; $old_output_fh = select FH; tie *FH, 'Tie::Simple', '', WRITE => sub { }, PRINT => sub { my $text = $_[1]; print_to_terminal +($text) }; PRINTF => sub { }, READ => sub { }, READLINE => sub { }, GETC => sub { }, CLOSE => sub { }; } sub restore_stdout { select $old_output_fh; close $output_fh; } sub print_to_terminal ($txt) { $vbox->add( Tickit::Widget::Static->new( text => $txt )); $scrollbox->scroll_to(1e5); } sub timer ($delay, $interval, $coderef ) { my $timer; if ($interval == 0){ $timer = IO::Async::Timer::Countdown->new( delay => $delay, on_expire => $coderef, ); } else { $timer = IO::Async::Timer::Periodic->new( interval => $interval, on_tick => $coderef, ); } $timer->start; $loop->add($timer); $timer }

      It doesn't need to be an open handle. You can use tie *FH, ... out of the blue. You can use tie local *FH, ... for something localized.

      $ perl -e' use v5.40; use feature qw( bareword_filehandles ); use Tie::Simple qw( ); tie *FH, Tie::Simple::, undef, PRINT => sub { shift; my $msg = join( defined( $, ) ? $, : "", @_ ); $msg .= $\ if defined( $\ ); say STDOUT "[$msg]"; }; say FH "Hello!"; ' [Hello! ]

      Without bare word file handles:

      $ perl -e' use v5.40; use Symbol qw( gensym ); use Tie::Simple qw( ); my $fh = gensym; tie *$fh, Tie::Simple::, undef, PRINT => sub { shift; my $msg = join( defined( $, ) ? $, : "", @_ ); $msg .= $\ if defined( $\ ); say STDOUT "[$msg]"; }; say $fh "Hello!"; ' [Hello! ]

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (3)
As of 2025-06-22 09:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.