File Coverage

blib/lib/Const/Fast.pm

Criterion	Covered	Total	%
statement	53	54	98.1
branch	21	26	80.7
condition	16	18	88.8
subroutine	10	10	100.0
pod	1	1	100.0
total	101	109	92.6

package Const::Fast;
{
  $Const::Fast::VERSION = '0.014';
}

use 5.008;
use strict;
use warnings FATAL => 'all';

use Scalar::Util qw/reftype blessed/;
use Carp qw/croak/;
use Sub::Exporter::Progressive 0.001007 -setup => { exports => [qw/const/], groups => { default => [qw/const/] } };

sub _dclone($) {
	require Storable;
	no warnings 'redefine';
	*_dclone = \&Storable::dclone;
	goto &Storable::dclone;
}

## no critic (RequireArgUnpacking, ProhibitAmpersandSigils)
# The use of $_[0] is deliberate and essential, to be able to use it as an lvalue and to keep the refcount down.

my %skip = map { $_ => 1 } qw/CODE GLOB/;

sub _make_readonly {
	my (undef, $dont_clone) = @_;
	if (my $reftype = reftype $_[0] and not blessed($_[0]) and not &Internals::SvREADONLY($_[0])) {
		$_[0] = _dclone($_[0]) if !$dont_clone && &Internals::SvREFCNT($_[0]) > 1 && !$skip{$reftype};
		&Internals::SvREADONLY($_[0], 1);
		if ($reftype eq 'SCALAR' || $reftype eq 'REF') {
			_make_readonly(${ $_[0] }, 1);
		}
		elsif ($reftype eq 'ARRAY') {
			_make_readonly($_) for @{ $_[0] };
		}
		elsif ($reftype eq 'HASH') {
			&Internals::hv_clear_placeholders($_[0]);
			_make_readonly($_) for values %{ $_[0] };
		}
	}
	Internals::SvREADONLY($_[0], 1);
	return;
}

## no critic (ProhibitSubroutinePrototypes, ManyArgs)
sub const(\[$@%]@) {
	my (undef, @args) = @_;
	croak 'Invalid first argument, need an reference' if not defined reftype($_[0]);
	croak 'Attempt to reassign a readonly variable' if &Internals::SvREADONLY($_[0]);
	if (reftype $_[0] eq 'SCALAR' or reftype $_[0] eq 'REF') {
		croak 'No value for readonly variable' if @args == 0;
		croak 'Too many arguments in readonly assignment' if @args > 1;
		${ $_[0] } = $args[0];
	}
	elsif (reftype $_[0] eq 'ARRAY') {
		@{ $_[0] } = @args;
	}
	elsif (reftype $_[0] eq 'HASH') {
		croak 'Odd number of elements in hash assignment' if @args % 2;
		%{ $_[0] } = @args;
	}
	else {
		croak 'Can\'t make variable readonly';
	}
	_make_readonly($_[0], 1);
	return;
}

1;    # End of Const::Fast

# ABSTRACT: Facility for creating read-only scalars, arrays, and hashes

__END__