http://qs1969.pair.com?node_id=4943

Lets say you have a perl script sucking rows out of a database. You generally want to know that it's still running, instead of it sitting there, working it's butt off, and not printing anything while it performs some math or hashing or something. This whirleygig prints a character to stdout or stderr so you can see it working.
#!/usr/bin/perl

$|=1;$WHIRLEY_COUNT=-1;

#$whirley='-\|/';@whirley=split //,$whirley;
#$whirley='.o0O0o';@whirley=split //,$whirley;
#$whirley='1234567890';@whirley=split //,$whirley;
#$whirley='';@whirley=split //,$whirley;
$whirley=" ".pack(C,176).pack(C,177).pack(C,178).pack(C,219).pack(C,17
+8).pack(C,177). pack(C,176);@whirley=split //,$whirley;


sub whirley {
  if ($WHIRLEY_COUNT+1==@whirley) {
    $WHIRLEY_COUNT=0;
  } else {
    $WHIRLEY_COUNT++;
  }
  return "@whirley[$WHIRLEY_COUNT]";
}

while (1) {
    sleep 1;
    print STDERR "please wait : ".&whirley."\r";
}

[download]

Replies are listed 'Best First'.
RE: A whirleygig for a progress indicator for scripts
by btrott (Parson) on Mar 23, 2000 at 00:13 UTC
    In that spirit, here's another idea for improving/generalizing your code. 
        package Whirley;

    sub new {
        my $type = shift;
        my $class = ref $type || $type;

        my $WHIRLEY_COUNT = -1;
        my @whirley = map chr, qw/32 176 177 178 219 178 177 176/;

        my $self = sub {
            $WHIRLEY_COUNT = 0 if ++$WHIRLEY_COUNT == @whirley;
            return $whirley[$WHIRLEY_COUNT];
        };

        bless $self, $class;
    }

    package main;

    my $whirley = new Whirley;

    while (1) {
        sleep 1;
        print STDERR "please wait: ", $whirley->(), "\r";
    }

    [download]
    This packages up your whirley functionality into a package and a closure--you could even put it into Whirley.pm or something; then just use it and call it as illustrated.
[reply]
[d/l]

      Taking it one step further here is a repackage of btrott's version that takes an argument to choose from an array of weird spinners.

      #   main
    my $whirley = Whirley->new(1);

    while (1) {
        sleep 1;
        print STDERR "please wait: ", $whirley->(), "\r";
    }

    package Whirley;
    sub new {
        my $type = shift;
        my $number = shift;
        my $class = ref $type || $type;

        my $WHIRLEY_COUNT = -1;
        my @whirleyhash = (
          [qw(- \ | / )],
          [map chr, qw/32 176 177 178 219 178 177 176/],
          [qw(>--- ->-- -->- ---> ---* --- ---< --<- -<-- <--- *---)],
          [qw(_o_ \o/  _O_ \O/)],
          [qw/. .o .oO .oO(zzz) .oO(ZZZ) /],
          [ '(^_^ )','( ^_^)'],
          [ '(^_^ )','( ^_^)','( -_-)', '(-_- )' ]
        );
        my @whirley = @{$whirleyhash[$number]};

        my $self = sub {
            $WHIRLEY_COUNT = 0 if ++$WHIRLEY_COUNT == @whirley;
            return $whirley[$WHIRLEY_COUNT];
        };

        bless $self, $class;
    }

      [download]
[reply]
[d/l]
        Is there anyway i can use Whirley with File::Copy ?

        I want to show a progress meter (percentage) while moving a file.
        I found http://www.perlmonks.org/?node=File%20copy%20progress. but that doesn't use File::Copy and dont know if it working for large files.
        Or can i do something like;

        my $sizetarget= (-s $destination); 
my $sizesource= (-s $source);
my $percentage="";

while (move($source,$destination) || print "$!\n") {
$sizetarget = (-s $destination);
$percentage = ($sizetarget / $sizesource)*100;
print "[$percentage\%]\r";
}

        [download]
        hmm nope that doesnt work.. anyways you get my point.
        Hope anyone can give me an example or a hand :).
        greets,
        Wire64
[reply]
[d/l]
RE: A whirleygig for a progress indicator for scripts
by btrott (Parson) on Mar 08, 2000 at 22:57 UTC
    Or, since you're just taking the chr value of each of those numbers, just use map: 
    my @whirley = map chr, qw/32 176 177 178 219 178 177 176/;

    [download]
    Then you don't have to bother with split and all that.

    Also, the whirley function could use some work (particularly since it gives a warning): 

    sub whirley {
    $WHIRLEY_COUNT = 0 if ++$WHIRLEY_COUNT == @whirley;
    return $whirley[$WHIRLEY_COUNT];
}

    [download]
    The most important change here is the return line. You were taking an array slice: 
        return "@whirley[$WHIRLEY_COUNT]";

    [download]
    which isn't what you want to do; you just want a single element (and you don't need the quotes): 
        return $whirley[$WHIRLEY_COUNT];

    [download]
[reply]
[d/l]
[select]
      Never used map before, Thanks!
[reply]
Re: A whirleygig for a progress indicator for scripts
by Shendal (Hermit) on Sep 21, 2001 at 00:53 UTC
    In the spirit of TMTOWTDI, I thought that using tie might be interesting.

    ##### Whirley package
package Whirley;
use strict;
my @whirlies = qw!. o 0 O 0 o!;
my $current  = -1;

sub TIESCALAR {
  my $type  = shift;
  my $class = ref $type || $type;
  my $self = {};
  bless $self, $class;
}

sub FETCH {
  my $self = shift;
  my $backspace = $current < 0 ? '' : "\b"; # don't backspace on first
+ go 'round
  $current = 0 if (++$current == @whirlies);
  return $backspace . $whirlies[$current];
}

##### Main package
package Main;
use strict;
$|++;

my $whirley;
tie $whirley, 'Whirley';

print "Please wait: ";
while (1) {
  print $whirley;
  sleep 1;
}

    [download]

    Cheers,
    Shendal
[reply]
[d/l]
      Using the Tie::Cycle module, this can be simplified further ...

      use Tie::Cycle;

tie my $whirley, 'Tie::Cycle', [ qw( . o 0 O 0 o ) ];

#   And now for the demonstration ...

++$|;

while (1) {
    print $whirley, "\b";
    sleep 1;
}

      [download]

       

      perl -le 'print+unpack("N",pack("B32","00000000000000000000001000000000"))'

[reply]
[d/l]
[reply]
RE: A whirleygig for a progress indicator for scripts
by Anonymous Monk on Mar 08, 2000 at 15:00 UTC
    How about rewriting pack.pack.pack.pack line like $whirley=" ".pack('C*',176,177,178,219,178,177,176);@whirley=split //,$whirley;
[reply]
RE: A whirleygig for a progress indicator for scripts
by da w00t (Sexton) on Mar 22, 2000 at 21:44 UTC
    See, this is what I absolutely love about perlmonks.org. Post your code, and you get quick responces on how your code can be made better. :)
[reply]

Back to Cool Uses for Perl