1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 1.2 +++ b/tools/performance/startup/gettime.pl Wed Dec 31 06:09:35 2014 +0100 1.3 @@ -0,0 +1,77 @@ 1.4 +#!/usr/bin/perl 1.5 +# This Source Code Form is subject to the terms of the Mozilla Public 1.6 +# License, v. 2.0. If a copy of the MPL was not distributed with this 1.7 +# file, You can obtain one at http://mozilla.org/MPL/2.0/. 1.8 + 1.9 +# 1.10 +# Use high resolution routines if installed (on win32 or linux), using 1.11 +# eval as try/catch block around import of modules. Otherwise, just use 'time()'. 1.12 +# 1.13 +# 'Win32::API' <http://www.activestate.com/PPMPackages/zips/5xx-builds-only/Win32-API.zip> 1.14 +# 'Time::HiRes' <http://search.cpan.org/search?dist=Time-HiRes> 1.15 +# (also: http://rpmfind.net/linux/rpm2html/search.php?query=perl-Time-HiRes) 1.16 +# 1.17 +package Time::PossiblyHiRes; 1.18 + 1.19 +use strict; 1.20 + 1.21 +#use Time::HiRes qw(gettimeofday); 1.22 + 1.23 +my $getLocalTime; # for win32 1.24 +my $lpSystemTime = pack("SSSSSSSS"); # for win32 1.25 +my $timesub; # code ref 1.26 + 1.27 +# returns 12 char string "'s'x9.'m'x3" which is milliseconds since epoch, 1.28 +# although resolution may vary depending on OS and installed packages 1.29 + 1.30 +sub getTime () { 1.31 + 1.32 + return &$timesub 1.33 + if $timesub; 1.34 + 1.35 + $timesub = sub { time() . "000"; }; # default 1.36 + 1.37 + return &$timesub 1.38 + if $^O eq "MacOS"; # don't know a better way on Mac 1.39 + 1.40 + if ($^O eq "MSWin32") { 1.41 + eval "use Win32::API;"; 1.42 + $timesub = sub { 1.43 + # pass pointer to struct, void return 1.44 + $getLocalTime = 1.45 + eval "new Win32::API('kernel32', 'GetLocalTime', [qw{P}], qw{V});" 1.46 + unless $getLocalTime; 1.47 + $getLocalTime->Call($lpSystemTime); 1.48 + my @t = unpack("SSSSSSSS", $lpSystemTime); 1.49 + sprintf("%9s%03s", time(), pop @t); 1.50 + } if !$@; 1.51 + } 1.52 + 1.53 + # ass-u-me if not mac/win32, then we're on a unix flavour 1.54 + else { 1.55 + eval "use Time::HiRes qw(gettimeofday);"; 1.56 + $timesub = sub { 1.57 + my @t = gettimeofday(); 1.58 + $t[0]*1000 + int($t[1]/1000); 1.59 + } if !$@; 1.60 + } 1.61 + 1.62 + return &$timesub; 1.63 + 1.64 +} 1.65 + 1.66 +# 1.67 +# 1.68 +# Test script to compare with low-res time: 1.69 +# 1.70 +# require "gettime.pl"; 1.71 +# 1.72 +# use POSIX qw(strftime); 1.73 +# 1.74 +# print "hires time = " . Time::PossiblyHiRes::getTime() . "\n"; 1.75 +# print "lowres time = " . time() . "\n"; 1.76 +# 1.77 + 1.78 + 1.79 +# end package 1.80 +1;