plugins/perl-loader/perl-gnumeric.c

   1 #include <gnumeric-config.h>
   2 #include "perl-gnumeric.h"
   3
   4 SV *
   5 value2perl(const GnmValue *v)
   6 {
   7         SV *sv;
   8
   9         switch (v->v_any.type) {
  10         case VALUE_BOOLEAN:
  11                 sv = newSViv(value_get_as_int (v));
  12                 break;
  13
  14         case VALUE_FLOAT:
  15                 sv = newSVnv(value_get_as_float (v));
  16                 break;
  17
  18         case VALUE_STRING: {
  19                 const char *s = value_peek_string (v);
  20                 sv = newSVpv(s,strlen(s));
  21                 break;
  22         }
  23
  24         default:
  25                 sv = NULL;
  26                 break;
  27         }
  28         return sv;
  29 }
  30
  31 GnmValue *
  32 perl2value(SV *sv)
  33 {
  34     GnmValue *v = NULL;
  35
  36     if (SvIOK(sv))
  37         v = value_new_int (SvIV(sv));
  38     else if (SvNOK(sv))
  39         v = value_new_float ((gnm_float) SvNV(sv));
  40     else if (SvPOK(sv)) {
  41         STRLEN size;
  42         gchar *tmp;
  43
  44         tmp = SvPV(sv, size);
  45         v = value_new_string_nocopy (g_strndup (tmp, size));
  46     }
  47
  48     return v;
  49 }
  50
  51 GnmValue *
  52 marshal_func (GnmFuncEvalInfo *ei, GnmValue *argv[])
  53 {
  54     dSP;
  55     GnmFunc const *func =
  56         gnm_expr_get_func_def ((GnmExpr const *)ei->func_call);
  57     I32 r;
  58     int i, min, max;
  59     SV * result;
  60     GnmValue *v;
  61
  62     /* Read the perlcall man page for more information. */
  63     ENTER;
  64     SAVETMPS;
  65
  66     PUSHMARK(sp);
  67     gnm_func_count_args (func, &min, &max);
  68
  69     for (i = 0; i < max && argv[i] != NULL; i++) {
  70         XPUSHs(sv_2mortal(value2perl(argv[i])));
  71     }
  72     PUTBACK;
  73
  74     r = perl_call_sv (gnm_func_get_user_data (func), G_SCALAR);
  75     SPAGAIN;
  76     if (r != 1)
  77         croak("uh oh, beter get maco");
  78
  79     result = POPs;
  80     v = perl2value(result);
  81
  82     PUTBACK;
  83     FREETMPS;
  84     LEAVE;
  85
  86     return v;
  87 }