Category: |
Miscellaneous |
Author/Contact Info |
Jeff japhy Pinyan |
Description: |
Thanks to some helpful feedback from my fellow monks, I offer Loop-Watch-0.01b. I'm not releasing it to CPAN until I have some testing results. |
Here is the new code. I've tested it a bit more this time. Got rid of that deep recursion (curses, Abigail, fie on you!).
It now supports looping { ... } and doing { ... } (the latter only executes once); the function using has been replaced by the more aptly named watching.
package Loop::Watch;
use strict;
require Exporter;
@Loop::Watch::ISA = qw( Exporter );
@Loop::Watch::EXPORT = qw( ensure watching looping doing );
my %seen;
sub ensure (&@) {
my ($cref, $obj, $loop) = @_;
for (@$obj) {
if (ref eq 'SCALAR') { tie $$_, 'Loop::Watch::Scalar', $$_, $cref
+}
elsif (ref eq 'ARRAY') { tie @$_, 'Loop::Watch::Array', [ @$_ ], $
+cref }
elsif (ref eq 'HASH') { tie %$_, 'Loop::Watch::Hash', { %$_ }, $cr
+ef }
}
eval { { $loop->[1]->(); redo if $loop->[0] } };
die $@ if $@ and $@ ne "[Loop::Watch]\n";
for (@$obj) {
if (ref eq 'SCALAR') {
my $v = (tied $$_)->[0];
untie $$_;
$$_ = $v;
}
elsif (ref eq 'ARRAY') {
my $v = (tied @$_)->[0];
untie @$_;
@$_ = @$v;
}
else {
my $v = (tied %$_)->[0];
untie %$_;
%$_ = %$v;
}
}
}
sub watching (@) { [ map ref($_) ? $_ : \$_, @_ ] }
sub looping (&) { [ 1, $_[0] ] }
sub doing (&) { [ 0, $_[0] ] }
package Loop::Watch::Scalar;
sub TIESCALAR {
my $class = shift;
bless [ @_ ], $class;
}
sub FETCH {
my $self = shift;
my $val = $self->[0];
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub STORE {
my ($self, $val) = @_;
$self->[0] = $val;
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
package Loop::Watch::Array;
sub TIEARRAY {
my $class = shift;
bless [ @_ ], $class;
}
sub FETCH {
my ($self, $i) = @_;
my $val = $self->[0][$i];
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub FETCHSIZE {
my $self = shift;
my $size = @{ $self->[0] };
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $size;
}
sub STORE {
my ($self, $i, $val) = @_;
$self->[0][$i] = $val;
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub STORESIZE {
my ($self, $size) = @_;
$#{ $self->[0] } = $size;
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $size;
}
eval << 'END 5.6.0 CODE' if $^V;
sub EXISTS {
my ($self, $i) = @_;
my $val = exists $self->[0][$i];
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub DELETE {
my ($self, $i) = @_;
my $val = delete $self->[0][$i];
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
END 5.6.0 CODE
sub PUSH {
my $self = shift;
for (@_) {
push @{ $self->[0] }, $_;
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loo
+p::Watch]\n");
}
return scalar @{ $self->[0] };
}
sub POP {
my $self = shift;
my $val = pop @{ $self->[0] };
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub UNSHIFT {
my $self = shift;
for (reverse @_) {
unshift @{ $self->[0] }, $_;
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loo
+p::Watch]\n");
}
return scalar @{ $self->[0] };
}
sub SHIFT {
my $self = shift;
my $val = shift @{ $self->[0] };
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub CLEAR {
my $self = shift;
$self->[0] = [];
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return;
}
package Loop::Watch::Hash;
sub TIEHASH {
my $class = shift;
bless [ @_ ], $class;
}
sub FETCH {
my ($self, $key) = @_;
my $val = $self->[0]{$key};
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub STORE {
my ($self, $key, $val) = @_;
$self->[0]{$key} = $val;
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub FIRSTKEY {
my $self = shift;
my ($k,$v) = each %{ $_[0][0] };
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return wantarray ? ($k,$v) : $k;
}
sub NEXTKEY {
my $self = shift;
my ($k,$v) = each %{ $_[0][0] };
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return wantarray ? ($k,$v) : $k;
}
sub EXISTS {
my ($self,$key) = @_;
my $val = exists $self->[0]{$key};
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub DELETE {
my ($self, $key) = @_;
my $val = delete $self->[0]{$key};
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return $val;
}
sub CLEAR {
my $self = shift;
$self->[0] = {};
$seen{$self}++ ? ($seen{$self} = 0) : ($self->[1]->() or die "[Loop:
+:Watch]\n");
return;
}
1;
|
Docs and Examples for Loop::Watch
by japhy (Canon) on Apr 17, 2001 at 19:26 UTC
|
Since I left these out of the code I posted, and since some people did not follow the Help Name This Module thread, here is some documentation for the Loop::Watch module.
Abstract
Loop::Watch is like alarm() for variables -- it watches a given set of variables (scalars, arrays, and hashes are the only ones currently supported), and exits a block of code (which may or may not be a loop) as soon as the condition it is given becomes false. It's like a while-loop that keeps tabs on the condition constantly.
Usage
Let's say you wanted to do a series of statements, but stop as soon as one of them caused $temperature to go below 0, and if none caused that, to continue normally with the rest of the program.
use Loop::Watch;
my $temp = 20; # celsius, that is
# doing { ... } does *not* loop
ensure { $temp >= 0 } watching($temp), doing {
move_to_florida();
wait_until_winter();
move_to_new_jersey();
wait_until_spring();
move_to_montana();
wait_until_fall();
move_to_alaska();
wait_until_winter();
};
That code would probably stop somewhere around the move to New Jersey. That function could do any number of things to $temperature, and this module keeps an eye on things.
Let's say, though, you wanted to circle the globe until your money ran out:
use Loop::Watch;
my $money = 1_000_000; # in USD
# looping { ... } *does* loop
ensure { $money > 0 } watching($money), looping {
circle_globe();
};
sub circle_globe {
move_to_next_location();
purchase_lodging();
eat();
# ...
}
This allows the functions called by circle_globe()
to assume you have money left -- and as soon as you don't have any money left, you stop your trip.
You can watch multiple variables in the same block:
use Loop::Watch;
my ($age, @companies);
$age = 20;
ensure { $age < 35 and @companies < 10 }
watching($age, \@companies),
looping {
$age++ if new_year();
if (my $c = acquisition_available()) {
if (try_to_purchase($c)) {
push @companies, $c;
check_related($c);
}
}
};
That code will stop once you've reached 35 (good age to retire at) or you've acquired 10 companies. Maybe during the course of the new_year(), you lose a company or something -- that's ok. You needn't do any checking there, all the checking of the age and company count is done by the module.
japhy --
Perl and Regex Hacker | [reply] [d/l] [select] |
|
|