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 #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;
  40
  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 */
  49
  50
  51 MODULE = RRDs   PACKAGE = RRDs  PREFIX = rrd_
  52
  53 BOOT:
  54 #ifdef MUST_DISABLE_SIGFPE
  55         signal(SIGFPE,SIG_IGN);
  56 #endif
  57 #ifdef MUST_DISABLE_FPMASK
  58         fpsetmask(0);
  59 #endif
  60
  61
  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
  69
  70
  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
  81
  82
  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
  94
  95
  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
 107
 108
 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
 120
 121
 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);
 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+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)));
 221
 222
 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;
 252
 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);
 260
 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);
 273
 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)));
 281
 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
 340
 341