tools/performance/startup/gettime.pl
author reed@reedloden.com
Tue, 29 Jan 2008 07:58:38 -0800
changeset 10915 71ec64f4a1c9eebf208e2bf5c979801c8d80a888
parent 1 9b2a99adc05e53cd4010de512f50118594756650
child 98983 f4157e8c410708d76703f19e4dfb61859bfe32d8
permissions -rw-r--r--
Bug 66057 - "Proxy: $http_proxy should influence proxy settings" [p=roc@ocallahan.org (Robert O'Callahan [roc]) / diane@ghic.org (Diane Trout) / ventnor.bugzilla@yahoo.com.au (Michael Ventnor) r=josh r+sr=biesi a1.9=damons]

#!/usr/bin/perl
#
# Use high resolution routines if installed (on win32 or linux), using
# eval as try/catch block around import of modules. Otherwise, just use 'time()'.
#
# 'Win32::API'  <http://www.activestate.com/PPMPackages/zips/5xx-builds-only/Win32-API.zip>
# 'Time::HiRes' <http://search.cpan.org/search?dist=Time-HiRes> 
#   (also: http://rpmfind.net/linux/rpm2html/search.php?query=perl-Time-HiRes)
#
package Time::PossiblyHiRes;

use strict;

#use Time::HiRes qw(gettimeofday);

my $getLocalTime;                      # for win32
my $lpSystemTime = pack("SSSSSSSS");   # for win32
my $timesub;                           # code ref

# returns 12 char string "'s'x9.'m'x3" which is milliseconds since epoch, 
# although resolution may vary depending on OS and installed packages

sub getTime () {

    return &$timesub 
	if $timesub;

    $timesub = sub { time() . "000"; }; # default

    return &$timesub 
	if $^O eq "MacOS"; # don't know a better way on Mac

    if ($^O eq "MSWin32") {
	eval "use Win32::API;";
	$timesub = sub { 
	    # pass pointer to struct, void return 
	    $getLocalTime = 
		eval "new Win32::API('kernel32', 'GetLocalTime', [qw{P}], qw{V});"
		    unless $getLocalTime;
	    $getLocalTime->Call($lpSystemTime);
	    my @t = unpack("SSSSSSSS", $lpSystemTime);
	    sprintf("%9s%03s", time(), pop @t);
	} if !$@;
    } 

    # ass-u-me if not mac/win32, then we're on a unix flavour
    else {
	eval "use Time::HiRes qw(gettimeofday);";
	$timesub = sub { 
	    my @t = gettimeofday();
	    $t[0]*1000 + int($t[1]/1000);	    
	} if !$@;
    }

    return &$timesub;

} 

#
#
# Test script to compare with low-res time:
#
# require "gettime.pl";
#
# use POSIX qw(strftime);
#
# print "hires  time = " . Time::PossiblyHiRes::getTime() . "\n";
# print "lowres time = " . time()    . "\n";
#


# end package
1;