File Coverage

blib/lib/Random/Simple.pm

Criterion	Covered	Total	%
statement	114	143	79.7
branch	22	44	50.0
condition	4	8	50.0
subroutine	19	21	90.4
pod	8	14	57.1
total	167	230	72.6

package Random::Simple;

use strict;
use warnings;
use Time::HiRes;
use Carp qw(croak);
use Config;
use v5.10; # For state

# https://pause.perl.org/pause/query?ACTION=pause_operating_model#3_5_factors_considering_in_the_indexing_phase
our $VERSION   = '0.28';
our $debug     = 0;
my $URANDOM_FH = undef;

# Check if the UV (unsigned value) Perl type is 64bit
my $has_64bit = ($Config{uvsize} == 8);

#############################################################

require XSLoader;
XSLoader::load();

# When this module is loaded (`use`) seed with random bytes from OS
seed_with_os_random();

use Exporter 'import';
our @EXPORT = qw(random_int random_bytes random_float random_elem shuffle_array rand srand);

#############################################################

# Throw away the first batch to warm up the PRNG, this is helpful
# if a poor seed (lots of zero bits) was chosen
sub warmup {
	my ($iter) = @_;

	for (my $i = 0; $i < $iter; $i++) {
		Random::Simple::_rand64(); # C API
	}
}

# Manually seed the PRNG (no warmup)
sub seed {
	my ($seed1, $seed2) = @_;

	$seed1 = int($seed1);
	$seed2 = int($seed2);

	if ($debug) {
		print "SEEDING MANUALLY ($seed1, $seed2)\n";
	}

	if ($seed1 == 0 && $seed2 == 0) {
		croak("Both seeds cannot be zero");
	}

	Random::Simple::_seed($seed1, $seed2); # C API
}

# Fetch random bytes from the OS supplied method
# /dev/urandom = Linux, Unix, FreeBSD, Mac, Android
# Windows requires the Win32::API call to call RtlGenRandom()
sub os_random_bytes {
	my $count  = shift();
	my $ret    = "";

	if ($count <= 0) {
		croak("$count is not a valid amount of bytes");
	}

	if ($^O eq 'MSWin32') {
		require Win32::API;

		state $rand = Win32::API->new(
			'advapi32',
			'INT SystemFunction036(PVOID RandomBuffer, ULONG RandomBufferLength)'
		) or croak("Could not import SystemFunction036: $^E");

		$ret = chr(0) x $count;
		$rand->Call($ret, $count) or croak("Could not read from csprng: $^E");
	} elsif (-r "/dev/urandom") {
		if (!$URANDOM_FH) {
			open($URANDOM_FH, '<:raw', '/dev/urandom') or croak("Couldn't open /dev/urandom: $!");
		}

		sysread($URANDOM_FH, $ret, $count) or croak("Couldn't read from csprng: $!");
	} else {
		croak("Unknown operating system $^O");
	};

	if (length($ret) != $count) {
		croak("Unable to read $count bytes from OS");
	}

	return $ret;
}

# Split a string into an array of smaller length strings
sub str_split {
    my ($string, $chunk_size) = @_;
	my $num_chunks = length($string) / $chunk_size;

    my @ret = ();
	for (my $i = 0; $i < $num_chunks; $i++) {
		my $str = substr($string, $i * $chunk_size, $chunk_size);
		push(@ret, $str);
	}

	return @ret;
}

# Binary to hex for human readability
sub bin2hex {
	my $bytes = shift();
	my $ret   = (unpack("h* ", $bytes));

	return $ret;
}

# Randomly seed the PRNG and warmup
sub seed_with_os_random {
	my ($high, $low, $seed1, $seed2);

	# PCG needs to be seeded with 2x 64bit unsigned integers
	# We fetch 16 bytes from the OS to create the two seeds
	# we need for proper seeding

	my $bytes = os_random_bytes(16);
	my @parts = str_split($bytes, 4);

	if (length($bytes) != 16) {
		my $size = length($bytes);
		die("Did not get enough entropy bytes from OS (got $size bytes)\n");
	}

	# Build the first 64bit seed from the random bytes
	# Cannot use Q because it doesn't exist on 32bit Perls
	$high  = unpack("L", $parts[0]);
	$low   = unpack("L", $parts[1]);
	$seed1 = ($high << 32) | $low;

	# Build the second 64bit seed
	$high  = unpack("L", $parts[2]);
	$low   = unpack("L", $parts[3]);
	$seed2 = ($high << 32) | $low;

	if ($debug) {
		print "RANDOM SEEDS: $seed1 / $seed2\n\n";
	}

	if ($seed1 == 0 && $seed2 == 0) {
		die("ERROR: Seeding from OS failed. Both zero? #91393\n");
	}

	# Seed the PRNG with the values we just created
	Random::Simple::_seed($seed1, $seed2); # C API

	warmup(32);
}

######################################################################
# Below are the public user callable methods
######################################################################

# Get a string of random bytes
sub random_bytes {
	my ($num) = @_;

	if ($num < 0) {
		croak("$num is not a valid amount of bytes");
	}

	my $octets_needed = $num / 4;

	my $ret = "";
	for (my $i = 0; $i < $octets_needed; $i++) {
		my $num = Random::Simple::_rand32(); # C API

		# Convert the integer into a 4 byte string
		$ret .= pack("L", $num);
	}

	$ret = substr($ret, 0, $num);

	return $ret;
}

# Get a random non-biased integer in a given range (inclusive)
# Note: "Lemire"    range must be no larger than 2^32 - 2 (best)
# Note: "Rejection" range must be no larger than 2^64 - 2
sub random_int {
	my ($min, $max) = @_;

	if ($max < $min) { die("Max can't be less than min"); }

	my $range = $max - $min + 1; # +1 makes it inclusive
	my $ret;

	# Anything bigger than 2^32 - 2
	if ($range > 4294967294) {
		$ret = _bounded_rand64_rejection($range);
	} else {
		$ret = _bounded_rand32_lemire($range);
	}

	$ret += $min;

	return $ret;
}

# Get a random float between 0 and 1 inclusive
sub random_float {
	my $ret = 0;

	if ($has_64bit) {
		my $num = Random::Simple::_rand64();
		$ret    = Random::Simple::_uint64_to_double($num, 1);
	} else {
		my $num = Random::Simple::_rand32();
		$ret    = Random::Simple::_uint32_to_float($num, 1);
	}

	return $ret;
}

# Pick a random element from an array
sub random_elem {
	my @arr = @_;

	if (!@arr) { return (); }

	my $elem_count = scalar(@arr) - 1;
	my $idx        = Random::Simple::random_int(0, $elem_count);
	my $ret        = $arr[$idx];

	return $ret;
}

# Use the Fisher-Yates algo to shuffle an array in a non-biased way
sub shuffle_array {
	my @array = @_;

	if (!@array) { return (); }

    my $i = @array;
    while ($i--) {
        my $j = Random::Simple::random_int(0, $i);
        @array[$i, $j] = @array[$j, $i];
    }

	return @array;
}

sub perl_rand64 {
	my $high = rand() * 4294967295;
	my $low  = rand() * 4294967295;

	my $ret = ($high << 32) | $low;

	return $ret;
}

# Our srand() overrides CORE::srand()
sub srand {
	my $seed = $_[0];

	# No seed passed in so we generate a good random one
	if (!$seed) {
		my $bytes = os_random_bytes(8);
		my @parts = str_split($bytes, 4);

		my $high = unpack("L", $parts[0]);
		my $low  = unpack("L", $parts[1]);

		$seed = ($high << 32) | $low;
	}

	# Seed has to be an integer
	$seed = int($seed);

	# Convert one seed into 2x 64bit seeds
	my $seed1 = _hash_mur3($seed);  # C API
	my $seed2 = _hash_mur3($seed1); # C API

	Random::Simple::seed($seed1, $seed2);

	return $seed;
}

# Our rand() overrides CORE::rand()
# This is slightly different than random_float because it returns
# a number where: 0 <= x < 1
#
# This prototype is required so we can emulate CORE::rand(@array)
sub rand(;$) {
	my ($mult) = @_;

	$mult ||= 1;
	my $ret;

	if ($has_64bit) {
		my $num = Random::Simple::_rand64();
		$ret    = Random::Simple::_uint64_to_double($num, 0);
	} else {
		my $num = Random::Simple::_rand32();
		$ret    = Random::Simple::_uint32_to_float($num, 0);
	}

	$ret *= $mult;

	return $ret;
}

#############################################################

=encoding utf8

=head1 NAME

Random::Simple - Generate good random numbers in a user consumable way.

=head1 SYNOPSIS

    use Random::Simple;

    my $coin_flip      = random_int(1, 2);
    my $die_roll       = random_int(1, 6);
    my $random_percent = random_float() * 100;
    my $buffer         = random_bytes(8);

    my @arr            = ('red', 'green', 'blue');
    my $rand_item      = random_elem(@arr);
    my @mixed          = shuffle_array(@arr);

=head1 DESCRIPTION

Perl's internal C function uses C which is an older
pseudorandom number generator and may have limitations. C uses
PCG which is: modern, simple, well vetted, and fast. Using C
will automatically upgrade/override the core C function to use a
better PRNG.

C is automatically seeded with entropy directly
from your OS. On Linux this is C and on Windows it uses
RtlGenRandom.

When you C we automatically upgrade C and C
to use a modern PRNG with better statistical properties. As a bonus you also
get a handful of other useful random related methods.

=head1 METHODS

=over 4

=item B

returns a non-biased integer between C<$min> and C<$max> (inclusive). Range must be no larger than 2**64 - 2.

=item B

returns a random floating point value between 0 and 1 (inclusive).

=item B

returns a string of random bytes with length of C<$number>.

=item B

returns a random element from C<@array>.

=item B

returns an array that has been randomized using the Fisher-Yates alorgithm.

=item B

emulates C using a better PRNG.

=item B

emulates C using a better PRNG.

=item B

Seed the PRNG with two unsigned 64bit integers for predictable and repeatable
random numbers. C will automatically seed itself from your
operating system's randomness if not manually seeded. Manual seeding should
only be used in specific cases where you need repeatable or testable
randomness.

=back

=head1 CAVEATS

PCG uses two 64bit unsigned integers for seeding. High quality seeds are needed
to generate good random numbers. C automatically generates high
quality seeds by reading random bytes from your operating system and converting
appropriately.

If you manually seed C, make sure you use good seeds that
are mostly non-zero. The larger the number the better seed it will make. A good
seed is a decimal number with 18 or 19 digits.

=head1 BUGS

Submit issues on Github: L

=head1 SEE ALSO

=over

=item *
L

=item *
L

=item *
L

=item *
L

=back

=head1 AUTHOR

Scott Baker - L

=cut

1;