зеркало из https://github.com/mozilla/pjs.git
74 строки
1.8 KiB
Perl
74 строки
1.8 KiB
Perl
#!/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;
|