From blair at orcaware.com Thu Dec 1 21:14:05 2005 From: blair at orcaware.com (blair at orcaware.com) Date: Thu, 1 Dec 2005 21:14:05 -0800 Subject: [Orca-checkins] r516 - in orca/trunk: . packages/Time-HiRes-1.73 packages/Time-HiRes-1.83 packages/Time-HiRes-1.83/fallback packages/Time-HiRes-1.83/t Message-ID: <200512020514.jB25E5gf017651@orca3.orcaware.com> Author: blair at orcaware.com Date: Thu Dec 1 21:13:32 2005 New Revision: 516 Added: orca/trunk/packages/Time-HiRes-1.83/ - copied from r515, /orca/trunk/packages/Time-HiRes-1.73/ Removed: orca/trunk/packages/Time-HiRes-1.73/ Modified: orca/trunk/configure.in orca/trunk/packages/Time-HiRes-1.83/Changes orca/trunk/packages/Time-HiRes-1.83/HiRes.pm orca/trunk/packages/Time-HiRes-1.83/HiRes.xs orca/trunk/packages/Time-HiRes-1.83/META.yml orca/trunk/packages/Time-HiRes-1.83/Makefile.PL orca/trunk/packages/Time-HiRes-1.83/fallback/const-c.inc orca/trunk/packages/Time-HiRes-1.83/fallback/const-xs.inc orca/trunk/packages/Time-HiRes-1.83/t/HiRes.t Log: Upgrade Time::HiRes from 1.73 to 1.83. * configure.in: Bump Time::HiRes's version number to 1.83. * packages/Time-HiRes-1.83: Renamed from packages/Time-HiRes-1.73. Directory contents updated from Time-HiRes-1.83.tar.gz. Modified: orca/trunk/configure.in ============================================================================== --- orca/trunk/configure.in (original) +++ orca/trunk/configure.in Thu Dec 1 21:13:32 2005 @@ -39,8 +39,8 @@ RRDTOOL_VER=1.000503 STORABLE_DIR=Storable-2.15 STORABLE_VER=2.15 -TIME_HIRES_DIR=Time-HiRes-1.73 -TIME_HIRES_VER=1.73 +TIME_HIRES_DIR=Time-HiRes-1.83 +TIME_HIRES_VER=1.83 AC_SUBST(DATA_DUMPER_DIR) AC_SUBST(DATE_PARSE_DIR) Modified: orca/trunk/packages/Time-HiRes-1.83/Changes ============================================================================== --- /orca/trunk/packages/Time-HiRes-1.73/Changes (original) +++ orca/trunk/packages/Time-HiRes-1.83/Changes Thu Dec 1 21:13:32 2005 @@ -1,23 +1,119 @@ Revision history for Perl extension Time::HiRes. -1.73 - Time::HiRes::nanosleep support for Solaris [PATCH] +1.83 [2005-11-19] + - has_symbol() was wrong since e.g. ITIMER_VIRTUAL is exported + via @EXPORT_OK even when it is not available. This is heinous. + @EXPORT_OK should be determined at Makefile.PL time. + - be more lenient is testing clock_gettime(): allow more slop, + and retry up to three times, sleeping a random nap between + the retries + - human months are one-based (noticed by Anton Berezin) + +1.82 [2005-10-06] + - CLOCK_REALTIME is an enum value (of the clockid_t enum) + in HP-UX (and might be so elsewhere, too), debugged by + H. Merijn Brand + - include const-c.inc as late as possible (from Randy Kobes, + [rt.cpan.org #15552] to avoid undefined usleep() on Win32 + +1.81 [2005-11-05] + - try to be more robust and consistent in the detection of + CLOCK_REALTIME and ITIMER_VIRTUAL in HiRes.t: the proper + way is + + sub has_symbol { + my $symbol = shift; + eval 'import Time::HiRes qw($symbol)'; + return 0 unless $@ eq ''; + return exists ${"Time::HiRes::$symbol"}; + } + + and then use + + &FOO_BAR + + in the test. All these moves are needed because + + 1) one cannot directly do eval 'Time::HiRes::FOO_BAR' + because FOO_BAR might have a true value of zero + (or in the general case an empty string or even undef) + + 2) In case FOO_BAR is not available in this platform, + &FOO_BAR avoids the bareword warning + + - wait more (1.5 seconds instead of 0.1) for the CLOCK_REALTIME test + but expect the 'customary' slop of 0.20 instead of 0.25 + - fixed inside a comment HAS_POLL -> TIME_HIRES_NANOSLEEP + - at the end of HiRest.t tell how close we were to termination + +1.80 [2005-11-04] + - Gisle noticed a mistake (using HAS_NANOSLEEP) in 1.79 + +1.79 [2005-11-03] + - try nanosleep for emulating usleep -- may help in some weird + embedded realtime places which have nanosleep but neither usleep + nor select nor poll (doesn't have to be weird embedded realtime + place, though -- in many places usleep is nanosleep anyway) + - try poll for emulating usleep -- this may help some obscure/old + SVR4 places that have neither usleep nor select + - a redundant test guard in HiRes.t + +1.78 [2005-11-03] + - ITIMER_VIRTUAL detection in HiRes.t had problems (that we cannot + in the general case fail already at 'use' phase is suboptimal) + - fixes to the documentation of clock_gettime() and clock_getres() + +1.77 [2005-11-03] + - add support for the POSIX clock_gettime() and clock_getres(), + if available, either as library calls or as syscalls + - be more defensive about missing functionality: break out + early (during 'use') if no e.g. clock_getres() is available, + and protect our back by trapping those cases also in HiRes.xs + - the test added in 1.76 could cause an endless loop e.g. in Solaris, + due to mixing of sleep() and alarm() (bad programmer, no cookie!) + +1.76 [2005-10-22] + - testing for nanosleep had wrong logic which caused nanosleep + to become undefined for e.g. Mac OS X + - added a test for a core dump that was introduced by Perl 5.8.0 + safe signals and was fixed for the time of 5.8.1 (one report of + the core dump was [perl #20920]), the test skipped pre-5.8.1. + - *cough* s/unanosleep/nanosleep/g; *cough* + +1.75 [2005-10-18] + - installation patch from Gisle Aas: in Perls 5.8.x and later + use MakeMaker INSTALLDIRS value of 'perl' instead of 'site'. + +1.74 [2005-09-19] + - [cpan #14608] Solaris 8 perl 5.005_03 File::Spec module does not have method rel2abs + (the workaround is not to use rel2abs, should not be necessary) + - [cpan #14642] U2time wrongly exported on the C API + (patch supplied by the reporter, SALVA at cpan.org) + - add release dates to Changes + +1.73 [2005-08-16] + - Time::HiRes::nanosleep support for Solaris [PATCH] (POSIX::uname() not available if building with core perl, from Gisle Aas, via perl5-porters, perl change #25295) -1.72 - going back to the 1.68 loader setup (using DynaLoader) +1.72 [2005-07-01] + - going back to the 1.68 loader setup (using DynaLoader) since too many weird things starting breaking - fix a typo in Jos? Auguste-Etienne's name -1.71 - a thinko in the nanosleep() detection +1.71 [2005-06-28] + - a thinko in the nanosleep() detection - move more changes stuff from the README to Changes - add -w to the Makefile.PL -1.70 - oops in 1.69 about @ISA (not affecting anything but silly) +1.70 [2005-06-26] + - oops in 1.69 about @ISA (not affecting anything but silly) - add copyright 2005 to HiRes.pm - add copyright and license to HiRes.xs - add copyrights 2003, 2004, 2005 to README -1.69 - actually run a test for nanosleep +1.69 [2005-06-25] + - actually run a test for nanosleep (if there is no $Config{d_nanosleep}) since e.g. in AIX 4.2 it seems that one can link in nanosleep() but then calling it fails instantly and sets errno to ENOSYS (Not implemented). @@ -35,7 +131,7 @@ (from Alexey Tourbin) - add SEE ALSO (BSD::Resource and Time::TAI64) -1.68 +1.68 [2005-05-14] - somehow 1.67 had a lot of doubled lines (a major cut-and-paste error suspected), but miraculously it still worked since the doubling took place below the __END__ token @@ -44,20 +140,22 @@ (part of perl change #24271) - minor doc tweaks -1.67 +1.67 [2005-05-04] - (internal) don't ignore the return value of gettimeofday() - (external) return undef or an empty if the C gettimeofday() fails (affects Time::HiRes gettimeofday() and the hires time()) -1.66 +1.66 [2004-12-19] - add nanosleep() - fix the 'hierachy' typo in Makefile.PL [rt.cpan.org #8492] - should now build in Solaris [rt.cpan.org #7165] (since 1.64) - should now build in Cygwin [rt.cpan.org #7535] (since 1.64) - - close also [rt.cpan.org #5933] "Time::HiRes::time does not pick up time adjustments like ntp" since ever reproducing it in the same environment + - close also [rt.cpan.org #5933] "Time::HiRes::time does not + pick up time adjustments like ntp" since ever reproducing it + (and therefore verifying a possible fix) in the same environment has become rather unlikely -1.65 +1.65 [2004-09-18] - one should not mix u?alarm and sleep (the tests modified by 1.65, #12 and #13, hung in Solaris), now we just busy loop executing an empty block @@ -65,7 +163,7 @@ sleeps and alarms - small spelling fixes -1.64 +1.64 [2004-09-16] - regenerate ppport.h with Devel::PPPort 3.03, now the MY_CXT_CLONE is defined in ppport.h, we no more need to do that. @@ -75,11 +173,11 @@ changed to sleep(1)s, the tests still pass but no hang after a few hundred repeats. -1.63 +1.63 [2004-09-01] - Win32 and any ithread build: ppport.h didn't define MY_CXT_CLONE, which seems to be a Time-HiResism. -1.62 +1.62 [2004-08-31] - Skip testing if under PERL_CORE and Time::HiRes has not been Configured (from Marcus Holland-Moritz, core change #23246) @@ -91,13 +189,13 @@ - Can't use newSVpvf for <= 5.003. (most of the changes from Marcus) -1.61 +1.61 [2004-08-21] - Win32: reset reading from the performance counters every five minutes to better track wall clock time (thanks to PC timers being often quite bad), should help long-running programs. -1.60 +1.60 [2004-08-15] - Win32: Patch from Steve Hay [PATCH] Re: [perl #30755] [Win32] Different results from Time::HiRes::gettimeofdayunder the debugger to [perl #30755] reported by Nigel Sandever @@ -110,50 +208,50 @@ after that keep using -lrt, patch from Alan Burlison, bug reported in [cpan #7165] -1.59 +1.59 [2004-04-08] - Change the Win32 recalibration limit to 0.5 seconds and tweak the documentation to blather less about the gory details of the Win32 implementation and more about the complications in general of meddling with the system clock. -1.58 +1.58 [2004-04-08] - Document the 1.57 change better. -1.57 +1.57 [2004-07-04] - Win32/Cygwin/MinGW: if the performance counter drifts by more than two seconds from the system clock (due to ntp adjustments, for example), recalibrate our internal counter: from Jan Dubois, based on [cpan #5933] by Jerry D. Hedden. -1.56 +1.56 [2004-29-02] - Give a clearer message if the tests timeout (perl change #22253) - Don't use /tmp or its moral equivalents (perl bug #15036, perl change #22258) -1.55 +1.55 [2004-01-14] - Windows: mingw32 patch from Mike Pomraning (use Perl's Const64() instead of VC-specific i64 suffix) -1.54 +1.54 [2003-12-31] - Solaris: like Tru64 (dec_osf) also Solaris need -lrt for nanosleep -1.53 +1.53 [2003-12-30] - Windows: higher resolution time() by using the Windows performance counter API, from Jan Dubois and Anton Shcherbinin. The exact new higher resolution depends on the hardware, but it should be quite a bit better than using the basic Windows timers. -1.52 +1.52 [2003-10-28] - In AIX (v?) with perl 5.6.1 the HiRes.t can hang after the subtest 18. No known analysis nor fix, but added an alarm (that requires fork() and alarm()) to the test. -1.51 +1.51 [2003-09-22] - doc tweaks from mjd (perl change #20456) - NCR MP-RAS hints file added (svr4.pl) (perl change #21249) -1.50 +1.50 [2003-08-02] - add a message (for non-core builds) to Makefile.PL about the LC_ALL=C workaround - &Time::HiRes::d_nanosleep was broken (perl change #20131) @@ -163,47 +261,47 @@ - MPE/iX tweak (perl change #20042) - do not use HAS_NANOSLEEP (perl change #19898) -1.49 +1.49 [2003-06-23] - UVuf for non-IVSIZE platforms (from Keiichiro Nagano) - OS/2 can always mix subsecond sleeps with signals (part of perl change #19789) -1.48 +1.48 [2003-06-04] - workaround for buggy gcc 2.95.3 in openbsd/sparc64 (perl change #19592) -1.47 +1.47 [2003-05-03] - do not use -lrt in Linux (from March Lehmann, perl change #19449) - unnecessary (nanosleep is in libc anyway) - harmful (-lrt slows down execution) - incompatible (with many distributions' pthreads) -1.46 +1.46 [2003-04-25] - do not create files in blib directories under core (perl change #19160, from rgs) - detypo s/VTLARM/VTARLM/ (perl change #19328, from mjd) -1.45 +1.45 [2003-04-01] - guarantee that $xdefine in HiRes.t is always defined (perl change #19109, from IlyaZ) - a cleaner way to detect PERL_CORE (perl change #19111, from IlyaZ) -1.44 +1.44 [2003-03-30] - add hints/irix.pl to turn off overly POSIX flags that cause hide struct timespec to be hidden (and compilation to fail) (bleadperl change #19085) - documentation tweaks -1.43 +1.43 [2003-03-11] - add c:/temp to the list of temp directories to probe so that cygwin (and win*?) builds are happy. This was needed at least in my cygwin 1.3.20/w2k setup. -1.42 +1.42 [2003-01-07] - modernize the constants code (from Nicholas Clark) -1.41 +1.41 [2003-01-03] - At some point the ability to figure our the correct incdir for EXTERN.h (either a core perl build, or an installed perl) had broken (which lead into all test compiles failing with @@ -213,7 +311,7 @@ Now stole a trick from the Encode that sets $ENV{PERL_CORE} right, and both styles of build should work again. -1.40 +1.40 [2003-01-03] - Nicholas Clark noticed that the my_catdir() emulation function was broken (which means that we didn't really work for Perls 5.002 and 5.003) @@ -221,16 +319,16 @@ and strict clean - tightened up the Makefile.PL output, less whitespace -1.39 +1.39 [2003-10-20] - fix from Craig Berry for better building in VMS with PERL_CORE -1.38 +1.38 [2003-10-13] - no functional changes - move lib/Time/HiRes.pm as Hires.pm - libraries scanning was slightly broken (always scanned for a library even when $Config{libs} already had it) -1.37 +1.37 [2003-09-23] - Ray Zimmerman ran into a race condition in Mac OS X. A 0.01-second alarm fired before the test expected. The test first slept indefinitely (blocking for signals) @@ -241,7 +339,7 @@ environment variable VERBOSE to a true value to see the details (the probing command and the possible errors) -1.36 +1.36 [2003-09-12] - do not clear MAN3PODS in Makefile.PL (Radoslaw Zielinski) - INSTALLDIRS => 'perl' missing which means that Time::HiRes cannot be upgraded from CPAN to override the 5.8.0 version @@ -251,19 +349,19 @@ if $ENV{PERL_CORE} (Hugo van der Sanden) - add documentation about the restart of select() under alarm() -1.35 +1.35 [2003-08-24] - small documentation tweaks -1.34 +1.34 [2003-08-22] - better VMS operation (Craig Berry) -1.33 +1.33 [2003-08-20] - our time machine is accelerating: now works with Perl 5.004_01 (tried with 5.003_07 and 5.002 but I get segmentation faults from running the Makefile.PL with those in Tru64 4.0D) -1.32 +1.32 [2003-08-20] - backward compatibility (pre-5.6.0) tweaks: - no XSLoader in 5.00503, use DynaLoader instead - no SvPV_nolen, either @@ -278,7 +376,7 @@ (since older Perl do not have them in %Config, and even 5.8.0 does not probe for nanosleep) -1.31 +1.31 [2003-08-19] - backward compatibility (pre-5.6.1) tweaks: - define NV if no NVTYPE - define IVdf if needed (note: the Devel::PPPort @@ -291,7 +389,7 @@ back to Perl 5.00404), and using nanosleep() (if available) for subsecond sleeps. -1.30 +1.30 [2003-08-16] - release 1.29_02 as 1.30 @@ -303,18 +401,18 @@ version. Note also that in 1.30 Wegscheid turns over the maintenance to Jarkko Hietaniemi. -1.29_02 +1.29_02 [2003-08-16] - fix a silly unclosed comment typo in HiRes.xs - document and export REALTIME_REALPROF (Solaris) -1.29_01 +1.29_01 [2003-08-16] - only getitimer(ITIMER_REAL) available in Cygwin and Win32 (need to patch this also in Perl 5.[89]) - remove CVS revision log from HiRes.xs -1.29_00 +1.29_00 [2003-08-14] The following numbered patches refer to the Perl 5.7 changes, you can browse them at http://public.activestate.com/cgi-bin/perlbrowse Modified: orca/trunk/packages/Time-HiRes-1.83/HiRes.pm ============================================================================== --- /orca/trunk/packages/Time-HiRes-1.73/HiRes.pm (original) +++ orca/trunk/packages/Time-HiRes-1.83/HiRes.pm Thu Dec 1 21:13:32 2005 @@ -10,20 +10,24 @@ @EXPORT = qw( ); @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval - getitimer setitimer nanosleep + getitimer setitimer nanosleep clock_gettime clock_getres + CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID + CLOCK_REALTIME CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer - d_nanosleep); + d_nanosleep d_clock_gettime d_clock_getres); -$VERSION = '1.73'; +$VERSION = '1.83'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; sub AUTOLOAD { my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; + # print "AUTOLOAD: constname = $constname ($AUTOLOAD)\n"; die "&Time::HiRes::constant not defined" if $constname eq 'constant'; my ($error, $val) = constant($constname); + # print "AUTOLOAD: error = $error, val = $val\n"; if ($error) { my (undef,$file,$line) = caller; die "$error at $file line $line.\n"; @@ -35,6 +39,21 @@ goto &$AUTOLOAD; } +sub import { + my $this = shift; + for my $i (@_) { + if (($i eq 'clock_getres' && !&d_clock_getres) || + ($i eq 'clock_gettime' && !&d_clock_gettime) || + ($i eq 'nanosleep' && !&d_nanosleep) || + ($i eq 'usleep' && !&d_usleep) || + ($i eq 'ualarm' && !&d_ualarm)) { + require Carp; + Carp::croak("Time::HiRes::$i(): unimplemented in this platform"); + } + } + Time::HiRes->export_to_level(1, $this, @_); +} + bootstrap Time::HiRes; # Preloaded methods go here. @@ -57,7 +76,8 @@ =head1 SYNOPSIS - use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep ); + use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep + clock_gettime clock_getres ); usleep ($microseconds); nanosleep ($nanoseconds); @@ -85,6 +105,9 @@ setitimer ($which, $floating_seconds, $floating_interval ); getitimer ($which); + $realtime = clock_gettime(CLOCK_REALTIME); + $resolution = clock_getres(CLOCK_REALTIME); + =head1 DESCRIPTION The C module implements a Perl interface to the @@ -97,10 +120,10 @@ If your system lacks C or an emulation of it you don't get C or the one-argument form of C. -If your system lacks all of C, C, and -C, you don't get C, -C, or C. If your -system lacks both C and C you don't get +If your system lacks all of C, C, +C, and C, you don't get C, +C, or C. +If your system lacks both C and C you don't get C or C. If you try to import an unimplemented function in the C statement @@ -174,7 +197,8 @@ or more than the core C, depending on whether your platform rounds the higher resolution timer values up, down, or to the nearest second to get the core C, but naturally the difference should be never -more than half a second. +more than half a second. See also L, if available +in your system. B: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT, when the C seconds since epoch rolled over to 1_000_000_000, the @@ -267,6 +291,27 @@ In list context, both the remaining time and the interval are returned. The interval is always what you put in using C. +=item clock_gettime ( $which ) + +Return as seconds the current value of the POSIX high resolution timer +specified by C<$which>. All implementations that support POSIX high +resolution timers are supposed to support at least the C<$which> value +of C, which is supposed to return results close to the +results of C, or the number of seconds since 00:00:00:00 +January 1, 1970 Greenwich Mean Time (GMT). Do not assume that +CLOCK_REALTIME is zero, it might be one, or something else. +Another potentially useful (but not available everywhere) value is +C, which guarantees a monotonically increasing time +value (unlike time(), which can be adjusted). See your system +documentation for other possibly supported values. + +=item clock_getres ( $which ) + +Return as seconds the resolution of the POSIX high resolution timer +specified by C<$which>. All implementations that support POSIX high +resolution timers are supposed to support at least the C<$which> value +of C, see L. + =back =head1 EXAMPLES @@ -274,13 +319,13 @@ use Time::HiRes qw(usleep ualarm gettimeofday tv_interval); $microseconds = 750_000; - usleep $microseconds; + usleep($microseconds); # signal alarm in 2.5s & every .1s thereafter - ualarm 2_500_000, 100_000; + ualarm(2_500_000, 100_000); # get seconds and microseconds since the epoch - ($s, $usec) = gettimeofday; + ($s, $usec) = gettimeofday(); # measure elapsed time # (could also do by subtracting 2 gettimeofday return values) @@ -315,6 +360,12 @@ $SIG{VTALRM} = sub { print time, "\n" }; setitimer(ITIMER_VIRTUAL, 10, 2.5); + use Time::HiRes qw( clock_gettime clock_getres CLOCK_REALTIME ); + # Read the POSIX high resolution timer. + my $high = clock_getres(CLOCK_REALTIME); + # But how accurate we can be, really? + my $reso = clock_getres(CLOCK_REALTIME); + =head1 C API In addition to the perl API described above, a C API is available for @@ -324,7 +375,7 @@ name C prototype --------------- ---------------------- Time::NVtime double (*)() - Time::U2time void (*)(UV ret[2]) + Time::U2time void (*)(pTHX_ UV ret[2]) Both functions return equivalent information (like C) but with different representations. The names C and C @@ -365,10 +416,15 @@ platforms like Cygwin and MinGW) the Time::HiRes::time() may temporarily drift off from the system clock (and the original time()) by up to 0.5 seconds. Time::HiRes will notice this eventually and recalibrate. +Note that since Time::HiRes 1.77 the clock_gettime(CLOCK_MONOTONIC) +might help in this (in case your system supports CLOCK_MONOTONIC). =head1 SEE ALSO -L, L. +Perl modules L, L. + +Your system documentation for C, C, +C, C, C, C. =head1 AUTHORS Modified: orca/trunk/packages/Time-HiRes-1.83/HiRes.xs ============================================================================== --- /orca/trunk/packages/Time-HiRes-1.73/HiRes.xs (original) +++ orca/trunk/packages/Time-HiRes-1.83/HiRes.xs Thu Dec 1 21:13:32 2005 @@ -30,6 +30,9 @@ # include # endif #endif +#if defined(TIME_HIRES_CLOCK_GETTIME_SYSCALL) || defined(TIME_HIRES_CLOCK_GETRES_SYSCALL) +#include +#endif #ifdef __cplusplus } #endif @@ -62,7 +65,17 @@ # endif #endif -#include "const-c.inc" +#if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) + +/* HP-UX has CLOCK_XXX values but as enums, not as defines. + * The only way to detect these would be to test compile for each. */ +# ifdef __hpux +# define CLOCK_REALTIME CLOCK_REALTIME +# define CLOCK_VIRTUAL CLOCK_VIRTUAL +# define CLOCK_PROFILE CLOCK_PROFILE +# endif /* # ifdef __hpux */ + +#endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) */ #if defined(WIN32) || defined(CYGWIN_WITH_W32API) @@ -358,14 +371,16 @@ /* Do not use H A S _ N A N O S L E E P - * so that Perl Configure doesn't scan for it. + * so that Perl Configure doesn't scan for it (and pull in -lrt and + * the like which are not usually good ideas for the default Perl). + * (We are part of the core perl now.) * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */ #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) #define HAS_USLEEP -#define usleep hrt_unanosleep /* could conflict with ncurses for static build */ +#define usleep hrt_nanosleep /* could conflict with ncurses for static build */ void -hrt_unanosleep(unsigned long usec) /* This is used to emulate usleep. */ +hrt_nanosleep(unsigned long usec) /* This is used to emulate usleep. */ { struct timespec res; res.tv_sec = usec/1000/1000; @@ -405,6 +420,33 @@ } #endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */ +#if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) +#define HAS_USLEEP +#define usleep hrt_usleep /* could conflict with ncurses for static build */ + +void +hrt_usleep(unsigned long usec) +{ + struct timespec tsa; + tsa.tv_sec = usec * 1000; /* Ignoring wraparound. */ + tsa.tv_nsec = 0; + nanosleep(&tsa, NULL); +} + +#endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */ + +#if !defined(HAS_USLEEP) && defined(HAS_POLL) +#define HAS_USLEEP +#define usleep hrt_usleep /* could conflict with ncurses for static build */ + +void +hrt_usleep(unsigned long usec) +{ + int msec = usec / 1000; + poll(0, 0, msec); +} + +#endif /* #if !defined(HAS_USLEEP) && defined(HAS_POLL) */ #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) #define HAS_UALARM @@ -646,6 +688,8 @@ #endif /* #ifdef HAS_GETTIMEOFDAY */ +#include "const-c.inc" + MODULE = Time::HiRes PACKAGE = Time::HiRes PROTOTYPES: ENABLE @@ -658,10 +702,8 @@ #ifdef ATLEASTFIVEOHOHFIVE #ifdef HAS_GETTIMEOFDAY { - UV auv[2]; hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0); - if (myU2time(aTHX_ auv) == 0) - hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) auv[0]), 0); + hv_store(PL_modglobal, "Time::U2time", 12, newSViv(PTR2IV(myU2time)), 0); } #endif #endif @@ -741,6 +783,15 @@ OUTPUT: RETVAL +#else /* #if defined(TIME_HIRES_NANOSLEEP) */ + +NV +nanosleep(nseconds) + NV nseconds + CODE: + croak("Time::HiRes::nanosleep(): unimplemented in this platform"); + RETVAL = 0.0; + #endif /* #if defined(TIME_HIRES_NANOSLEEP) */ NV @@ -780,6 +831,15 @@ OUTPUT: RETVAL +#else /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ + +NV +usleep(useconds) + NV useconds + CODE: + croak("Time::HiRes::usleep(): unimplemented in this platform"); + RETVAL = 0.0; + #endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ #ifdef HAS_UALARM @@ -809,6 +869,24 @@ OUTPUT: RETVAL +#else + +int +ualarm(useconds,interval=0) + int useconds + int interval + CODE: + croak("Time::HiRes::ualarm(): unimplemented in this platform"); + RETVAL = -1; + +NV +alarm(seconds,interval=0) + NV seconds + NV interval + CODE: + croak("Time::HiRes::alarm(): unimplemented in this platform"); + RETVAL = 0.0; + #endif /* #ifdef HAS_UALARM */ #ifdef HAS_GETTIMEOFDAY @@ -936,4 +1014,63 @@ #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */ +#if defined(TIME_HIRES_CLOCK_GETTIME) + +NV +clock_gettime(clock_id = CLOCK_REALTIME) + int clock_id + PREINIT: + struct timespec ts; + int status = -1; + CODE: +#ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL + status = syscall(SYS_clock_gettime, clock_id, &ts); +#else + status = clock_gettime(clock_id, &ts); +#endif + RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1; + + OUTPUT: + RETVAL + +#else /* if defined(TIME_HIRES_CLOCK_GETTIME) */ + +NV +clock_gettime(clock_id = 0) + int clock_id + CODE: + croak("Time::HiRes::clock_gettime(): unimplemented in this platform"); + RETVAL = 0.0; + +#endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) */ + +#if defined(TIME_HIRES_CLOCK_GETRES) + +NV +clock_getres(clock_id = CLOCK_REALTIME) + int clock_id + PREINIT: + int status = -1; + struct timespec ts; + CODE: +#ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL + status = syscall(SYS_clock_getres, clock_id, &ts); +#else + status = clock_getres(clock_id, &ts); +#endif + RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1; + + OUTPUT: + RETVAL + +#else /* if defined(TIME_HIRES_CLOCK_GETRES) */ + +NV +clock_getres(clock_id = 0) + int clock_id + CODE: + croak("Time::HiRes::clock_getres(): unimplemented in this platform"); + RETVAL = 0.0; + +#endif /* #if defined(TIME_HIRES_CLOCK_GETRES) */ Modified: orca/trunk/packages/Time-HiRes-1.83/META.yml ============================================================================== --- /orca/trunk/packages/Time-HiRes-1.73/META.yml (original) +++ orca/trunk/packages/Time-HiRes-1.83/META.yml Thu Dec 1 21:13:32 2005 @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Time-HiRes -version: 1.73 +version: 1.83 version_from: HiRes.pm installdirs: perl requires: Modified: orca/trunk/packages/Time-HiRes-1.83/Makefile.PL ============================================================================== --- /orca/trunk/packages/Time-HiRes-1.73/Makefile.PL (original) +++ orca/trunk/packages/Time-HiRes-1.83/Makefile.PL Thu Dec 1 21:13:32 2005 @@ -1,7 +1,7 @@ #!/usr/bin/perl # # In general we trust %Config, but for nanosleep() this trust -# may be misplaces (it may be linkable but not really functional). +# may be misplaced (it may be linkable but not really functional). # Use $ENV{FORCE_NANOSLEEP_SCAN} to force rescanning whether there # really is hope. @@ -15,6 +15,7 @@ my $DEFINE; my $LIBS = []; my $XSOPT = ''; +my $SYSCALL_H; use vars qw($self); # Used in 'sourcing' the hints. @@ -141,19 +142,24 @@ my $tmp_exe = "$tmp$ld_exeext"; printf "cccmd = $cccmd\n" if $VERBOSE; my $res = system($cccmd); - $ok = defined($res) && $res==0 && -s $tmp_exe && -x _; + $ok = defined($res) && $res == 0 && -s $tmp_exe && -x _; if ( $ok && exists $args{run} && $args{run}) { - my $abs_tmp_exe = - File::Spec-> - catfile(File::Spec->rel2abs(File::Spec->curdir), - $tmp_exe); - printf "Running $abs_tmp_exe..." if $VERBOSE; - if (system($abs_tmp_exe) == 0) { + my $tmp_exe = + File::Spec->catfile(File::Spec->curdir, $tmp_exe); + printf "Running $tmp_exe..." if $VERBOSE; + if (system($tmp_exe) == 0) { $ok = 1; } else { $ok = 0; - print "[ system('$abs_tmp_exe') failed: status $? ] "; + my $errno = $? >> 8; + local $! = $errno; + printf < 1); #include @@ -243,7 +249,7 @@ ts2.tv_sec = 0; ts2.tv_nsec = 0; errno = 0; - ret = nanosleep(&ts1, &ts2); /* E.g. in AIX nanosleep() fail and set errno to ENOSYS. */ + ret = nanosleep(&ts1, &ts2); /* E.g. in AIX nanosleep() fails and sets errno to ENOSYS. */ ret == 0 ? exit(0) : exit(errno ? errno : -1); } EOM @@ -266,6 +272,43 @@ return 0; } +sub has_clock_x_syscall { + my $x = shift; + return 0 unless defined $SYSCALL_H; + return 1 if + try_compile_and_link(< 1); +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <$SYSCALL_H> +int main _((int argc, char** argv, char** env)) +{ + struct timespec ts; + /* Many Linuxes get ENOSYS even though the syscall exists. */ + /* All implementations are supposed to support CLOCK_REALTIME. */ + int ret = syscall(SYS_clock_$x, CLOCK_REALTIME, &ts); + ret == 0 ? exit(0) : exit(errno ? errno : -1); +} +EOM +} + +sub has_clock_x { + my $x = shift; + return 1 if + try_compile_and_link(< 1); +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +int main _((int argc, char** argv, char** env)) +{ + struct timespec ts; + int ret = clock_$x(CLOCK_REALTIME, &ts); /* Many Linuxes get ENOSYS. */ + /* All implementations are supposed to support CLOCK_REALTIME. */ + ret == 0 ? exit(0) : exit(errno ? errno : -1); +} +EOM +} + sub init { my $hints = File::Spec->catfile("hints", "$^O.pl"); if (-f $hints) { @@ -280,6 +323,25 @@ $DEFINE = ''; + if ($Config{d_syscall}) { + print "Have syscall()... looking for syscall.h... "; + if (has_include('syscall.h')) { + $SYSCALL_H = 'syscall.h'; + } elsif (has_include('sys/syscall.h')) { + $SYSCALL_H = 'sys/syscall.h'; + } + } else { + print "No syscall()...\n"; + } + + if ($Config{d_syscall}) { + if (defined $SYSCALL_H) { + print "found <$SYSCALL_H>.\n"; + } else { + print "NOT found.\n"; + } + } + print "Looking for gettimeofday()... "; my $has_gettimeofday; if (exists $Config{d_gettimeod}) { @@ -385,16 +447,27 @@ print "Looking for nanosleep()... "; my $has_nanosleep; - if (exists $Config{d_nanosleep} && !$ENV{FORCE_NANOSLEEP_SCAN}) { - # Believe $Config{d_nanosleep}. + if ($ENV{FORCE_NANOSLEEP_SCAN}) { + print "forced scan... "; + if (has_nanosleep()) { + $has_nanosleep++; + $DEFINE .= ' -DTIME_HIRES_NANOSLEEP'; + } + } + elsif (exists $Config{d_nanosleep}) { + print "believing \$Config{d_nanosleep}... "; if ($Config{d_nanosleep}) { $has_nanosleep++; $DEFINE .= ' -DTIME_HIRES_NANOSLEEP'; } - } elsif ($^O ne 'mpeix' && # MPE/iX falsely finds nanosleep. - has_nanosleep()) { - $has_nanosleep++; - $DEFINE .= ' -DTIME_HIRES_NANOSLEEP'; + } elsif ($^O =~ /^(mpeix)$/) { + # MPE/iX falsely finds nanosleep from its libc equivalent. + print "skipping because in $^O... "; + } else { + if (has_nanosleep()) { + $has_nanosleep++; + $DEFINE .= ' -DTIME_HIRES_NANOSLEEP'; + } } if ($has_nanosleep) { @@ -408,6 +481,50 @@ print "(It would not be portable anyway.)\n"; } + print "Looking for clock_gettime()... "; + my $has_clock_gettime; + if (exists $Config{d_clock_gettime}) { + $has_clock_gettime++ if $Config{d_clock_gettime}; # Unlikely... + } elsif (has_clock_x('gettime')) { + $has_clock_gettime++; + $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME'; + } elsif (defined $SYSCALL_H && has_clock_x_syscall('gettime')) { + $has_clock_gettime++; + $DEFINE .= ' -DTIME_HIRES_CLOCK_GETTIME -DTIME_HIRES_CLOCK_GETTIME_SYSCALL'; + } + + if ($has_clock_gettime) { + if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETTIME_SYSCALL/) { + print "found (via syscall).\n"; + } else { + print "found.\n"; + } + } else { + print "NOT found.\n"; + } + + print "Looking for clock_getres()... "; + my $has_clock_getres; + if (exists $Config{d_clock_getres}) { + $has_clock_getres++ if $Config{d_clock_getres}; # Unlikely... + } elsif (has_clock_x('getres')) { + $has_clock_getres++; + $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES'; + } elsif (defined $SYSCALL_H && has_clock_x_syscall('getres')) { + $has_clock_getres++; + $DEFINE .= ' -DTIME_HIRES_CLOCK_GETRES -DTIME_HIRES_CLOCK_GETRES_SYSCALL'; + } + + if ($has_clock_getres) { + if ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETRES_SYSCALL/) { + print "found (via syscall).\n"; + } else { + print "found.\n"; + } + } else { + print "NOT found.\n"; + } + my $has_w32api_windows_h; if ($^O eq 'cygwin') { print "Looking for ... "; @@ -448,9 +565,10 @@ 'LIBS' => $LIBS, # e.g., '-lm' 'DEFINE' => $DEFINE, # e.g., '-DHAS_SOMETHING' 'XSOPT' => $XSOPT, - # do not even think about 'INC' => '-I/usr/ucbinclude', Solaris will avenge. + # Do not even think about 'INC' => '-I/usr/ucbinclude', + # Solaris will avenge. 'INC' => '', # e.g., '-I/usr/include/other' - 'INSTALLDIRS' => 'perl', + 'INSTALLDIRS' => ($] >= 5.008 ? 'perl' : 'site'), 'dist' => { 'CI' => 'ci -l', 'COMPRESS' => 'gzip -9f', @@ -469,15 +587,20 @@ sub doConstants { if (eval {require ExtUtils::Constant; 1}) { - my @names = (qw(ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF + my @names = (qw(CLOCK_HIGHRES CLOCK_MONOTONIC + CLOCK_PROCESS_CPUTIME_ID + CLOCK_REALTIME + CLOCK_THREAD_CPUTIME_ID + CLOCK_TIMEOFDAY + ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF)); foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer - d_nanosleep)) { + d_nanosleep d_clock_gettime d_clock_getres)) { my $macro = $_; - if ($macro eq 'd_nanosleep') { - $macro =~ s/d_(.*)/TIME_HIRES_\U$1/; + if ($macro =~ /^(d_nanosleep|d_clock_gettime|d_clock_getres)$/) { + $macro =~ s/^d_(.+)/TIME_HIRES_\U$1/; } else { - $macro =~ s/d_(.*)/HAS_\U$1/; + $macro =~ s/^d_(.+)/HAS_\U$1/; } push @names, {name => $_, macro => $macro, value => 1, default => ["IV", "0"]}; @@ -509,6 +632,7 @@ if ($^O =~ /Win32/i) { $DEFINE = '-DSELECT_IS_BROKEN'; $LIBS = []; + print "System is $^O, skipping full configure...\n"; } else { init(); } @@ -523,7 +647,7 @@ (exists $ENV{LC_CTYPE} && $ENV{LC_CTYPE} =~ /utf-?8/i) || (exists $ENV{LANG} && $ENV{LANG} =~ /utf-?8/i)) { print <"d_clock_getres", type=>"IV", macro=>"TIME_HIRES_CLOCK_GETRES", value=>"1", default=>["IV", "0"]}, + {name=>"d_clock_gettime", type=>"IV", macro=>"TIME_HIRES_CLOCK_GETTIME", value=>"1", default=>["IV", "0"]}, {name=>"d_getitimer", type=>"IV", macro=>"HAS_GETITIMER", value=>"1", default=>["IV", "0"]}, {name=>"d_gettimeofday", type=>"IV", macro=>"HAS_GETTIMEOFDAY", value=>"1", default=>["IV", "0"]}, - {name=>"d_nanosleep", type=>"IV", macro=>"HAS_NANOSLEEP", value=>"1", default=>["IV", "0"]}, + {name=>"d_nanosleep", type=>"IV", macro=>"TIME_HIRES_NANOSLEEP", value=>"1", default=>["IV", "0"]}, {name=>"d_setitimer", type=>"IV", macro=>"HAS_SETITIMER", value=>"1", default=>["IV", "0"]}, {name=>"d_ualarm", type=>"IV", macro=>"HAS_UALARM", value=>"1", default=>["IV", "0"]}, {name=>"d_usleep", type=>"IV", macro=>"HAS_USLEEP", value=>"1", default=>["IV", "0"]}); @@ -128,8 +244,8 @@ /* Offset 7 gives the best switch position. */ switch (name[7]) { case 'm': - if (memEQ(name, "d_ualarm", 8)) { - /* ^ */ + if (memEQ(name, "d_ualar", 7)) { + /* m */ #ifdef HAS_UALARM *iv_return = 1; return PERL_constant_ISIV; @@ -140,8 +256,8 @@ } break; case 'p': - if (memEQ(name, "d_usleep", 8)) { - /* ^ */ + if (memEQ(name, "d_uslee", 7)) { + /* p */ #ifdef HAS_USLEEP *iv_return = 1; return PERL_constant_ISIV; @@ -156,40 +272,36 @@ case 11: return constant_11 (aTHX_ name, iv_return); break; - case 14: - /* Names all of length 14. */ - /* ITIMER_VIRTUAL d_gettimeofday */ - /* Offset 6 gives the best switch position. */ - switch (name[6]) { - case '_': - if (memEQ(name, "ITIMER_VIRTUAL", 14)) { - /* ^ */ -#ifdef ITIMER_VIRTUAL - *iv_return = ITIMER_VIRTUAL; - return PERL_constant_ISIV; + case 13: + if (memEQ(name, "CLOCK_HIGHRES", 13)) { +#ifdef CLOCK_HIGHRES + *iv_return = CLOCK_HIGHRES; + return PERL_constant_ISIV; #else - return PERL_constant_NOTDEF; + return PERL_constant_NOTDEF; #endif - } - break; - case 'i': - if (memEQ(name, "d_gettimeofday", 14)) { - /* ^ */ -#ifdef HAS_GETTIMEOFDAY - *iv_return = 1; - return PERL_constant_ISIV; + } + break; + case 14: + return constant_14 (aTHX_ name, iv_return); + break; + case 15: + return constant_15 (aTHX_ name, iv_return); + break; + case 23: + if (memEQ(name, "CLOCK_THREAD_CPUTIME_ID", 23)) { +#ifdef CLOCK_THREAD_CPUTIME_ID + *iv_return = CLOCK_THREAD_CPUTIME_ID; + return PERL_constant_ISIV; #else - *iv_return = 0; - return PERL_constant_ISIV; + return PERL_constant_NOTDEF; #endif - } - break; } break; - case 15: - if (memEQ(name, "ITIMER_REALPROF", 15)) { -#ifdef ITIMER_REALPROF - *iv_return = ITIMER_REALPROF; + case 24: + if (memEQ(name, "CLOCK_PROCESS_CPUTIME_ID", 24)) { +#ifdef CLOCK_PROCESS_CPUTIME_ID + *iv_return = CLOCK_PROCESS_CPUTIME_ID; return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; Modified: orca/trunk/packages/Time-HiRes-1.83/fallback/const-xs.inc ============================================================================== --- /orca/trunk/packages/Time-HiRes-1.73/fallback/const-xs.inc (original) +++ orca/trunk/packages/Time-HiRes-1.83/fallback/const-xs.inc Thu Dec 1 21:13:32 2005 @@ -86,3 +86,4 @@ type, s)); PUSHs(sv); } + Modified: orca/trunk/packages/Time-HiRes-1.83/t/HiRes.t ============================================================================== --- /orca/trunk/packages/Time-HiRes-1.73/t/HiRes.t (original) +++ orca/trunk/packages/Time-HiRes-1.83/t/HiRes.t Thu Dec 1 21:13:32 2005 @@ -12,7 +12,7 @@ } } -BEGIN { $| = 1; print "1..28\n"; } +BEGIN { $| = 1; print "1..31\n"; } END { print "not ok 1\n" unless $loaded } @@ -24,41 +24,66 @@ use strict; -my $have_gettimeofday = defined &Time::HiRes::gettimeofday; -my $have_usleep = defined &Time::HiRes::usleep; -my $have_nanosleep = defined &Time::HiRes::nanosleep; -my $have_ualarm = defined &Time::HiRes::ualarm; -my $have_time = defined &Time::HiRes::time; +my $have_gettimeofday = &Time::HiRes::d_gettimeofday; +my $have_usleep = &Time::HiRes::d_usleep; +my $have_nanosleep = &Time::HiRes::d_nanosleep; +my $have_ualarm = &Time::HiRes::d_ualarm; +my $have_clock_gettime = &Time::HiRes::d_clock_gettime; +my $have_clock_getres = &Time::HiRes::d_clock_getres; + +sub has_symbol { + my $symbol = shift; + eval "use Time::HiRes qw($symbol)"; + return 0 unless $@ eq ''; + eval "my \$a = $symbol"; + return $@ eq ''; +} + +printf "# have_gettimeofday = %d\n", $have_gettimeofday; +printf "# have_usleep = %d\n", $have_usleep; +printf "# have_nanosleep = %d\n", $have_nanosleep; +printf "# have_ualarm = %d\n", $have_ualarm; +printf "# have_clock_gettime = %d\n", $have_clock_gettime; +printf "# have_clock_getres = %d\n", $have_clock_getres; import Time::HiRes 'gettimeofday' if $have_gettimeofday; import Time::HiRes 'usleep' if $have_usleep; import Time::HiRes 'nanosleep' if $have_nanosleep; import Time::HiRes 'ualarm' if $have_ualarm; +import Time::HiRes 'clock_gettime' if $have_clock_gettime; +import Time::HiRes 'clock_getres' if $have_clock_getres; use Config; +use Time::HiRes qw(gettimeofday); + my $have_alarm = $Config{d_alarm}; my $have_fork = $Config{d_fork}; -my $waitfor = 60; # 10 seconds is normal. -my $pid; +my $waitfor = 60; # 10-20 seconds is normal (load affects this). +my $timer_pid; +my $TheEnd; if ($have_fork) { - print "# I am process $$, starting the timer process\n"; - if (defined ($pid = fork())) { - if ($pid == 0) { # We are the kid, set up the timer. - print "# I am timer process $$\n"; + print "# I am the main process $$, starting the timer process...\n"; + $timer_pid = fork(); + if (defined $timer_pid) { + if ($timer_pid == 0) { # We are the kid, set up the timer. + print "# I am the timer process $$, sleeping for $waitfor seconds...\n"; sleep($waitfor); - warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded\n"; - print "# Terminating the testing process\n"; + warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n"; + print "# Terminating the main process...\n"; kill('TERM', getppid()); - print "# Timer process exiting\n"; + print "# This is the timer process $$, over and out.\n"; exit(0); + } else { + print "# The timer process $timer_pid launched, continuing testing...\n"; + $TheEnd = time() + $waitfor; } } else { warn "$0: fork failed: $!\n"; } } else { - print "# No timer process\n"; + print "# No timer process (need fork)\n"; } my $xdefine = ''; @@ -95,7 +120,7 @@ } } -if (!$have_gettimeofday) { +unless ($have_gettimeofday) { skip 2..6; } else { @@ -114,10 +139,11 @@ ok 6, $f - $two[0] < 2, "$f - $two[0] >= 2"; } -if (!$have_usleep) { +unless ($have_usleep) { skip 7..8; } else { + use Time::HiRes qw(usleep); my $one = time; usleep(10_000); my $two = time; @@ -125,7 +151,7 @@ my $three = time; ok 7, $one == $two || $two == $three, "slept too long, $one $two $three"; - if (!$have_gettimeofday) { + unless ($have_gettimeofday) { skip 8; } else { @@ -143,7 +169,7 @@ ok 9, abs($f - 5.4) < 0.001, $f; } -if (!$have_gettimeofday) { +unless ($have_gettimeofday) { skip 10; } else { @@ -152,17 +178,17 @@ ok 10, $f < 2, $f; } -if (!$have_usleep || !$have_gettimeofday) { +unless ($have_usleep && $have_gettimeofday) { skip 11; } else { - my $r = [gettimeofday()]; + my $r = [ gettimeofday() ]; Time::HiRes::sleep( 0.5 ); my $f = tv_interval $r; ok 11, $f > 0.4 && $f < 0.9, "slept $f instead of 0.5 secs."; } -if (!$have_ualarm || !$have_alarm) { +unless ($have_ualarm && $have_alarm) { skip 12..13; } else { @@ -183,7 +209,7 @@ # Did we even get close? -if (!$have_time) { +unless ($have_gettimeofday) { skip 14; } else { my ($s, $n, $i) = (0); @@ -209,7 +235,7 @@ print "ok $_ # Skip: no gettimeofday or no ualarm or no usleep\n"; } } else { - use Time::HiRes qw (time alarm sleep); + use Time::HiRes qw(time alarm sleep); my ($f, $r, $i, $not, $ok); @@ -272,47 +298,49 @@ unless ( defined &Time::HiRes::setitimer && defined &Time::HiRes::getitimer - && eval 'Time::HiRes::ITIMER_VIRTUAL' - && $Config{d_select} + && has_symbol('ITIMER_VIRTUAL') && $Config{sig_name} =~ m/\bVTALRM\b/) { for (18..19) { print "ok $_ # Skip: no virtual interval timers\n"; } } else { - use Time::HiRes qw (setitimer getitimer ITIMER_VIRTUAL); + use Time::HiRes qw(setitimer getitimer ITIMER_VIRTUAL); my $i = 3; my $r = [Time::HiRes::gettimeofday()]; $SIG{VTALRM} = sub { - $i ? $i-- : setitimer(ITIMER_VIRTUAL, 0); + $i ? $i-- : setitimer(&ITIMER_VIRTUAL, 0); print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n"; }; print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 0.5, 0.4)), "\n"; # Assume interval timer granularity of $limit * 0.5 seconds. Too bold? - my $virt = getitimer(ITIMER_VIRTUAL); + my $virt = getitimer(&ITIMER_VIRTUAL); print "not " unless defined $virt && abs($virt / 0.5) - 1 < $limit; print "ok 18\n"; print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n"; - while (getitimer(ITIMER_VIRTUAL)) { + while (getitimer(&ITIMER_VIRTUAL)) { my $j; for (1..1000) { $j++ } # Can't be unbreakable, must test getitimer(). } print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n"; - $virt = getitimer(ITIMER_VIRTUAL); + $virt = getitimer(&ITIMER_VIRTUAL); print "not " unless defined $virt && $virt == 0; print "ok 19\n"; $SIG{VTALRM} = 'DEFAULT'; } -if ($have_gettimeofday) { +if ($have_gettimeofday && + $have_usleep) { + use Time::HiRes qw(usleep); + my ($t0, $td); my $sleep = 1.5; # seconds @@ -350,7 +378,7 @@ } } -if (!$have_nanosleep) { +unless ($have_nanosleep) { skip 22..23; } else { @@ -361,7 +389,7 @@ my $three = CORE::time; ok 22, $one == $two || $two == $three, "slept too long, $one $two $three"; - if (!$have_gettimeofday) { + unless ($have_gettimeofday) { skip 23; } else { @@ -402,9 +430,128 @@ skip 28; } -if (defined $pid) { - print "# I am process $$, terminating the timer process $pid\n"; - kill('TERM', $pid); # We are done, the timer can go. - unlink("ktrace.out"); +if ($have_ualarm && $] >= 5.008001) { + # http://groups.google.com/group/perl.perl5.porters/browse_thread/thread/adaffaaf939b042e/20dafc298df737f0%2320dafc298df737f0?sa=X&oi=groupsr&start=0&num=3 + # Perl changes [18765] and [18770], perl bug [perl #20920] + + # First we will find the loop size N (a for() loop 0..N-1) + # that will take more than T seconds. + + my $T = 0.01; + use Time::HiRes qw(time); + my $N = 1024; + my $i; + N: { + do { + my $t0 = time(); + for ($i = 0; $i < $N; $i++) { } + my $t1 = time(); + my $dt = $t1 - $t0; + print "# N = $N, t1 = $t1, t0 = $t0, dt = $dt\n"; + last N if $dt > $T; + $N *= 2; + } while (1); + } + + # The time-burner which takes at least T seconds. + my $F = sub { + my $c = @_ ? shift : 1; + my $n = $c * $N; + my $i; + for ($i = 0; $i < $n; $i++) { } + }; + + # Then we will setup a periodic timer (the two-argument alarm() of + # Time::HiRes, behind the curtains the libc ualarm()) which has + # a signal handler that takes so much time (on the first initial + # invocation) that the first periodic invocation (second invocation) + # will happen before the first invocation has finished. In Perl 5.8.0 + # the "safe signals" concept was implemented, with unfortunately at least + # one bug that caused a core dump on reentering the handler. This bug + # was fixed by the time of Perl 5.8.1. + + # Do not try mixing sleep() and alarm() for testing this. + + my $a = 0; # Number of alarms we receive. + my $A = 2; # Number of alarms we will handle before disarming. + # (We may well get $A + 1 alarms.) + + $SIG{ALRM} = sub { + $a++; + print "# Alarm $a - ", time(), "\n"; + alarm(0) if $a >= $A; # Disarm the alarm. + $F->(2); # Try burning CPU at least for 2T seconds. + }; + + use Time::HiRes qw(alarm); + alarm($T, $T); # Arm the alarm. + + $F->(10); # Try burning CPU at least for 10T seconds. + + print "ok 29\n"; # Not core dumping by now is considered to be the success. +} else { + skip 29; +} + +if ($have_clock_gettime && + # All implementations of clock_gettime() + # are SUPPOSED TO support CLOCK_REALTIME. + has_symbol('CLOCK_REALTIME')) { + my $ok = 0; + TRY: { + for my $try (1..3) { + print "# CLOCK_REALTIME: try = $try\n"; + my $t0 = clock_gettime(&CLOCK_REALTIME); + use Time::HiRes qw(sleep); + my $T = 1.5; + sleep($T); + my $t1 = clock_gettime(&CLOCK_REALTIME); + if ($t0 > 0 && $t1 > $t0) { + print "# t1 = $t1, t0 = $t0\n"; + my $dt = $t1 - $t0; + my $rt = abs(1 - $dt / $T); + print "# dt = $dt, rt = $rt\n"; + if ($rt <= 2 * $limit) { + $ok = 1; + last TRY; + } + } else { + print "# Error: t0 = $t0, t1 = $t1\n"; + } + my $r = rand() + rand(); + printf "# Sleeping for %.6f seconds...\n"; + sleep($r); + } + } + if ($ok) { + print "ok 30\n"; + } else { + print "not ok 30\n"; + } +} else { + print "# No clock_gettime\n"; + skip 30; +} + +if ($have_clock_getres) { + my $tr = clock_getres(); + if ($tr > 0) { + print "ok 31 # tr = $tr\n"; + } else { + print "not ok 31 # tr = $tr\n"; + } +} else { + print "# No clock_getres\n"; + skip 31; +} + +END { + if (defined $timer_pid) { + my $left = $TheEnd - time(); + printf "# I am the main process $$, terminating the timer process $timer_pid\n# before it terminates me in %d seconds (testing took %d seconds).\n", $left, $waitfor - $left; + kill('TERM', $timer_pid); # We are done, the timer can go. + unlink("ktrace.out"); # Used in BSD system call tracing. + print "# All done.\n"; + } } From blair at orcaware.com Sat Dec 10 11:18:54 2005 From: blair at orcaware.com (blair at orcaware.com) Date: Sat, 10 Dec 2005 11:18:54 -0800 Subject: [Orca-checkins] r517 - orca/trunk Message-ID: <200512101918.jBAJIsqB002636@orca3.orcaware.com> Author: blair at orcaware.com Date: Sat Dec 10 11:18:25 2005 New Revision: 517 Modified: orca/trunk/autogen.sh Log: In Debian based distributions, aclocal is packaged separately from autoconf, so add a check for aclocal. * autogen.sh: Check that aclocal can be found. The name or the path to aclocal can be specified by the ACLOCAL environmental variable. Modified: orca/trunk/autogen.sh ============================================================================== --- orca/trunk/autogen.sh (original) +++ orca/trunk/autogen.sh Sat Dec 10 11:18:25 2005 @@ -19,6 +19,16 @@ echo "$0: autoconf version $ac_version (ok)" fi +# Check for aclocal. +${ACLOCAL:-aclocal} --version >/dev/null 2>&1 +if test $? -ne 0; then + echo "$0: aclocal not found." + echo " You need aclocal installed to build Orca from Subversion." + exit 1 +else + echo "$0: aclocal found" +fi + # The Orca Subversion repository contains RRDtool, which has its own # automake, autoconf and libtool setup. When checking out Orca from # Subversion, it does not preserve the relative timestamps of the From blair at orcaware.com Sat Dec 10 11:26:32 2005 From: blair at orcaware.com (blair at orcaware.com) Date: Sat, 10 Dec 2005 11:26:32 -0800 Subject: [Orca-checkins] r518 - orca/trunk Message-ID: <200512101926.jBAJQW5D005168@orca3.orcaware.com> Author: blair at orcaware.com Date: Sat Dec 10 11:25:58 2005 New Revision: 518 Modified: orca/trunk/autogen.sh Log: Actually use the ACLOCAL and the AUTOCONF environmental variables if they are set. * autogen.sh: Use ACLOCAL and fall back to 'aclocal' if ACLOCAL is not set. Use AUTOCONF and fall back to 'autoconf if AUTOCONF is not set. Modified: orca/trunk/autogen.sh ============================================================================== --- orca/trunk/autogen.sh (original) +++ orca/trunk/autogen.sh Sat Dec 10 11:25:58 2005 @@ -43,6 +43,6 @@ # Now create configure and it's associated build files. echo "$0: creating configure and associated build files..." -aclocal -I config --output=config/aclocal.m4 -autoconf --include=config +${ACLOCAL:-aclocal} -I config --output=config/aclocal.m4 +${AUTOCONF:-autoconf} --include=config rm -fr autom4te*.cache From blair at orcaware.com Tue Dec 13 20:06:11 2005 From: blair at orcaware.com (blair at orcaware.com) Date: Tue, 13 Dec 2005 20:06:11 -0800 Subject: [Orca-checkins] r519 - orca/trunk/data_gatherers/procallator Message-ID: <200512140406.jBE46BmT016175@orca3.orcaware.com> Author: blair at orcaware.com Date: Tue Dec 13 20:05:44 2005 New Revision: 519 Modified: orca/trunk/data_gatherers/procallator/procallator.cfg.in Log: Spelling fixes, capitalization consistency changes and whitespace formatting fixes. * data_gatherers/procallator/procallator.cfg.in: Correct spelling of some works. s/statistics/Statistics/g. Remove extra empty lines. Modified: orca/trunk/data_gatherers/procallator/procallator.cfg.in ============================================================================== --- orca/trunk/data_gatherers/procallator/procallator.cfg.in (original) +++ orca/trunk/data_gatherers/procallator/procallator.cfg.in Tue Dec 13 20:05:44 2005 @@ -123,7 +123,6 @@ legend 15 minute average legend CPUs (load threshold) y_legend Number of processes and CPUs - data_min 0 data_max 100 href http://www.orcaware.com/orca/docs/procallator.html#processes_in_run_queue @@ -291,7 +290,6 @@ data_min 0 } - plot { title %g Interface Input Bits Per Second source procallator @@ -306,7 +304,7 @@ } plot { -title %g Interface Ouput Bits Per Second +title %g Interface Output Bits Per Second source procallator data 8 * if_out_b_(.*) line_type line1 @@ -419,7 +417,7 @@ } plot { -title %g IP Traffic statistics +title %g IP Traffic Statistics source procallator data Ip_InReceives data Ip_OutRequests @@ -428,7 +426,7 @@ data_type counter data_type counter legend IP Input datagrams -legend IP Ouput datagrams +legend IP Output datagrams legend IP Forwarded datagrams y_legend rate data_min 0 @@ -436,7 +434,7 @@ } plot { -title %g IP Error statistics +title %g IP Error Statistics source procallator data Ip_InHdrErrors + Ip_InHdrErrors + Ip_InAddrErrors + Ip_InUnknownProtos + Ip_InDiscards data Ip_OutDiscards + Ip_OutNoRoutes @@ -456,7 +454,7 @@ } plot { -title %g TCP Connection statistics +title %g TCP Connection Statistics source procallator data Tcp_CurrEstab data Tcp_ActiveOpens @@ -478,9 +476,8 @@ flush_regexps 1 } - plot { -title %g TCP Traffic statistics +title %g TCP Traffic Statistics source procallator data Tcp_InSegs data Tcp_OutSegs @@ -494,7 +491,7 @@ } plot { -title %g TCP Error statistics +title %g TCP Error Statistics source procallator data Tcp_InErrs data Tcp_OutRsts @@ -511,7 +508,7 @@ } plot { -title %g ICMP statistics +title %g ICMP Statistics source procallator data Icmp_(.*) data_type counter @@ -522,7 +519,7 @@ } plot { -title %g UDP statistics +title %g UDP Statistics source procallator data Udp_(.*) data_type counter @@ -616,8 +613,6 @@ href http://www.orcaware.com/orca/docs/procallator.html#disk_system_wide_transfer_rate } - - plot { title %g Disk Space Percent Usage source procallator @@ -673,7 +668,6 @@ href http://www.orcaware.com/orca/docs/procallator.html#memory_free } - plot { title %g Memory Page Scan Rate source procallator From blair at orcaware.com Tue Dec 27 23:27:22 2005 From: blair at orcaware.com (blair at orcaware.com) Date: Tue, 27 Dec 2005 23:27:22 -0800 Subject: [Orca-checkins] r520 - orca/trunk/data_gatherers/winallator Message-ID: <200512280727.jBS7RMro020745@orca3.orcaware.com> Author: blair at orcaware.com Date: Tue Dec 27 23:26:54 2005 New Revision: 520 Added: orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r519.txt - copied, changed from r519, /orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r362.txt Removed: orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r362.txt Modified: orca/trunk/data_gatherers/winallator/README Log: Update Winallator's patch for SourceFile.pm so it cleanly applies. * data_gatherers/winallator/SourceFile.pm-patch-with-r519.txt: Renamed from data_gatherers/winallator/SourceFile.pm-patch-with-r362.txt. Regenerated by applying SourceFile.pm-patch-with-r362.txt to SourceFile.pm and running diff with the unpatched and patched versions. * data_gatherers/winallator/README: Mention new filenames. Modified: orca/trunk/data_gatherers/winallator/README ============================================================================== --- orca/trunk/data_gatherers/winallator/README (original) +++ orca/trunk/data_gatherers/winallator/README Tue Dec 27 23:26:54 2005 @@ -26,7 +26,7 @@ a) Get a copy of the Orca source tree on the system that will process the Winallator log files. - b) Find the SourceFile.pm-patch-with-r362.txt file and note where + b) Find the SourceFile.pm-patch-with-r519.txt file and note where it is. c) cd into the $prefix/lib/Orca directory, where $prefix is where @@ -35,7 +35,7 @@ c) Apply the patch by running: cp -p SourceFile.pm SourceFile.FCS - patch -s -p0 < path/to/SourceFile.pm-patch-with-r362.txt + patch -s -p0 < path/to/SourceFile.pm-patch-with-r519.txt 4. You have two choices now. The first and easy choice is to load in a previously designed log configuration. You can always modify Copied: orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r519.txt (from r519, /orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r362.txt) ============================================================================== --- /orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r362.txt (original) +++ orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r519.txt Tue Dec 27 23:26:54 2005 @@ -1,8 +1,6 @@ -Index: SourceFile.pm -=================================================================== ---- SourceFile.pm (revision 362) -+++ SourceFile.pm (working copy) -@@ -31,6 +31,10 @@ +--- SourceFile.pm.orig 2005-12-27 23:14:54.000000000 -0800 ++++ SourceFile.pm 2005-12-27 23:14:58.000000000 -0800 +@@ -48,6 +48,10 @@ use Orca::Utils qw(email_message); use vars qw(@ISA $VERSION); @@ -11,9 +9,9 @@ +use Time::Local; + @ISA = qw(Orca::DataFile); - $VERSION = substr q$Revision: 0.01 $, 10; + $VERSION = (substr q$Revision: 513 $, 10)/100.0; -@@ -153,9 +157,39 @@ +@@ -170,9 +174,39 @@ return unless $fd; my $line = <$fd>; chomp($line); @@ -54,7 +52,7 @@ } else { warn "$0: warning: no first_line for '$filename' yet.\n"; $open_file_cache->close($fid) or -@@ -921,8 +955,19 @@ +@@ -965,7 +999,18 @@ # in the output file when it starts up. next if $line =~ /timestamp/; @@ -64,18 +62,17 @@ +s/ /:/g; +s/"//g; +$line = $_; - ++ + # Andy Fox - 2nd July 2002 + # Changed this to a tab (was a space), so it can read tsv format files + my @line = split(' ', $line); + + ##ANDY## + #print "@line\n"; -+ + # Skip this input line if 1) the file uses the first line to # define the column names, 2) the number of columns loaded is not - # equal to the number of columns in the column description. -@@ -940,6 +985,58 @@ +@@ -984,6 +1029,58 @@ } else { $time = $line[$date_column_index]; } From blair at orcaware.com Thu Dec 29 20:01:20 2005 From: blair at orcaware.com (blair at orcaware.com) Date: Thu, 29 Dec 2005 20:01:20 -0800 Subject: [Orca-checkins] r521 - orca/trunk/data_gatherers/winallator Message-ID: <200512300401.jBU41KmX007584@orca3.orcaware.com> Author: blair at orcaware.com Date: Thu Dec 29 20:00:46 2005 New Revision: 521 Added: orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r520.txt - copied, changed from r520, /orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r519.txt Removed: orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r519.txt Modified: orca/trunk/data_gatherers/winallator/README Log: Clean up and simplify Winallator's patch for SourceFile.pm. Also, move some changes to another portion of the file so that it doesn't include the $Revision$ svn:keywords expansion which would prevent it from cleanly applying after the next commit to SourceFile.pm. * data_gatherers/winallator/SourceFile.pm-patch-with-r520.txt: Renamed from data_gatherers/winallator/SourceFile.pm-patch-with-r519.txt. Regenerated by applying SourceFile.pm-patch-with-r519.txt to SourceFile.pm and running diff with the unpatched and patched versions. * data_gatherers/winallator/README: Mention new filenames. Modified: orca/trunk/data_gatherers/winallator/README ============================================================================== --- orca/trunk/data_gatherers/winallator/README (original) +++ orca/trunk/data_gatherers/winallator/README Thu Dec 29 20:00:46 2005 @@ -26,7 +26,7 @@ a) Get a copy of the Orca source tree on the system that will process the Winallator log files. - b) Find the SourceFile.pm-patch-with-r519.txt file and note where + b) Find the SourceFile.pm-patch-with-r520.txt file and note where it is. c) cd into the $prefix/lib/Orca directory, where $prefix is where @@ -35,7 +35,7 @@ c) Apply the patch by running: cp -p SourceFile.pm SourceFile.FCS - patch -s -p0 < path/to/SourceFile.pm-patch-with-r519.txt + patch -s -p0 < path/to/SourceFile.pm-patch-with-r520.txt 4. You have two choices now. The first and easy choice is to load in a previously designed log configuration. You can always modify Copied: orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r520.txt (from r520, /orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r519.txt) ============================================================================== --- /orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r519.txt (original) +++ orca/trunk/data_gatherers/winallator/SourceFile.pm-patch-with-r520.txt Thu Dec 29 20:00:46 2005 @@ -1,24 +1,20 @@ ---- SourceFile.pm.orig 2005-12-27 23:14:54.000000000 -0800 -+++ SourceFile.pm 2005-12-27 23:14:58.000000000 -0800 -@@ -48,6 +48,10 @@ - use Orca::Utils qw(email_message); - use vars qw(@ISA $VERSION); - -+# Andy Fox - 2nd July 2002 -+# We need this to convert time into Unix Epoch Time. +--- SourceFile.pm.orig 2005-12-28 19:51:32.000000000 -0800 ++++ SourceFile.pm 2005-12-28 20:04:16.000000000 -0800 +@@ -31,6 +31,7 @@ + use Carp; + use Digest::MD5 qw(md5); + use Storable qw(dclone); +use Time::Local; -+ - @ISA = qw(Orca::DataFile); - $VERSION = (substr q$Revision: 513 $, 10)/100.0; - -@@ -170,9 +174,39 @@ + use Orca::Constants qw($opt_verbose + die_when_called + $INCORRECT_NUMBER_OF_ARGS); +@@ -170,9 +171,33 @@ return unless $fd; my $line = <$fd>; chomp($line); + -+ # Andy Fox - 2nd July 2002 -+ # Take the first line (headers) and convert it into a format Orca can understand -+ ++ # Take the first line (headers) and convert it into a format ++ # Orca can understand. if ($line) { $self->[I_FIRST_LINE] = 1; - @column_description = split(' ', $line); @@ -39,94 +35,47 @@ + $line = $_; + print "$line\n"; + -+ # Andy Fox - 2nd July 2002 -+ # Changed this to a tab (was a space), so it can read tsv format files -+ -+ @column_description = split(' ', $line); ++ # Change this space to a tab, so it can read tsv format files. ++ @column_description = split("\t", $line); + -+ # Andy Fox - 2nd July 2002 + # Set the first field of the first line 'timestamp' -+ -+ $column_description[0]="timestamp"; -+ ++ $column_description[0] = "timestamp"; } else { warn "$0: warning: no first_line for '$filename' yet.\n"; $open_file_cache->close($fid) or -@@ -965,7 +999,18 @@ +@@ -965,7 +990,12 @@ # in the output file when it starts up. next if $line =~ /timestamp/; - my @line = split(' ', $line); -+print "$line\n"; -+$_ = $line; -+s/ /:/g; -+s/"//g; -+$line = $_; -+ -+ # Andy Fox - 2nd July 2002 -+ # Changed this to a tab (was a space), so it can read tsv format files -+ my @line = split(' ', $line); ++ print "$line\n"; ++ $line =~ s/ /:/g; ++ $line =~ s/"//g; + -+ ##ANDY## -+ #print "@line\n"; ++ # Change this space to a tab, so it can read tsv format files. ++ my @line = split("\t", $line); # Skip this input line if 1) the file uses the first line to # define the column names, 2) the number of columns loaded is not -@@ -984,6 +1029,58 @@ +@@ -984,6 +1014,22 @@ } else { $time = $line[$date_column_index]; } -+#ANDY# -+#print "$time\n"; + -+# At this stage the date is in this format: 06/18/2002 21:56:06.096 ++ # At this stage the date is in this format: 06/18/2002:21:56:06.096 ++ $time =~ s/\//:/g; ++ $time =~ s/\./:/; ++ ++ # Now we have this: "06:18:2002:21:56:06:096" ++ my @time = split(':', $time); ++ ++ my ($mon, $day, $yr, $hr, $min, $sec) = @time; + -+$_ = $time; -+s/\//:/g; -+#print "$_\n"; -+#s/ /:/; -+#print "$_\n"; -+s/\./:/; -+#print "$_\n"; -+#$newtime = $_; -+#s/"//g; -+#print "$_\n"; -+ -+# Now we have this: "06:18:2002:21:56:06:096" -+ -+my @andy = split(':', $_); -+ -+my ($sec); -+my ($min); -+my ($hr); -+my ($day); -+my ($mon); -+my ($yr); -+ -+$mon = $andy[0]; -+$day = $andy[1]; -+$yr = $andy[2]; -+$hr = $andy[3]; -+$min = $andy[4]; -+$sec = $andy[5]; -+ -+#print "mon = $mon\n"; -+#print "day = $day\n"; -+#print "yr = $yr\n"; -+#print "hr = $hr\n"; -+#print "min = $min\n"; -+#print "sec = $sec\n"; -+ -+$mon -= 1; -+$yr -= 1900; -+#print "yr = $yr\n"; -+ -+my ($blur); -+$blur = timelocal($sec, $min, $hr, $day, $mon, $yr); -+#print "time is now $blur\n"; ++ $mon -= 1; ++ $yr -= 1900; + -+$time = $blur; -+print "$time\n"; ++ $time = timelocal($sec, $min, $hr, $day, $mon, $yr); ++ print "$time\n"; + $last_data_time = $time if $time > $last_data_time;