File Coverage

Warp.xs
Criterion Covered Total %
statement 34 50 68.0
branch 13 24 54.1
condition n/a
subroutine n/a
pod n/a
total 47 74 63.5


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 14           static NV fallback_NVtime()
18 14           { 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 Scale; /** speed of time (.5 == half speed) */
34              
35 2           static void reset_warp()
36             {
37 2           Lost=0;
38 2           Scale=1;
39 2           }
40              
41             /*-----------------*/
42              
43 10           static NV warped_NVtime()
44             {
45 10           return (*realNVtime)() * Scale + Lost;
46             }
47              
48 0           static void warped_U2time(U32 *ret)
49             {
50             /* performance doesn't matter enough for a native
51             non-float implementation */
52 0           double now = warped_NVtime();
53 0           U32 unow = now;
54 0           ret[0] = unow;
55 0           ret[1] = (now - unow) * 1000000;
56 0           }
57              
58             MODULE = Time::Warp PACKAGE = Time::Warp
59              
60             PROTOTYPES: ENABLE
61              
62             void
63             install_time_api()
64             CODE:
65             {
66             SV **svp;
67 1 50         if (Installed) {
68 0           warn("Time::Warp::install_time_api() called more than once");
69 0           return;
70             }
71 1           Installed=1;
72 1           svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
73 1 50         if (!svp) {
74 1           warn("Time::Warp: Time::HiRes is not loaded --\n\tat best 1s time accuracy is available");
75 1           hv_store(PL_modglobal, "Time::NVtime", 12,
76             newSViv((IV) fallback_NVtime), 0);
77 1           hv_store(PL_modglobal, "Time::U2time", 12,
78             newSViv((IV) fallback_U2time), 0);
79             }
80 1           svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
81 1 50         if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer");
82 1 50         realNVtime = (NV(*)()) SvIV(*svp);
83 1           svp = hv_fetch(PL_modglobal, "Time::U2time", 12, 0);
84 1 50         if (!SvIOK(*svp)) croak("Time::U2time isn't a function pointer");
85 1 50         realU2time = (void(*)(U32*)) SvIV(*svp);
86 1           hv_store(PL_modglobal, "Time::NVtime", 12,
87             newSViv((IV) warped_NVtime), 0);
88 1           hv_store(PL_modglobal, "Time::U2time", 12,
89             newSViv((IV) warped_U2time), 0);
90              
91 1           reset_warp();
92             }
93              
94             void
95             reset()
96             CODE:
97 1           reset_warp();
98              
99             void
100             to(when)
101             double when
102             CODE:
103             {
104 2           Lost = when - (*realNVtime)() * Scale;
105             }
106              
107             void
108             scale(...)
109             PREINIT:
110             double new_Scale;
111             PPCODE:
112             {
113 9 100         if (items == 0) {
114 7 50         XPUSHs(sv_2mortal(newSVnv(Scale)));
115             } else {
116 2 50         new_Scale = SvNV(ST(0));
117 2 50         if (new_Scale < 0) {
118 0           warn("Sorry, Time::Warp cannot go backwards");
119 0           new_Scale = 1;
120             }
121 2 50         else if (new_Scale < .001) {
122 0           warn("Sorry, Time::Warp cannot stop time");
123 0           new_Scale = .001;
124             }
125 2           Lost += (*realNVtime)() * (Scale - new_Scale);
126 2           Scale = new_Scale;
127             }
128             }
129              
130             void
131             time()
132             PPCODE:
133             {
134 10 50         XPUSHs(sv_2mortal(newSVnv(warped_NVtime())));
135             }