File Coverage

Warp.xs
Criterion Covered Total %
statement 38 54 70.3
branch 13 24 54.1
condition n/a
subroutine n/a
pod n/a
total 51 78 65.3


line stmt bran cond sub pod time code
1             #ifdef __cplusplus
2             extern "C" {
3             #endif
4              
5             #define MIN_PERL_DEFINE 1
6              
7             #include "EXTERN.h"
8             #include "perl.h"
9             #include "XSUB.h"
10              
11             #ifdef __cplusplus
12             }
13             #endif
14              
15             /* Is time() portable everywhere? Hope so! XXX */
16              
17 12           static NV fallback_NVtime()
18 12           { return time(0); }
19              
20 0           static void fallback_U2time(U32 *ret)
21             {
22 0           ret[0]=time(0);
23 0           ret[1]=0;
24 0           }
25              
26             /*-----------------*/
27              
28             static int Installed=0;
29             static NV (*realNVtime)();
30             static void (*realU2time)(U32 *);
31              
32             static double Lost; /** time relative to now */
33             static double Zero; /** apply Scale from when? */
34             static double Scale; /** speed of time (.5 == half speed) */
35              
36 2           static void reset_warp()
37             {
38 2           Lost=0;
39 2           Zero=(*realNVtime)();
40 2           Scale=1;
41 2           }
42              
43             /*-----------------*/
44              
45 10           static NV warped_NVtime()
46             {
47 10           double now = (*realNVtime)() - Lost;
48 10           double delta = now - Zero;
49 10           delta *= Scale;
50 10           return Zero + delta;
51             }
52              
53 0           static void warped_U2time(U32 *ret)
54             {
55             /* performance doesn't matter enough for a native
56             non-float implementation */
57 0           double now = warped_NVtime();
58 0           U32 unow = now;
59 0           ret[0] = unow;
60 0           ret[1] = (now - unow) * 1000000;
61 0           }
62              
63             MODULE = Time::Warp PACKAGE = Time::Warp
64              
65             PROTOTYPES: ENABLE
66              
67             void
68             install_time_api()
69             CODE:
70             {
71             SV **svp;
72 1 50         if (Installed) {
73 0           warn("Time::Warp::install_time_api() called more than once");
74 0           return;
75             }
76 1           Installed=1;
77 1           svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
78 1 50         if (!svp) {
79 1           warn("Time::Warp: Time::HiRes is not loaded --\n\tat best 1s time accuracy is available");
80 1           hv_store(PL_modglobal, "Time::NVtime", 12,
81             newSViv((IV) fallback_NVtime), 0);
82 1           hv_store(PL_modglobal, "Time::U2time", 12,
83             newSViv((IV) fallback_U2time), 0);
84             }
85 1           svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
86 1 50         if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer");
87 1 50         realNVtime = (NV(*)()) SvIV(*svp);
88 1           svp = hv_fetch(PL_modglobal, "Time::U2time", 12, 0);
89 1 50         if (!SvIOK(*svp)) croak("Time::U2time isn't a function pointer");
90 1 50         realU2time = (void(*)(U32*)) SvIV(*svp);
91 1           hv_store(PL_modglobal, "Time::NVtime", 12,
92             newSViv((IV) warped_NVtime), 0);
93 1           hv_store(PL_modglobal, "Time::U2time", 12,
94             newSViv((IV) warped_U2time), 0);
95              
96 1           reset_warp();
97             }
98              
99             void
100             reset()
101             CODE:
102 1           reset_warp();
103              
104             void
105             to(when)
106             double when
107             CODE:
108             {
109 2           Lost += (warped_NVtime() - when) / Scale;
110             }
111              
112             void
113             scale(...)
114             PPCODE:
115             {
116 5 100         if (items == 0) {
117 3 50         XPUSHs(sv_2mortal(newSVnv(Scale)));
118             } else {
119 2           Zero = warped_NVtime();
120 2           Lost = 0;
121 2 50         Scale = SvNV(ST(0));
122 2 50         if (Scale < 0) {
123 0           warn("Sorry, Time::Warp cannot go backwards");
124 0           Scale = 1;
125             }
126 2 50         else if (Scale < .001) {
127 0           warn("Sorry, Time::Warp cannot stop time");
128 0           Scale = .001;
129             }
130             }
131             }
132              
133             void
134             time()
135             PPCODE:
136             {
137 6 50         XPUSHs(sv_2mortal(newSVnv(warped_NVtime())));
138             }