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><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><code>##

ensure { ... } using($x,$y,$z), looping { ... };

ensure { ... } using($x,\@y), looping { ... };

ensure { ... } using($x,\%y,\@z), looping { ... };

##</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;