profile picture

Packing timeval

December 05, 2012 - programming time perl netbsd

Recently I got a lot of failures from CPAN Testers for RedisDB on NetBSD i386. After investigating a bit I've found that NetBSD 6.0 comes now with 64-bit time_t on all architectures. It means that the way I used to pack struct timeval value to set timeout on socket, didn't work anymore. Previously it was the same as long, long on all systems and pack looked like this:

my $timeval = pack "L!L!", $sec, $usec;

Now I had a special case for NetBSD there the first part is always 64 bit number. And pack on 32-bit perl doesn't even support "Q" unless is was compiled with 64-bit integers. So the simple construction turned into:

my $timeout;
if ( $Config{osname} eq 'netbsd' and $Config{osvers} >= 6.0 and $Config{longsize} == 4 ) {
    if ( defined $Config{use64bitint} ) {
        $timeout = pack( 'QL', $self->{timeout}, 0 );
    }
    else {
        $timeout = pack(
            'LLL',
            (
                $Config{byteorder} eq '1234'
                ? ( $self->{timeout}, 0, 0 )
                : ( 0, $self->{timeout}, 0 )
            )
        );
    }
}
else {
    $timeout = pack( 'L!L!', $self->{timeout}, 0 );
}

Solution involving XS looked much simpler and cleaner in this case:

use 5.010;
use strict;
use warnings;
use Inline C => DATA => AUTO_INCLUDE => '#include <sys/time.h>';
my $timeval = pack_timeval(2,0);
say length $timeval;
__DATA__
__C__
SV* pack_timeval(time_t tv_sec, long tv_usec) {
    struct timeval tv;
    tv.tv_sec = tv_sec;
    tv.tv_usec = tv_usec;
    return newSVpv((char *) &tv, sizeof(struct timeval));
}