The Tor Browser / file comparison
comparison: tools/performance/startup/gettime.pl
tools/performance/startup/gettime.pl
- changeset 0
- 6474c204b198
equal
deleted
inserted
replaced
| -1:000000000000 | 0:bcaf6f90de1d |
|---|---|
| 1 #!/usr/bin/perl | |
| 2 # This Source Code Form is subject to the terms of the Mozilla Public | |
| 3 # License, v. 2.0. If a copy of the MPL was not distributed with this | |
| 4 # file, You can obtain one at http://mozilla.org/MPL/2.0/. | |
| 5 | |
| 6 # | |
| 7 # Use high resolution routines if installed (on win32 or linux), using | |
| 8 # eval as try/catch block around import of modules. Otherwise, just use 'time()'. | |
| 9 # | |
| 10 # 'Win32::API' <http://www.activestate.com/PPMPackages/zips/5xx-builds-only/Win32-API.zip> | |
| 11 # 'Time::HiRes' <http://search.cpan.org/search?dist=Time-HiRes> | |
| 12 # (also: http://rpmfind.net/linux/rpm2html/search.php?query=perl-Time-HiRes) | |
| 13 # | |
| 14 package Time::PossiblyHiRes; | |
| 15 | |
| 16 use strict; | |
| 17 | |
| 18 #use Time::HiRes qw(gettimeofday); | |
| 19 | |
| 20 my $getLocalTime; # for win32 | |
| 21 my $lpSystemTime = pack("SSSSSSSS"); # for win32 | |
| 22 my $timesub; # code ref | |
| 23 | |
| 24 # returns 12 char string "'s'x9.'m'x3" which is milliseconds since epoch, | |
| 25 # although resolution may vary depending on OS and installed packages | |
| 26 | |
| 27 sub getTime () { | |
| 28 | |
| 29 return &$timesub | |
| 30 if $timesub; | |
| 31 | |
| 32 $timesub = sub { time() . "000"; }; # default | |
| 33 | |
| 34 return &$timesub | |
| 35 if $^O eq "MacOS"; # don't know a better way on Mac | |
| 36 | |
| 37 if ($^O eq "MSWin32") { | |
| 38 eval "use Win32::API;"; | |
| 39 $timesub = sub { | |
| 40 # pass pointer to struct, void return | |
| 41 $getLocalTime = | |
| 42 eval "new Win32::API('kernel32', 'GetLocalTime', [qw{P}], qw{V});" | |
| 43 unless $getLocalTime; | |
| 44 $getLocalTime->Call($lpSystemTime); | |
| 45 my @t = unpack("SSSSSSSS", $lpSystemTime); | |
| 46 sprintf("%9s%03s", time(), pop @t); | |
| 47 } if !$@; | |
| 48 } | |
| 49 | |
| 50 # ass-u-me if not mac/win32, then we're on a unix flavour | |
| 51 else { | |
| 52 eval "use Time::HiRes qw(gettimeofday);"; | |
| 53 $timesub = sub { | |
| 54 my @t = gettimeofday(); | |
| 55 $t[0]*1000 + int($t[1]/1000); | |
| 56 } if !$@; | |
| 57 } | |
| 58 | |
| 59 return &$timesub; | |
| 60 | |
| 61 } | |
| 62 | |
| 63 # | |
| 64 # | |
| 65 # Test script to compare with low-res time: | |
| 66 # | |
| 67 # require "gettime.pl"; | |
| 68 # | |
| 69 # use POSIX qw(strftime); | |
| 70 # | |
| 71 # print "hires time = " . Time::PossiblyHiRes::getTime() . "\n"; | |
| 72 # print "lowres time = " . time() . "\n"; | |
| 73 # | |
| 74 | |
| 75 | |
| 76 # end package | |
| 77 1; |
