sourcecode
japhy
Before I show the code, let me tell you a few of the other names people have suggested for this module:
<ul>
<li> GetTheHellOutOfLoop
<li> PHPSUX0R
<li> You::Are::Sux
<li> BlockF::cker
<li> Ensure
<li> Exiter
<li> Exeter
<li> Terminator
</ul>
Personally, my favorite is <tt>BlockF::cker</tt>, but that wouldn't go over very well with the masses now, would it?
<p>
So right now, it's called <tt>Ensure</tt>. Here's a sample use:
<code>
use Ensure;
use strict;
my ($x,$limit) = (0,100);
ensure { $x < $limit } using($x), looping {
print "Enter P,Q,R: ";
chomp(my $numbers = <STDIN>);
my ($p,$q,$r) = split /,/, $numbers;
$x += $p;
$x *= $q;
$x /= $r;
};
print "Finally stopped at $x.\n";
</code>
What this code has saved me from doing is:
<code>
while ($x < $limit) {
print "Enter P,Q,R: ";
chomp(my $numbers = <STDIN>);
my ($p,$q,$r) = split /,/, $numbers;
$x += $p;
last if $x >= $limit;
$x *= $q;
last if $x >= $limit;
$x /= $r;
}
</code>
The point is that the module tracks accesses and modifications to a given list of variables, and will execute a conditional expression at each point. As soon as the condition is false, it stops the loop.
<p>
This is synonymous to walking around the block several times, and AS SOON as you see [merlyn], you let me know. You don't wait to finish your current circuit, you tell me immediately.
<p>
<b>Update:</b> Here are some sample uses of the <tt>using()</tt> function:
<code>
ensure { ... } using($x,$y,$z), looping { ... };
ensure { ... } using($x,\@y), looping { ... };
ensure { ... } using($x,\%y,\@z), looping { ... };
</code>
Basically, scalars can be sent as-is. Arrays and hashes must be passed by reference. That's just the way it is.
So here's the bloody code.
<code>
package Ensure;
use strict;
require Exporter;
@Ensure::ISA = qw( Exporter );
@Ensure::EXPORT = qw( ensure using looping );
sub ensure (&@) {
my ($cref, $obj, $loop) = @_;
for (@$obj) {
if (not ref $$_) { tied($$_)->[1] = $cref }
elsif (ref $$_ eq 'SCALAR') { tied($$$_)->[1] = $cref }
elsif (ref $$_ eq 'ARRAY') { tied(@$$_)->[1] = $cref }
else { tied(%$$_)->[1] = $cref }
}
eval { { $loop->(); redo } };
die $@ if $@ ne "[Ensure]\n";
untie $$_ for @$obj;
}
sub using (@) {
my @obj;
for (@_) {
if (not ref) { tie $_, 'Ensure::Scalar' => $_ }
elsif (ref eq 'SCALAR') { tie $$_, 'Ensure::Scalar' => $$_ }
elsif (ref eq 'ARRAY') { tie @$_, 'Ensure::Array' => @$_ }
elsif (ref eq 'HASH') { tie %$_, 'Ensure::Hash' => %$_ }
else { next }
push @obj, \$_;
}
return \@obj;
}
sub looping (&) { $_[0] }
package Ensure::Scalar;
sub TIESCALAR {
my ($class, $val) = @_;
bless [ $val ], $class;
}
sub FETCH {
my $self = shift;
my $val = $self->[0];
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub STORE {
my ($self, $val) = @_;
$self->[0] = $val;
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
package Ensure::Array;
sub TIEARRAY {
my $class = shift;
bless [ [ @_ ] ], $class;
}
sub FETCH {
my ($self, $i) = @_;
my $val = $self->[0][$i];
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub FETCHSIZE {
my $self = shift;
my $size = @{ $self->[0] };
die "[Ensure]\n" unless $self->[1]->();
return $size;
}
sub STORE {
my ($self, $i, $val) = @_;
$self->[0][$i] = $val;
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub STORESIZE {
my ($self, $size) = @_;
$#{ $self->[0] } = $size;
die "[Ensure]\n" unless $self->[1]->();
return $size;
}
sub EXISTS {
my ($self, $i) = @_;
my $val = exists $self->[0][$i];
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub DELETE {
my ($self, $i) = @_;
my $val = delete $self->[0][$i];
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub PUSH {
my $self = shift;
for (@_) {
push @{ $self->[0] }, $_;
die "[Ensure]\n" unless $self->[1]->();
}
return scalar @{ $self->[0] };
}
sub POP {
my $self = shift;
my $val = pop @{ $self->[0] };
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub UNSHIFT {
my $self = shift;
for (reverse @_) {
unshift @{ $self->[0] }, $_;
die "[Ensure]\n" unless $self->[1]->();
}
return scalar @{ $self->[0] };
}
sub SHIFT {
my $self = shift;
my $val = shift @{ $self->[0] };
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub CLEAR {
my $self = shift;
$self->[0] = [];
die "[Ensure]\n" unless $self->[1]->();
return;
}
package Ensure::Hash;
sub TIEHASH {
my $class = shift;
bless [ { @_ } ], $class;
}
sub FETCH {
my ($self, $key) = @_;
my $val = $self->[0]{$key};
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub STORE {
my ($self, $key, $val) = @_;
$self->[0]{$key} = $val;
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub FIRSTKEY {
my $self = shift;
my ($k,$v) = each %{ $_[0][0] };
die "[Ensure]\n" unless $self->[1]->();
return wantarray ? ($k,$v) : $k;
}
sub NEXTKEY {
my $self = shift;
my ($k,$v) = each %{ $_[0][0] };
die "[Ensure]\n" unless $self->[1]->();
return wantarray ? ($k,$v) : $k;
}
sub EXISTS {
my ($self,$key) = @_;
my $val = exists $self->[0]{$key};
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub DELETE {
my ($self, $key) = @_;
my $val = delete $self->[0]{$key};
die "[Ensure]\n" unless $self->[1]->();
return $val;
}
sub CLEAR {
my $self = shift;
$self->[0] = {};
die "[Ensure]\n" unless $self->[1]->();
return;
}
1;
</code>
This code allows you to escape loops immediately when a condition is met. It is currently named "Ensure", but I know you can think of a better name.
Miscellaneous
Jeff [japhy] Pinyan