From: [email-masked] (Tom Christiansen)
Date: 28 Nov 90 00:44:20 GMT
Newsgroups: comp.lang.perl

In article <[email-masked]> [email-masked] writes:
>Feature request:
>
>Is there a reason gettimeofday isn't in perl?  It exists in both BSD
>and SYSV, the PC can approximate it, although with less precision, and
>it's hard to do without a primitive (syscall is "hard").  I can't
>imagine how it could break existing scripts.  Just define
>gettimeofday() which returns ($tv_sec,$tv_usec).  Or make it really
>spiffy and have it return that in a list context, and
>$tv_sec+$tv_usec/1000000 in a scalar context.

"Spiffy" is one of the things some people (pas moi) don't like about perl.

I would say gettimeofday isn't there because it isn't on every system.
Yes, Tom, I hear you say, but what about socket?  Yes, there is that.
But socket has to work with internal datatypes that you can't mock
up very well just using syscall.  You say using syscall is hard, but
I would say having to know contextually dependent behavior is harder
still.

When I want better time than "time" gives me, and I'm trying to
be quick, I do this:

    # for milliseconds; otherwise would use built-in time.
    sub time {
	local($SYS_gettimeofday, $timeval, $timezone, $sec, $usec);

	$SYS_gettimeofday = 116;  # should really be from sys/syscalls.ph

	$timeval = $timezone = ("\0" x 4) x 2;

	syscall($SYS_gettimeofday, $timeval, $timezone)
	     && die "gettimeofday failed: $!";

	($sec, $usec) = unpack("L2", $timeval);
	return $sec +  $usec/1e6;
    }

But when I'm trying to be a little more careful, I do this:

    #!/usr/local/bin/perl

    require 'timeofday.pl';

    printf "It is now %f seconds past the epoch.\n", $now = &time;

    printf "We are in the %s timezone, ", $zone = &zone;

    printf "which is considered %s time.\n", &zonename($zone);

    printf "Merely %g seconds have passed since the program started.\n", 
	&time - $now;

where timeofday.pl is the following:

    #!/usr/local/bin/perl

    package main;

    require 'syscall.ph';
    $SYS_gettimeofday =  &'SYS_gettimeofday 
	unless defined $SYS_gettimeofday;

    package gettimeofday;

    $timeval_t = 'LL';
    $timezone_t = 'II';

    %zones_by_minute = (
	    0*60,      "WET", 
	    -1*60,     "MET",
	    -2*60,     "EET", 
	    -8*60,     "AWST", 
	    -10*60,    "AEST", 
	    -10*60+30, "ACST", 
	    4*60,      "AST", 
	    5*60,      "EST", 
	    6*60,      "CST", 
	    7*60,      "MST", 
	    8*60,      "PST", 
    );

    %zones_by_abbr = (
	    "WET", 		"Western European",
	    "MET", 		"Middle European",
	    "EET", 		"Eastern European",
	    "AWST", 	"Western Australian",
	    "AEST", 	"Eastern Australian",
	    "ACST", 	"Central Australian",
	    "AST", 		"Atlantic",
	    "EST", 		"Eastern",
	    "CST", 		"Central",
	    "MST", 		"Mountain",
	    "PST", 		"Pacific",
    );

    sub timeval {
	wantarray 
	    ? unpack($timeval_t, $_[0])
	    : pack($timeval_t, @_);
    } 

    sub timezone {
	wantarray 
	    ? unpack($timezone_t, $_[0])
	    : pack($timezone_t, @_);
    } 

    sub main'time {
	local($val, $zone) = &'gettimeofday;
	local($sec, $usec) = &timeval($val);
	$sec + $usec/1e6;
    } 

    sub main'zone {
	local($val, $zone) = &'gettimeofday;
	($mins, $dst) = &timezone($zone);

	defined $zones_by_minute{$mins} 
	    ? $zones_by_minute{$mins}
	    : $mins;
    } 

    sub main'zonename {
	$zones_by_abbr{$_[0]};
    } 

    sub main'gettimeofday {
	local($val, $zone);
	$val = &timeval;
	$zone = &timezone;

	syscall($'SYS_gettimeofday, $val, $zone) && do {
	    warn "gettimeofday: SYS_gettimeofday failed: $!";
	    ($val, $zone) = ();
	};

	($val, $zone);
    } 

There's some question whether I should export &timeval and &timezone
(which are protected, magic, bidirectional conversion functions), since I
am exporting &gettimeofday and it is returning packed data.  And of course
I'm doing nothing with the $dst flag, and my table is incomplete, and so
on and so forth.  But it's an idea.  I really don't like that I can't
duplicate ctime(3) output because I can't pin down the timezone without
having $TZ set.

--tom