tools/performance/startup/gettime.pl

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