File Coverage

blib/lib/Linux/Perl/getrandom.pm

Criterion	Covered	Total	%
statement	22	26	84.6
branch	3	6	50.0
condition	0	3	0.0
subroutine	5	5	100.0
pod	0	1	0.0
total	30	41	73.1

package Linux::Perl::getrandom;

use strict;
use warnings;

=encoding utf-8

=head1 NAME

Linux::Perl::getrandom

=head1 SYNOPSIS

    my $numbytes = Linux::Perl::getrandom::x86_64->getrandom(
        buffer => \$buffer,
        flags => [ 'RANDOM', 'NONBLOCK' ],
    );

    # … or, platform-neutral:
    my $numbytes = Linux::Perl::getrandom->getrandom(
        buffer => \$buffer,
        flags => [ 'RANDOM', 'NONBLOCK' ],
    );

=head1 DESCRIPTION

This is an interface to Linux’s C system call. This system
call is documented only for kernel 3.17 and after; however, it appears
to be present in some earlier kernel versions.

=cut

use Linux::Perl;
use Linux::Perl::Pointer;

my %FLAG_VALUE = (
    NONBLOCK => 1,
    RANDOM => 2,
);

sub getrandom {
    my ($class, %opts) = @_;

    if (!$class->can('NR_getrandom')) {
        require Linux::Perl::ArchLoader;
        $class = Linux::Perl::ArchLoader::get_arch_module($class);
    }

    my $flags = 0;
    if ($opts{'flags'}) {
        for my $f ( @{ $opts{'flags'} } ) {
            $flags |= $FLAG_VALUE{$f} || do {
                die "Invalid flag: “$f”!";
            };
        }
    }

    if ('SCALAR' ne ref $opts{'buffer'}) {
        die "“buffer” must be a scalar reference, not “$opts{'buffer'}”!";
    }

    return Linux::Perl::call(
        $class->NR_getrandom(),
        Linux::Perl::Pointer::get_address( ${ $opts{'buffer'} } ),
        length( ${ $opts{'buffer'} } ),
        0 + $flags,
    );
}

1;