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

Dear Perl Monks,
I kneel before you once again to ask for your guidance. I have cleaned up my twirling baton progress indicator as follows:

#Twirling baton progress indicator
sub twirling_baton {
    my $interval = 1;  #Sleep time between twirls
    my $tcount = 0;
    my @baton = qw( | / - \ );
    $| = 1;

    while ($interval) {
        $tcount++;
        print $baton[ $tcount % @baton ];
        sleep ($interval);
        print "\b\b";
    }
}

[download]
I need to execute a shell script program during which the progress indicator is running. How can I start the twirling baton in Perl and then suspend it when I need to execute a system call to run the shell script in Perl? Any advice would be greatly appreciated.
Thanks,
Perl noob

Followup:
Thanks for all your suggestions =) I finally came up with this code that appears to work (still testing).
my $pid;
    
if ($pid = fork) { 
    &twirling_baton();
    waitpid($pid,0) 
    }
else {
    system("$program < $temp_file");
    defined($pid) or die "fork: $!\n";
    exit;
}

[download]

Replies are listed 'Best First'.
Re: Executing a shell script with progress indicator
by BrowserUk (Patriarch) on Oct 11, 2005 at 21:41 UTC

    This is easy using threads::async 

    #! perl -slw
use strict;
use threads qw[ async ];
use threads::shared;

$|=1;
my $done:shared = 0;
my $rc  :shared = 0;
async {
    system @ARGV;
    $rc = $? >> 8;
    $done = 1;
};
my $n=0;
printf "%s\b", substr '|/-\ ', ($n = ++$n % 4), 1
    while select( '','','',0.25) and not $done;

print "@ARGV : rc = $rc";

__END__
P:\test>499224 perl -e"sleep 10; exit 123"
perl -esleep 10; exit 123 : rc = 123

    [download]
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
    "Science is about questioning the status quo. Questioning authority".
    The "good enough" maybe good enough for the now, and perfection maybe unobtainable, but that should not preclude us from striving for perfection, when time, circumstance or desire allow.
[reply]
[d/l]
Re: Executing a shell script with progress indicator
by ikegami (Patriarch) on Oct 11, 2005 at 18:40 UTC
    Another tip:
    $| =1; should be moved out of the loop. It only needs to be executed once.
[reply]
[d/l]
Re: Executing a shell script with progress indicator
by ikegami (Patriarch) on Oct 11, 2005 at 20:51 UTC

    [In reply to updated question, where the OP attempts to use fork.]

    Close. You'll never reach to waitpid. Also, system(...); exit(); is the same as exec(...);

    I believe the code below is a robust (allows for missed polls or missed twitches), reusable (a user-provided function indicates when to stop polling) and fancy (seperate timers for polling and twitching) solution. (Untested)

    use POSIX       qw( WNOHANG    );
use Time::HiRes qw( time sleep );

sub min { $_[0] < $_[1] ? $_[0] : $_[1] }
sub max { $_[0] > $_[1] ? $_[0] : $_[1] }

sub twirling_baton {
   my ($twitch_interval, $poll_interval, $poll_func) = @_;

   my $af = ($| = 1);

   my $tcount = 0;
   my @baton  = qw( | / - \ );
   print($baton[0]);

   my $time = time;
   my $twitch_time = $time + $twitch_interval;
   my $poll_time   = $time + $poll_interval;

   for (;;) {
      sleep(max(min($twitch_time, $poll_time) - $time, 0.250));

      # Sleep is not precise.
      $time = time;

      if ($time >= $poll_time) {
         last if &$poll_func();
         $time = time;  # In case the call is slow.
         $poll_time = $time + $poll_interval;
      }

      if ($time >= $twict_time) {
         $tcount = ($tcount + 1) % @baton;
         print("\b", $baton[$tcount]);
         $twitch_time = $time + $twitch_interval;
      }
   }

   $| = $af;
}

$pid = fork;

if (not defined $pid) {
   die("Unable to create child process: $!\n");
}

if (not $pid) {
   exec("$program < $temp_file");
   die("Unable to launch application: $!\n");
}

twirling_baton(
   0.250,  # Twitch every 500ms
   0.500,  # Poll   every 500ms
   sub { waitpid($pid, WNOHANG) != 0 },
);

    [download]

    Update: Oops, I used : instead of ? in min and max. Fixed.

[reply]
[d/l]
[select]
      Wow! The code looks very impressive. I will give it a shot as it is beyond my comprehension. Can you recommend a good book that will cover this material?
[reply]
Re: Executing a shell script with progress indicator
by Roy Johnson (Monsignor) on Oct 11, 2005 at 17:30 UTC
    You're looking for fork.
    Caution: Contents may have been coded under pressure.
[reply]
Re: Executing a shell script with progress indicator
by blazar (Canon) on Oct 11, 2005 at 17:36 UTC
    Things you may want to know:
    • To fill @baton: 
      my @baton = qw(| \ - /);

      [download]
    • 1 second seems kinda too much: 
      select undef, undef, undef, .15;  # or use Time::HiRes

      [download]
    • slightly more inefficient, but (cleaner and) in this context I doubt it cares: 
      push @baton, shift @baton;
print "$baton[0]\b";

      [download]
    How can I start the twirling baton in Perl and then suspend it when I need to execute a system call to run the shell script in Perl?
    If I understand your question correctly, which I'm totally unsure about, you may want to read up on $SIG{ALRM}.
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom