view release on metacpan or  search on metacpan

lib/Data/Lock.pm  view on Meta::CPAN

use Attribute::Handlers;
use Scalar::Util ();

use base 'Exporter';
our @EXPORT_OK = qw/dlock dunlock/;

#my @builtin_types = 
#    qw/SCALAR ARRAY HASH CODE REF GLOB LVALUE FORMAT IO VSTRING Regexp/;

for my $locked ( 0, 1 ) {
    my $subname = $locked ? 'dlock' : 'dunlock';
    no strict 'refs';
    *{$subname} = sub {
        no warnings "uninitialized";
        return if $_[1] and Internals::SvREADONLY( $_[0]) == $locked;
        Internals::SvREADONLY( $_[0], $locked );
        return unless my $type = Scalar::Util::reftype( $_[0] );
        for (
              $type eq 'ARRAY' ? @{ $_[0] }
            : $type eq 'HASH'  ? values %{ $_[0] }
            : $type ne 'CODE'  ? ${ $_[0] }
            :                    ()
          )
        {
            &$subname($_, 1) if ref $_;
            Internals::SvREADONLY( $_, $locked );
        }
            $type eq 'ARRAY' ? Internals::SvREADONLY( @{ $_[0] }, $locked )
          : $type eq 'HASH'  ? Internals::SvREADONLY( %{ $_[0] }, $locked )
          : $type ne 'CODE'  ? Internals::SvREADONLY( ${ $_[0] }, $locked )
          :                    undef;
    };
}

1;
__END__

=head1 NAME

Data::Lock - makes variables (im)?mutable