# -*- perl -*-
#
# Locked.pm
# Version 0.1 (19990302)
# Copyright 1999 M-J Dominus (mjd-perl-locked@plover.com)
#

package Locked;
use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(is_Locked Lock Unlock);

# new Locked 'foo' 
sub new {
  my $caller = caller;
  my $pack = shift;
  while (@_) {
    my $name = shift;
    $name = $caller . "::$name" unless $name =~ /::/;
    my $val = shift || $ {$name};
    #  $val = \$val unless defined ref $val;
    my $self = {NAME => $name, 
		VALUE => $val,
		LOCKED => 1};
    bless $self => $pack;
    tie $ {$name} => $pack, $self;
  }
  1;
}

sub TIESCALAR {			# It's a joke, son.
  my $pack = shift;
  my $self = shift;
  $self;   
}

sub FETCH {
  $_[0]{VALUE};
}

sub STORE {
  if ($_[0]{LOCKED}) {
    require Carp;
    Carp::croak("Attempt to modify locked variable \$$_[0]{NAME}");
  }
  $_[0]{VALUE} = $_[1];
}

sub is_Locked (\$) {
  my $tiedvar = shift;
  my $self = tied $$tiedvar;
  return undef unless defined $self && $self->isa('Locked');
  $self->{LOCKED};
}

sub Unlock (\$) {
  my $tiedvar = shift;
  my $self = tied $$tiedvar;
  if (defined $self && $self->isa('Locked')) {
    $self->{LOCKED} = undef;  
  }
  1;
}

sub Lock (\$) {
  my $tiedvar = shift;
  my $self = tied $$tiedvar;
  if (defined $self && $self->isa('Locked')) {
    $self->{LOCKED} = 1;  
  }
  1;
}

1;