a0001f7904af42069ef2d9c39e1958e5de3d4f9e
1 #ifdef __cplusplus
2 extern "C" {
3 #endif
5 #include "EXTERN.h"
6 #include "perl.h"
7 #include "XSUB.h"
9 #ifdef __cplusplus
10 }
11 #endif
13 #include "../../src/rrd_tool.h"
15 /* perl 5.004 compatibility */
16 #if PERLPATCHLEVEL < 5
17 #define PL_sv_undef sv_undef
18 #endif
20 #define rrdcode(name) \
21 argv = (char **) malloc((items+1)*sizeof(char *));\
22 argv[0] = "dummy";\
23 for (i = 0; i < items; i++) { \
24 STRLEN len; \
25 char *handle= SvPV(ST(i),len);\
26 /* actually copy the data to make sure possible modifications \
27 on the argv data does not backfire into perl */ \
28 argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char)); \
29 strcpy(argv[i+1],handle); \
30 } \
31 optind=0; opterr=0; \
32 rrd_clear_error();\
33 RETVAL=name(items+1,argv); \
34 for (i=0; i < items; i++) {\
35 free(argv[i+1]);\
36 } \
37 free(argv);\
38 \
39 if (rrd_test_error()) XSRETURN_UNDEF;
41 /*
42 * should not be needed if libc is linked (see ntmake.pl)
43 #ifdef WIN32
44 #define free free
45 #define malloc malloc
46 #define realloc realloc
47 #endif
48 */
51 MODULE = RRDs PACKAGE = RRDs PREFIX = rrd_
53 BOOT:
54 #ifdef MUST_DISABLE_SIGFPE
55 signal(SIGFPE,SIG_IGN);
56 #endif
57 #ifdef MUST_DISABLE_FPMASK
58 fpsetmask(0);
59 #endif
62 SV*
63 rrd_error()
64 CODE:
65 if (! rrd_test_error()) XSRETURN_UNDEF;
66 RETVAL = newSVpv(rrd_get_error(),0);
67 OUTPUT:
68 RETVAL
71 int
72 rrd_last(...)
73 PROTOTYPE: @
74 PREINIT:
75 int i;
76 char **argv;
77 CODE:
78 rrdcode(rrd_last);
79 OUTPUT:
80 RETVAL
83 int
84 rrd_create(...)
85 PROTOTYPE: @
86 PREINIT:
87 int i;
88 char **argv;
89 CODE:
90 rrdcode(rrd_create);
91 RETVAL = 1;
92 OUTPUT:
93 RETVAL
96 int
97 rrd_update(...)
98 PROTOTYPE: @
99 PREINIT:
100 int i;
101 char **argv;
102 CODE:
103 rrdcode(rrd_update);
104 RETVAL = 1;
105 OUTPUT:
106 RETVAL
109 int
110 rrd_tune(...)
111 PROTOTYPE: @
112 PREINIT:
113 int i;
114 char **argv;
115 CODE:
116 rrdcode(rrd_tune);
117 RETVAL = 1;
118 OUTPUT:
119 RETVAL
122 void
123 rrd_graph(...)
124 PROTOTYPE: @
125 PREINIT:
126 char **calcpr;
127 int i,xsize,ysize;
128 char **argv;
129 AV *retar;
130 PPCODE:
131 argv = (char **) malloc((items+1)*sizeof(char *));
132 argv[0] = "dummy";
133 for (i = 0; i < items; i++) {
134 STRLEN len;
135 char *handle = SvPV(ST(i),len);
136 /* actually copy the data to make sure possible modifications
137 on the argv data does not backfire into perl */
138 argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char));
139 strcpy(argv[i+1],handle);
140 }
141 optind=0; opterr=0;
142 rrd_clear_error();
143 rrd_graph(items+1,argv,&calcpr,&xsize,&ysize);
144 for (i=0; i < items; i++) {
145 free(argv[i+1]);
146 }
147 free(argv);
149 if (rrd_test_error()) {
150 if(calcpr)
151 for(i=0;calcpr[i];i++)
152 free(calcpr[i]);
153 XSRETURN_UNDEF;
154 }
155 retar=newAV();
156 if(calcpr){
157 for(i=0;calcpr[i];i++){
158 av_push(retar,newSVpv(calcpr[i],0));
159 free(calcpr[i]);
160 }
161 free(calcpr);
162 }
163 EXTEND(sp,4);
164 PUSHs(sv_2mortal(newRV_noinc((SV*)retar)));
165 PUSHs(sv_2mortal(newSViv(xsize)));
166 PUSHs(sv_2mortal(newSViv(ysize)));
168 void
169 rrd_fetch(...)
170 PROTOTYPE: @
171 PREINIT:
172 time_t start,end;
173 unsigned long step, ds_cnt,i,ii;
174 rrd_value_t *data,*datai;
175 char **argv;
176 char **ds_namv;
177 AV *retar,*line,*names;
178 PPCODE:
179 argv = (char **) malloc((items+1)*sizeof(char *));
180 argv[0] = "dummy";
181 for (i = 0; i < items; i++) {
182 STRLEN len;
183 char *handle= SvPV(ST(i),len);
184 /* actually copy the data to make sure possible modifications
185 on the argv data does not backfire into perl */
186 argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char));
187 strcpy(argv[i+1],handle);
188 }
189 optind=0; opterr=0;
190 rrd_clear_error();
191 rrd_fetch(items+1,argv,&start,&end,&step,&ds_cnt,&ds_namv,&data);
192 for (i=0; i < items; i++) {
193 free(argv[i+1]);
194 }
195 free(argv);
196 if (rrd_test_error()) XSRETURN_UNDEF;
197 /* convert the ds_namv into perl format */
198 names=newAV();
199 for (ii = 0; ii < ds_cnt; ii++){
200 av_push(names,newSVpv(ds_namv[ii],0));
201 free(ds_namv[ii]);
202 }
203 free(ds_namv);
204 /* convert the data array into perl format */
205 datai=data;
206 retar=newAV();
207 for (i = start+step; i <= end; i += step){
208 line = newAV();
209 for (ii = 0; ii < ds_cnt; ii++){
210 av_push(line,(isnan(*datai) ? &PL_sv_undef : newSVnv(*datai)));
211 datai++;
212 }
213 av_push(retar,newRV_noinc((SV*)line));
214 }
215 free(data);
216 EXTEND(sp,5);
217 PUSHs(sv_2mortal(newSViv(start+step)));
218 PUSHs(sv_2mortal(newSViv(step)));
219 PUSHs(sv_2mortal(newRV_noinc((SV*)names)));
220 PUSHs(sv_2mortal(newRV_noinc((SV*)retar)));
223 int
224 rrd_xport(...)
225 PROTOTYPE: @
226 PREINIT:
227 time_t start,end;
228 int xsize;
229 unsigned long step, col_cnt,row_cnt,i,ii;
230 rrd_value_t *data,*ptr;
231 char **argv,**legend_v;
232 AV *retar,*line,*names;
233 PPCODE:
234 argv = (char **) malloc((items+1)*sizeof(char *));
235 argv[0] = "dummy";
236 for (i = 0; i < items; i++) {
237 STRLEN len;
238 char *handle = SvPV(ST(i),len);
239 /* actually copy the data to make sure possible modifications
240 on the argv data does not backfire into perl */
241 argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char));
242 strcpy(argv[i+1],handle);
243 }
244 optind=0; opterr=0;
245 rrd_clear_error();
246 rrd_xport(items+1,argv,&xsize,&start,&end,&step,&col_cnt,&legend_v,&data);
247 for (i=0; i < items; i++) {
248 free(argv[i+1]);
249 }
250 free(argv);
251 if (rrd_test_error()) XSRETURN_UNDEF;
253 /* convert the legend_v into perl format */
254 names=newAV();
255 for (ii = 0; ii < col_cnt; ii++){
256 av_push(names,newSVpv(legend_v[ii],0));
257 free(legend_v[ii]);
258 }
259 free(legend_v);
261 /* convert the data array into perl format */
262 ptr=data;
263 retar=newAV();
264 for (i = start+step; i <= end; i += step){
265 line = newAV();
266 for (ii = 0; ii < col_cnt; ii++){
267 av_push(line,(isnan(*ptr) ? &PL_sv_undef : newSVnv(*ptr)));
268 ptr++;
269 }
270 av_push(retar,newRV_noinc((SV*)line));
271 }
272 free(data);
274 EXTEND(sp,7);
275 PUSHs(sv_2mortal(newSViv(start+step)));
276 PUSHs(sv_2mortal(newSViv(end)));
277 PUSHs(sv_2mortal(newSViv(step)));
278 PUSHs(sv_2mortal(newSViv(col_cnt)));
279 PUSHs(sv_2mortal(newRV_noinc((SV*)names)));
280 PUSHs(sv_2mortal(newRV_noinc((SV*)retar)));
282 SV*
283 rrd_info(...)
284 PROTOTYPE: @
285 PREINIT:
286 info_t *data,*save;
287 int i;
288 char **argv;
289 HV *hash;
290 CODE:
291 /* prepare argument list */
292 argv = (char **) malloc((items+1)*sizeof(char *));
293 argv[0] = "dummy";
294 for (i = 0; i < items; i++) {
295 STRLEN len;
296 char *handle= SvPV(ST(i),len);
297 /* actually copy the data to make sure possible modifications
298 on the argv data does not backfire into perl */
299 argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char));
300 strcpy(argv[i+1],handle);
301 }
302 optind=0; opterr=0;
303 rrd_clear_error();
304 data=rrd_info(items+1, argv);
305 for (i=0; i < items; i++) {
306 free(argv[i+1]);
307 }
308 free(argv);
309 if (rrd_test_error()) XSRETURN_UNDEF;
310 hash = newHV();
311 while (data) {
312 save=data;
313 /* the newSV will get copied by hv so we create it as a mortal to make sure
314 it does not keep hanging round after the fact */
315 #define hvs(VAL) hv_store_ent(hash, sv_2mortal(newSVpv(data->key,0)),VAL,0)
316 switch (data->type) {
317 case RD_I_VAL:
318 if (isnan(data->value.u_val))
319 hvs(&PL_sv_undef);
320 else
321 hvs(newSVnv(data->value.u_val));
322 break;
323 case RD_I_CNT:
324 hvs(newSViv(data->value.u_cnt));
325 break;
326 case RD_I_STR:
327 hvs(newSVpv(data->value.u_str,0));
328 free(data->value.u_str);
329 break;
330 }
331 #undefine hvs
332 free(data->key);
333 data = data->next;
334 free(save);
335 }
336 free(data);
337 RETVAL = newRV_noinc((SV*)hash);
338 OUTPUT:
339 RETVAL