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;
[download]

---

---

• Are you posting in the right place? Check out Where do I post X? to know for sure.
• Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:

  <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>

• Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
• Want more info? How to link or How to display code and escape characters are good places to start.