File Coverage

blib/lib/Mock/Data/Plugin/Number.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	49	56	87.5
condition	31	42	73.8
subroutine	9	9	100.0
pod	6	7	85.7
total	157	176	89.2

package Mock::Data::Plugin::Number;
use Mock::Data::Plugin -exporter_setup => 1;
use Mock::Data::Util 'mock_data_subclass';
my @generators= qw( integer decimal float byte sequence uuid );
export(@generators);

# ABSTRACT: Mock::Data plugin that provides basic numeric generators
our $VERSION = '0.03'; # VERSION


sub apply_mockdata_plugin {
	my ($class, $mock)= @_;
	$mock->add_generators(
		map +("Number::$_" => $class->can($_)), @generators
	);
}

our $int_bits= 15;
++$int_bits while (1 << $int_bits) > 1  # old perls used to perform MOD 32 on the shift argument
	and $int_bits < 256; # prevent infinite loop in case of broken assumptions

our $float_bits= 22;
++$float_bits while 2**$float_bits != 2**$float_bits + 1
	and $float_bits < 256; # prevent infinite loop in case of broken assumptions


sub integer {
	my $mock= shift;
	my $params= ref $_[0] eq 'HASH'? shift : undef;
	my $size= shift;
	my $signed;
	if ($params) {
		$size //= $params->{digits} // $params->{size};
		$signed= !$params->{unsigned};
	}
	else { $signed= 1; }

	if (defined $size) {
		my $digits= 1 + int rand($size-1);
		my $val= 10**($digits-1) + int rand(9 * 10**($digits-1));
		return $signed && int rand 2? -$val : $val;
	} else {
		my $bits= ($params? $params->{bits} : undef) // 32;
		$bits= $int_bits if $bits > $int_bits; # can't generate more than $int_bits anyway
		$bits= int rand($signed? $bits : $bits+1);
		# calls to rand() only return 53 bits, because it is a double.  To get 64, need to
		# combine multiple rands.  Also, can't get 32 bits from rand on 32bit arch.
		my $val= $bits < $int_bits && $bits < $float_bits? int(rand(1<<$int_bits))
			: unpack('J', byte($mock, 8)) >> ($int_bits-$bits);
		return $signed && int rand 2? -$val : $val;
	}
}


sub decimal {
	my $mock= shift;
	my $params= ref $_ eq 'HASH'? shift : undef;
	my $size= shift // ($params? $params->{size} : undef) // 11;
	my $scale= 0;
	($size, $scale)= @$size if ref $size eq 'ARRAY';
	my $val= integer($mock, $size > $scale? $size : $scale-1);
	if ($scale) {
		if ($val < 0) {
			substr($val,1,0,'0'x($scale+2 - length $val))
				if length $val < $scale+2;
		} else {
			substr($val,0,0,'0'x($scale+1 - length $val))
				if length $val < $scale+1;
		}
		substr($val, -$scale, 0)= '.';
	}
	return $val;
}


sub float {
	my $mock= shift;
	my $params= ref $_[0] eq 'HASH'? shift : undef;
	my $size= shift // ($params? ($params->{digits} // $params->{size}) : undef);
	if (defined $size) {
		return decimal($mock, [$size, 1+int rand($size-1)]);
	}
	else {
		my $bits= shift // ($params? $params->{bits} : undef) // 23;
		$bits= $float_bits if $bits > $float_bits;
		# This algorithm chooses floating point numbers that don't lose precision when cast into
		# a float of the specified number of significant bits.
		my $sign= int rand 2? -1 : 1;
		my $exponent= 2 ** -int rand $bits;
		my $significand= int rand 2**$bits;
		return $sign * $exponent * $significand;
	}
}


sub byte {
	my ($mock, $count)= @_;
	return pack('C',rand(256))
		unless $count;
	my $buf= '';
	if (defined $count) {
		if ($int_bits > 32 && $float_bits > 32) {
			$buf .= pack('L', rand(1<<32))
				while length $buf < $count;
		}
		$buf .= pack('S', rand(1<<16))
			while length $buf < $count;
		substr($buf,$count)= '';
	}
	return $buf;
}


sub sequence {
	my $mock= shift;
	my $params= ref $_[0] eq 'HASH'? shift : undef;
	my $name= shift // ($params? $params->{sequence_name} : undef)
		// Carp::croak("sequence_name is required for sequence generator");
	return ++$mock->generator_state->{"Number::sequence"}{$name};
}


sub uuid {
	sprintf "%04x%04x-%04x-%04x-%04x-%04x%04x%04x",
		rand(1<<16), rand(1<<16), rand(1<<16),
		(4<<12)|rand(1<<12), (1<<15)|rand(1<<14),
		rand(1<<16), rand(1<<16), rand(1<<16)
}

1;

__END__