tools/performance/startup/gettime.pl

changeset 0
6474c204b198
     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;

mercurial