File Coverage

blib/lib/Data/Lock.pm
Criterion Covered Total %
statement 37 37 100.0
branch 18 18 100.0
condition 3 3 100.0
subroutine 9 9 100.0
pod n/a
total 67 67 100.0


line stmt bran cond sub pod time code
1             package Data::Lock;
2 6     6   26963 use 5.008001;
  6         35  
  6         229  
3 6     6   161 use warnings;
  6         11  
  6         435  
4 6     6   34 use strict;
  6         18  
  6         425  
5             our $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)/g;
6              
7 6     6   3803 use Attribute::Handlers;
  6         19144  
  6         35  
8 6     6   173 use Scalar::Util ();
  6         10  
  6         123  
9              
10 6     6   31 use base 'Exporter';
  6         11  
  6         861  
11             our @EXPORT_OK = qw/dlock dunlock/;
12              
13             #my @builtin_types =
14             # qw/SCALAR ARRAY HASH CODE REF GLOB LVALUE FORMAT IO VSTRING Regexp/;
15              
16             for my $locked ( 0, 1 ) {
17             my $subname = $locked ? 'dlock' : 'dunlock';
18 6     6   49 no strict 'refs';
  6         8  
  6         228  
19             *{$subname} = sub {
20 6     6   29 no warnings "uninitialized";
  6         13  
  6         1805  
21 48 100 100 48   25235 return if $_[1] and Internals::SvREADONLY( $_[0]) == $locked;
22 46         270 Internals::SvREADONLY( $_[0], $locked );
23 46 100       235 return unless my $type = Scalar::Util::reftype( $_[0] );
24 40 100       778 for (
    100          
    100          
25 14         61 $type eq 'ARRAY' ? @{ $_[0] }
  12         55  
26 13         82 : $type eq 'HASH' ? values %{ $_[0] }
27             : $type ne 'CODE' ? ${ $_[0] }
28             : ()
29             )
30             {
31 67 100       220 &$subname($_, 1) if ref $_;
32 67         182 Internals::SvREADONLY( $_, $locked );
33             }
34 14         44 $type eq 'ARRAY' ? Internals::SvREADONLY( @{ $_[0] }, $locked )
  12         49  
35 13         61 : $type eq 'HASH' ? Internals::SvREADONLY( %{ $_[0] }, $locked )
36 40 100       1109 : $type ne 'CODE' ? Internals::SvREADONLY( ${ $_[0] }, $locked )
    100          
    100          
37             : undef;
38             };
39             }
40              
41             1;
42             __END__