added call to tzset to activate TZ settings -- Paul A Vixie <vixie@vix.com>
[rrdtool.git] / bindings / perl-shared / RRDs.xs
1 #ifdef __cplusplus
2 extern "C" {
3 #endif
4
5 #include "EXTERN.h"
6 #include "perl.h"
7 #include "XSUB.h"
8 #include <time.h>
9
10 #ifdef __cplusplus
11 }
12 #endif
13
14 #include "../src/rrd_tool.h"
15
16 /* perl 5.004 compatibility */
17 #if PERLPATCHLEVEL < 5
18 #define PL_sv_undef sv_undef
19 #endif
20
21 #define rrdcode(name) \
22                 argv = (char **) malloc((items+1)*sizeof(char *));\
23                 argv[0] = "dummy";\
24                 for (i = 0; i < items; i++) { \
25                     STRLEN len; \
26                     char *handle= SvPV(ST(i),len);\
27                     /* actually copy the data to make sure possible modifications \
28                        on the argv data does not backfire into perl */ \
29                     argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char)); \
30                     strcpy(argv[i+1],handle); \
31                 } \
32                 optind=0; opterr=0; \
33                 rrd_clear_error();\
34                 RETVAL=name(items+1,argv); \
35                 for (i=0; i < items; i++) {\
36                     free(argv[i+1]);\
37                 } \
38                 free(argv);\
39                 \
40                 if (rrd_test_error()) XSRETURN_UNDEF;
41
42
43 #ifdef WIN32
44  #define free free
45  #define malloc malloc
46  #define realloc realloc
47 #endif /*WIN32*/
48
49
50 MODULE = RRDs   PACKAGE = RRDs  PREFIX = rrd_
51
52 BOOT:
53 #ifdef MUST_DISABLE_SIGFPE
54         signal(SIGFPE,SIG_IGN);
55 #endif
56 #ifdef MUST_DISABLE_FPMASK
57         fpsetmask(0);
58 #endif 
59         
60
61 SV*
62 rrd_error()
63         CODE:
64                 if (! rrd_test_error()) XSRETURN_UNDEF;
65                 RETVAL = newSVpv(rrd_get_error(),0);
66         OUTPUT:
67                 RETVAL
68
69         
70 int
71 rrd_last(...)
72       PROTOTYPE: @
73       PREINIT:
74       int i;
75       char **argv;
76       CODE:
77               rrdcode(rrd_last);
78       OUTPUT:
79             RETVAL
80
81
82 int
83 rrd_create(...)
84         PROTOTYPE: @    
85         PREINIT:
86         int i;
87         char **argv;
88         CODE:
89                 rrdcode(rrd_create);
90                 RETVAL = 1;
91         OUTPUT:
92                 RETVAL
93
94
95 int
96 rrd_update(...)
97         PROTOTYPE: @    
98         PREINIT:
99         int i;
100         char **argv;
101         CODE:
102                 rrdcode(rrd_update);
103                 RETVAL = 1;
104         OUTPUT:
105                 RETVAL
106
107
108 int
109 rrd_tune(...)
110         PROTOTYPE: @    
111         PREINIT:
112         int i;
113         char **argv;
114         CODE:
115                 rrdcode(rrd_tune);
116                 RETVAL = 1;
117         OUTPUT:
118                 RETVAL
119
120
121 void
122 rrd_graph(...)
123         PROTOTYPE: @    
124         PREINIT:
125         char **calcpr;
126         int i,xsize,ysize;
127         char **argv;
128         AV *retar;
129         PPCODE:
130                 argv = (char **) malloc((items+1)*sizeof(char *));
131                 argv[0] = "dummy";
132                 for (i = 0; i < items; i++) { 
133                     STRLEN len;
134                     char *handle = SvPV(ST(i),len);
135                     /* actually copy the data to make sure possible modifications
136                        on the argv data does not backfire into perl */ 
137                     argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char));
138                     strcpy(argv[i+1],handle);
139                 }
140                 optind=0; opterr=0; 
141                 rrd_clear_error();
142                 tzset();
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);
148
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)));
167
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; 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)));
218                 PUSHs(sv_2mortal(newSViv(step)));
219                 PUSHs(sv_2mortal(newRV_noinc((SV*)names)));
220                 PUSHs(sv_2mortal(newRV_noinc((SV*)retar)));
221
222
223 SV*
224 rrd_info(...)
225         PROTOTYPE: @    
226         PREINIT:
227                 info_t *data,*save;
228                 int i;
229                 char **argv;
230                 HV *hash;
231         CODE:
232                 /* prepare argument list */
233                 argv = (char **) malloc((items+1)*sizeof(char *));
234                 argv[0] = "dummy";
235                 for (i = 0; i < items; i++) { 
236                     STRLEN len;
237                     char *handle= SvPV(ST(i),len);
238                     /* actually copy the data to make sure possible modifications
239                        on the argv data does not backfire into perl */ 
240                     argv[i+1] = (char *) malloc((strlen(handle)+1)*sizeof(char));
241                     strcpy(argv[i+1],handle);
242                 }
243                 optind=0; opterr=0; 
244                 rrd_clear_error();
245                 data=rrd_info(items+1, argv);
246                 for (i=0; i < items; i++) {
247                     free(argv[i+1]);
248                 }
249                 free(argv);
250                 if (rrd_test_error()) XSRETURN_UNDEF;
251                 hash = newHV();
252                 while (data) {
253                     save=data;
254                 /* the newSV will get copied by hv so we create it as a mortal to make sure
255                    it does not keep hanging round after the fact */
256 #define hvs(VAL) hv_store_ent(hash, sv_2mortal(newSVpv(data->key,0)),VAL,0)                 
257                     switch (data->type) {
258                     case RD_I_VAL:
259                         if (isnan(data->value.u_val))
260                             hvs(&PL_sv_undef);
261                         else
262                             hvs(newSVnv(data->value.u_val));
263                         break;
264                     case RD_I_CNT:
265                         hvs(newSViv(data->value.u_cnt));
266                         break;
267                     case RD_I_STR:
268                         hvs(newSVpv(data->value.u_str,0));
269                         free(data->value.u_str);
270                         break;
271                     }
272 #undefine hvs
273                     free(data->key);
274                     data = data->next;              
275                     free(save);
276                 }
277                 free(data);
278                 RETVAL = newRV_noinc((SV*)hash);
279        OUTPUT:
280                 RETVAL
281
282