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', { %$_ }, $cref }
  }

  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 "[Loop::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 "[Loop::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;