r33675 - in /branches/upstream/libtime-warp-perl: ./ current/ current/MANIFEST current/MANIFEST.SKIP current/Makefile.PL current/README current/Warp.pm current/Warp.xs current/t/ current/t/when.t
bricas-guest at users.alioth.debian.org
bricas-guest at users.alioth.debian.org
Tue Apr 21 18:18:06 UTC 2009
Author: bricas-guest
Date: Tue Apr 21 18:18:01 2009
New Revision: 33675
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=33675
Log:
[svn-inject] Installing original source of libtime-warp-perl
Added:
branches/upstream/libtime-warp-perl/
branches/upstream/libtime-warp-perl/current/
branches/upstream/libtime-warp-perl/current/MANIFEST
branches/upstream/libtime-warp-perl/current/MANIFEST.SKIP
branches/upstream/libtime-warp-perl/current/Makefile.PL
branches/upstream/libtime-warp-perl/current/README
branches/upstream/libtime-warp-perl/current/Warp.pm
branches/upstream/libtime-warp-perl/current/Warp.xs
branches/upstream/libtime-warp-perl/current/t/
branches/upstream/libtime-warp-perl/current/t/when.t
Added: branches/upstream/libtime-warp-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-warp-perl/current/MANIFEST?rev=33675&op=file
==============================================================================
--- branches/upstream/libtime-warp-perl/current/MANIFEST (added)
+++ branches/upstream/libtime-warp-perl/current/MANIFEST Tue Apr 21 18:18:01 2009
@@ -1,0 +1,7 @@
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+README
+Warp.pm
+Warp.xs
+t/when.t
Added: branches/upstream/libtime-warp-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-warp-perl/current/MANIFEST.SKIP?rev=33675&op=file
==============================================================================
--- branches/upstream/libtime-warp-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libtime-warp-perl/current/MANIFEST.SKIP Tue Apr 21 18:18:01 2009
@@ -1,0 +1,3 @@
+^MANIFEST\.bak$
+Makefile(\.old)?$
+\.rej$
Added: branches/upstream/libtime-warp-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-warp-perl/current/Makefile.PL?rev=33675&op=file
==============================================================================
--- branches/upstream/libtime-warp-perl/current/Makefile.PL (added)
+++ branches/upstream/libtime-warp-perl/current/Makefile.PL Tue Apr 21 18:18:01 2009
@@ -1,0 +1,12 @@
+use ExtUtils::MakeMaker;
+
+require 5.005; # maybe 5.004_65+ OK
+
+my %hash = (
+ NAME => 'Time::Warp',
+ VERSION_FROM => 'Warp.pm',
+ OBJECT => 'Warp.o',
+ OPTIMIZE => '-g',
+ );
+
+WriteMakefile(%hash);
Added: branches/upstream/libtime-warp-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-warp-perl/current/README?rev=33675&op=file
==============================================================================
--- branches/upstream/libtime-warp-perl/current/README (added)
+++ branches/upstream/libtime-warp-perl/current/README Tue Apr 21 18:18:01 2009
@@ -1,0 +1,12 @@
+Time::Warp - offers developers control over the measurement of time
+
+
+SYNOPSIS
+
+ use Time::Warp qw(scale to time);
+
+ to(CORE::time + 5); # 5 seconds ahead
+ scale(2); # double speed of time
+
+
+AVAILABLE FROM CPAN!
Added: branches/upstream/libtime-warp-perl/current/Warp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-warp-perl/current/Warp.pm?rev=33675&op=file
==============================================================================
--- branches/upstream/libtime-warp-perl/current/Warp.pm (added)
+++ branches/upstream/libtime-warp-perl/current/Warp.pm Tue Apr 21 18:18:01 2009
@@ -1,0 +1,83 @@
+use strict;
+package Time::Warp;
+use vars qw(@ISA @EXPORT_OK $VERSION);
+require Exporter;
+require DynaLoader;
+ at ISA = qw(DynaLoader Exporter);
+ at EXPORT_OK = qw(reset to scale time);
+$VERSION = '0.5';
+
+__PACKAGE__->bootstrap($VERSION);
+
+install_time_api();
+
+1;
+__END__
+
+=head1 NAME
+
+Time::Warp - control over the flow of time
+
+=head1 SYNOPSIS
+
+ use Time::Warp qw(scale to time);
+
+ to(time + 5); # 5 seconds ahead
+ scale(2); # make time flow twice normal
+
+=head1 DESCRIPTION
+
+Our external experience unfolds in 3 1/2 dimensions (time has a
+dimensionality of 1/2). The Time::Warp module offers developers
+control over the measurement of time.
+
+=head1 API
+
+=over 4
+
+=item * to($desired_time)
+
+The theory of relativity asserts that all physical laws are enforced
+relative to the observer. Since the starting point of time is
+arbitrary, it is permissable to change it. This has the effect of
+making it appear as if time is moving forwards or backward
+instanteously. For example, on some types of operating systems time
+starts at Wed Dec 31 19:00:00 1969 (this will likely change as we
+approach 2030 and with the acceptance of 64-bit CPUs).
+
+ to(time + 60*60); # 1 hour ahead
+
+=item * scale($factor)
+
+Changes the speed at which time is progressing.
+
+ scale(scale * 2); # double the speed of time
+
+Note that it is not possible to stop time or cause it to reverse since
+this is forbidden by the second law of thermodynamics.
+
+=back
+
+=head1 ALSO SEE
+
+L<Time::HiRes> and L<Event>.
+
+=head1 SUPPORT
+
+Please direct your insights or complaints to perl-loop at perl.org.
+
+=head1 DISCLAIMER
+
+THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THIS IS NOT A
+TIME MACHINE. THIS MODULE CANNOT BE USED TO VIOLATE THE SECOND LAW OF
+THERMODYNAMICS.
+
+=head1 COPYRIGHT
+
+Copyright © 1999, 2000 Joshua Nathaniel Pritikin. All rights reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libtime-warp-perl/current/Warp.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-warp-perl/current/Warp.xs?rev=33675&op=file
==============================================================================
--- branches/upstream/libtime-warp-perl/current/Warp.xs (added)
+++ branches/upstream/libtime-warp-perl/current/Warp.xs Tue Apr 21 18:18:01 2009
@@ -1,0 +1,138 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define MIN_PERL_DEFINE 1
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef __cplusplus
+}
+#endif
+
+/* Is time() portable everywhere? Hope so! XXX */
+
+static double fallback_NVtime()
+{ return time(0); }
+
+static void fallback_U2time(U32 *ret)
+{
+ ret[0]=time(0);
+ ret[1]=0;
+}
+
+/*-----------------*/
+
+static int Installed=0;
+static double (*realNVtime)();
+static void (*realU2time)(U32 *);
+
+static double Lost; /** time relative to now */
+static double Zero; /** apply Scale from when? */
+static double Scale; /** speed of time (.5 == half speed) */
+
+static void reset_warp()
+{
+ Lost=0;
+ Zero=(*realNVtime)();
+ Scale=1;
+}
+
+/*-----------------*/
+
+static double warped_NVtime()
+{
+ double now = (*realNVtime)() - Lost;
+ double delta = now - Zero;
+ delta *= Scale;
+ return Zero + delta;
+}
+
+static void warped_U2time(U32 *ret)
+{
+ /* performance doesn't matter enough for a native
+ non-float implementation */
+ double now = warped_NVtime();
+ U32 unow = now;
+ ret[0] = unow;
+ ret[1] = (now - unow) * 1000000;
+}
+
+MODULE = Time::Warp PACKAGE = Time::Warp
+
+PROTOTYPES: ENABLE
+
+void
+install_time_api()
+ CODE:
+{
+ SV **svp;
+ if (Installed) {
+ warn("Time::Warp::install_time_api() called more than once");
+ return;
+ }
+ Installed=1;
+ svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
+ if (!svp) {
+ warn("Time::Warp: Time::HiRes is not loaded --\n\tat best 1s time accuracy is available");
+ hv_store(PL_modglobal, "Time::NVtime", 12,
+ newSViv((IV) fallback_NVtime), 0);
+ hv_store(PL_modglobal, "Time::U2time", 12,
+ newSViv((IV) fallback_U2time), 0);
+ }
+ svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
+ if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer");
+ realNVtime = (double(*)()) SvIV(*svp);
+ svp = hv_fetch(PL_modglobal, "Time::U2time", 12, 0);
+ if (!SvIOK(*svp)) croak("Time::U2time isn't a function pointer");
+ realU2time = (void(*)(U32*)) SvIV(*svp);
+ hv_store(PL_modglobal, "Time::NVtime", 12,
+ newSViv((IV) warped_NVtime), 0);
+ hv_store(PL_modglobal, "Time::U2time", 12,
+ newSViv((IV) warped_U2time), 0);
+
+ reset_warp();
+}
+
+void
+reset()
+ CODE:
+ reset_warp();
+
+void
+to(when)
+ double when
+ CODE:
+{
+ Lost += (warped_NVtime() - when) / Scale;
+}
+
+void
+scale(...)
+ PPCODE:
+{
+ if (items == 0) {
+ XPUSHs(sv_2mortal(newSVnv(Scale)));
+ } else {
+ Zero = warped_NVtime();
+ Lost = 0;
+ Scale = SvNV(ST(0));
+ if (Scale < 0) {
+ warn("Sorry, Time::Warp cannot go backwards");
+ Scale = 1;
+ }
+ else if (Scale < .001) {
+ warn("Sorry, Time::Warp cannot stop time");
+ Scale = .001;
+ }
+ }
+}
+
+void
+time()
+ PPCODE:
+{
+ XPUSHs(sv_2mortal(newSVnv(warped_NVtime())));
+}
Added: branches/upstream/libtime-warp-perl/current/t/when.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtime-warp-perl/current/t/when.t?rev=33675&op=file
==============================================================================
--- branches/upstream/libtime-warp-perl/current/t/when.t (added)
+++ branches/upstream/libtime-warp-perl/current/t/when.t Tue Apr 21 18:18:01 2009
@@ -1,0 +1,33 @@
+#!./perl -w
+
+# These tests may occationally fail due to small timing differences.
+
+use Test; plan test => 8;
+{
+ local $SIG{__WARN__} = sub {
+ if ($_[0] =~ /Time::HiRes/) {
+ ok 1;
+ } else {
+ warn $_[0];
+ }
+ };
+ require Time::Warp;
+}
+Time::Warp->import(qw(time to scale));
+ok 1;
+ok &scale, 1;
+
+scale(2);
+ok &scale, 2;
+my $now = &time;
+sleep 2;
+ok(&time - $now, 4);
+
+to(CORE::time);
+ok(&time - CORE::time, 0);
+
+scale(scale() * 2);
+ok(&time - CORE::time, 0);
+
+Time::Warp::reset(); to(&time + 5);
+ok(&time - CORE::time, 5);
More information about the Pkg-perl-cvs-commits
mailing list