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