michael@0: #!/usr/bin/perl
michael@0: # This Source Code Form is subject to the terms of the Mozilla Public
michael@0: # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0: # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0: 
michael@0: #
michael@0: # Use high resolution routines if installed (on win32 or linux), using
michael@0: # eval as try/catch block around import of modules. Otherwise, just use 'time()'.
michael@0: #
michael@0: # 'Win32::API'  <http://www.activestate.com/PPMPackages/zips/5xx-builds-only/Win32-API.zip>
michael@0: # 'Time::HiRes' <http://search.cpan.org/search?dist=Time-HiRes> 
michael@0: #   (also: http://rpmfind.net/linux/rpm2html/search.php?query=perl-Time-HiRes)
michael@0: #
michael@0: package Time::PossiblyHiRes;
michael@0: 
michael@0: use strict;
michael@0: 
michael@0: #use Time::HiRes qw(gettimeofday);
michael@0: 
michael@0: my $getLocalTime;                      # for win32
michael@0: my $lpSystemTime = pack("SSSSSSSS");   # for win32
michael@0: my $timesub;                           # code ref
michael@0: 
michael@0: # returns 12 char string "'s'x9.'m'x3" which is milliseconds since epoch, 
michael@0: # although resolution may vary depending on OS and installed packages
michael@0: 
michael@0: sub getTime () {
michael@0: 
michael@0:     return &$timesub 
michael@0: 	if $timesub;
michael@0: 
michael@0:     $timesub = sub { time() . "000"; }; # default
michael@0: 
michael@0:     return &$timesub 
michael@0: 	if $^O eq "MacOS"; # don't know a better way on Mac
michael@0: 
michael@0:     if ($^O eq "MSWin32") {
michael@0: 	eval "use Win32::API;";
michael@0: 	$timesub = sub { 
michael@0: 	    # pass pointer to struct, void return 
michael@0: 	    $getLocalTime = 
michael@0: 		eval "new Win32::API('kernel32', 'GetLocalTime', [qw{P}], qw{V});"
michael@0: 		    unless $getLocalTime;
michael@0: 	    $getLocalTime->Call($lpSystemTime);
michael@0: 	    my @t = unpack("SSSSSSSS", $lpSystemTime);
michael@0: 	    sprintf("%9s%03s", time(), pop @t);
michael@0: 	} if !$@;
michael@0:     } 
michael@0: 
michael@0:     # ass-u-me if not mac/win32, then we're on a unix flavour
michael@0:     else {
michael@0: 	eval "use Time::HiRes qw(gettimeofday);";
michael@0: 	$timesub = sub { 
michael@0: 	    my @t = gettimeofday();
michael@0: 	    $t[0]*1000 + int($t[1]/1000);	    
michael@0: 	} if !$@;
michael@0:     }
michael@0: 
michael@0:     return &$timesub;
michael@0: 
michael@0: } 
michael@0: 
michael@0: #
michael@0: #
michael@0: # Test script to compare with low-res time:
michael@0: #
michael@0: # require "gettime.pl";
michael@0: #
michael@0: # use POSIX qw(strftime);
michael@0: #
michael@0: # print "hires  time = " . Time::PossiblyHiRes::getTime() . "\n";
michael@0: # print "lowres time = " . time()    . "\n";
michael@0: #
michael@0: 
michael@0: 
michael@0: # end package
michael@0: 1;