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;
42 #ifdef WIN32
43 #define free free
44 #define malloc malloc
45 #define realloc realloc
46 #endif /*WIN32*/
49 MODULE = RRDs PACKAGE = RRDs PREFIX = rrd_
51 BOOT:
52 #ifdef MUST_DISABLE_SIGFPE
53 signal(SIGFPE,SIG_IGN);
54 #endif
55 #ifdef MUST_DISABLE_FPMASK
56 fpsetmask(0);
57 #endif
60 SV*
61 rrd_error()
62 CODE:
63 if (! rrd_test_error()) XSRETURN_UNDEF;
64 RETVAL = newSVpv(rrd_get_error(),0);
65 OUTPUT:
66 RETVAL
69 int
70 rrd_last(...)
71 PROTOTYPE: @
72 PREINIT:
73 int i;
74 char **argv;
75 CODE:
76 rrdcode(rrd_last);
77 OUTPUT:
78 RETVAL
81 int
82 rrd_create(...)
83 PROTOTYPE: @
84 PREINIT:
85 int i;
86 char **argv;
87 CODE:
88 rrdcode(rrd_create);
89 RETVAL = 1;
90 OUTPUT:
91 RETVAL
94 int
95 rrd_update(...)
96 PROTOTYPE: @
97 PREINIT:
98 int i;
99 char **argv;
100 CODE:
101 rrdcode(rrd_update);
102 RETVAL = 1;
103 OUTPUT:
104 RETVAL
107 int
108 rrd_tune(...)
109 PROTOTYPE: @
110 PREINIT:
111 int i;
112 char **argv;
113 CODE:
114 rrdcode(rrd_tune);
115 RETVAL = 1;
116 OUTPUT:
117 RETVAL
120 void
121 rrd_graph(...)
122 PROTOTYPE: @
123 PREINIT:
124 char **calcpr;
125 int i,xsize,ysize;
126 char **argv;
127 AV *retar;
128 PPCODE:
129 argv = (char **) malloc((items+1)*sizeof(char *));
130 argv[0] = "dummy";
131 for (i = 0; i < items; i++) {
132 STRLEN len;
133 char *handle = SvPV(ST(i),len);
134 /* actually copy the data to make sure possible modifications
135 on the argv data does not backfire into perl */
136 argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char));
137 strcpy(argv[i+1],handle);
138 }
139 optind=0; opterr=0;
140 rrd_clear_error();
141 rrd_graph(items+1,argv,&calcpr,&xsize,&ysize);
142 for (i=0; i < items; i++) {
143 free(argv[i+1]);
144 }
145 free(argv);
147 if (rrd_test_error()) {
148 if(calcpr)
149 for(i=0;calcpr[i];i++)
150 free(calcpr[i]);
151 XSRETURN_UNDEF;
152 }
153 retar=newAV();
154 if(calcpr){
155 for(i=0;calcpr[i];i++){
156 av_push(retar,newSVpv(calcpr[i],0));
157 free(calcpr[i]);
158 }
159 free(calcpr);
160 }
161 EXTEND(sp,4);
162 PUSHs(sv_2mortal(newRV_noinc((SV*)retar)));
163 PUSHs(sv_2mortal(newSViv(xsize)));
164 PUSHs(sv_2mortal(newSViv(ysize)));
166 void
167 rrd_fetch(...)
168 PROTOTYPE: @
169 PREINIT:
170 time_t start,end;
171 unsigned long step, ds_cnt,i,ii;
172 rrd_value_t *data,*datai;
173 char **argv;
174 char **ds_namv;
175 AV *retar,*line,*names;
176 PPCODE:
177 argv = (char **) malloc((items+1)*sizeof(char *));
178 argv[0] = "dummy";
179 for (i = 0; i < items; i++) {
180 STRLEN len;
181 char *handle= SvPV(ST(i),len);
182 /* actually copy the data to make sure possible modifications
183 on the argv data does not backfire into perl */
184 argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char));
185 strcpy(argv[i+1],handle);
186 }
187 optind=0; opterr=0;
188 rrd_clear_error();
189 rrd_fetch(items+1,argv,&start,&end,&step,&ds_cnt,&ds_namv,&data);
190 for (i=0; i < items; i++) {
191 free(argv[i+1]);
192 }
193 free(argv);
194 if (rrd_test_error()) XSRETURN_UNDEF;
195 /* convert the ds_namv into perl format */
196 names=newAV();
197 for (ii = 0; ii < ds_cnt; ii++){
198 av_push(names,newSVpv(ds_namv[ii],0));
199 free(ds_namv[ii]);
200 }
201 free(ds_namv);
202 /* convert the data array into perl format */
203 datai=data;
204 retar=newAV();
205 for (i = start; i <= end; i += step){
206 line = newAV();
207 for (ii = 0; ii < ds_cnt; ii++){
208 av_push(line,(isnan(*datai) ? &PL_sv_undef : newSVnv(*datai)));
209 datai++;
210 }
211 av_push(retar,newRV_noinc((SV*)line));
212 }
213 free(data);
214 EXTEND(sp,5);
215 PUSHs(sv_2mortal(newSViv(start)));
216 PUSHs(sv_2mortal(newSViv(step)));
217 PUSHs(sv_2mortal(newRV_noinc((SV*)names)));
218 PUSHs(sv_2mortal(newRV_noinc((SV*)retar)));
221 SV*
222 rrd_info(...)
223 PROTOTYPE: @
224 PREINIT:
225 info_t *data,*save;
226 int i;
227 char **argv;
228 HV *hash;
229 CODE:
230 /* prepare argument list */
231 argv = (char **) malloc((items+1)*sizeof(char *));
232 argv[0] = "dummy";
233 for (i = 0; i < items; i++) {
234 STRLEN len;
235 char *handle= SvPV(ST(i),len);
236 /* actually copy the data to make sure possible modifications
237 on the argv data does not backfire into perl */
238 argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char));
239 strcpy(argv[i+1],handle);
240 }
241 optind=0; opterr=0;
242 rrd_clear_error();
243 data=rrd_info(items+1, argv);
244 for (i=0; i < items; i++) {
245 free(argv[i+1]);
246 }
247 free(argv);
248 if (rrd_test_error()) XSRETURN_UNDEF;
249 hash = newHV();
250 while (data) {
251 save=data;
252 /* the newSV will get copied by hv so we create it as a mortal to make sure
253 it does not keep hanging round after the fact */
254 #define hvs(VAL) hv_store_ent(hash, sv_2mortal(newSVpv(data->key,0)),VAL,0)
255 switch (data->type) {
256 case RD_I_VAL:
257 if (isnan(data->value.u_val))
258 hvs(&PL_sv_undef);
259 else
260 hvs(newSVnv(data->value.u_val));
261 break;
262 case RD_I_CNT:
263 hvs(newSViv(data->value.u_cnt));
264 break;
265 case RD_I_STR:
266 hvs(newSVpv(data->value.u_str,0));
267 free(data->value.u_str);
268 break;
269 }
270 #undefine hvs
271 free(data->key);
272 data = data->next;
273 free(save);
274 }
275 free(data);
276 RETVAL = newRV_noinc((SV*)hash);
277 OUTPUT:
278 RETVAL