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