← Back to branch summary

~ubuntu-branches/ubuntu/natty/bluefish/natty-proposed

« back to all changes in this revision

Viewing changes to src/perl_ezembed.c

  • Committer: Bazaar Package Importer
  • Author(s): Davide Puricelli (evo)
  • Date: 2005-04-23 17:05:18 UTC
  • mto: (1.1.5 upstream) (5.1.2 sid)
  • mto: This revision was merged to the branch mainline in revision 3.
  • Revision ID: james.westby@ubuntu.com-20050423170518-izh2k25xve7ui1jx
Tags: upstream-1.0
Import upstream version 1.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/perl_ezembed.c
1
 
#include "config.h"
2
 
#ifdef PERL
3
 
 
4
 
#include <EXTERN.h>
5
 
#include <string.h>
6
 
#include <perl.h>
7
 
 
8
 
 
9
 
/*perl_call ("foo",
10
 
       "s",    "hello",
11
 
       "i",    2,
12
 
       "d",    5.4,
13
 
       "OUT",
14
 
       "i",    &i,
15
 
       "s",    buf,
16
 
       NULL);
17
 
*/
18
 
typedef struct {
19
 
    char type;       
20
 
    void *pdata;
21
 
} Out_Param;
22
 
 
23
 
 
24
 
int perl_eval_va (char *str, ...)
25
 
{
26
 
    /* Evals a string, returns -1 if unsuccessful, else returns
27
 
     *  the number of return params
28
 
     *  char buf[10]; int a;
29
 
     *  perl_eval_va ("$a = 10; ($a, $a+1)",
30
 
     *                "i", &a,
31
 
     *                "s", buf,
32
 
     *                 NULL);
33
 
     */
34
 
       
35
 
    SV*       sv     = newSVpv(str,0);
36
 
    va_list   vl;
37
 
    char      *p     = NULL;  
38
 
    int       i      = 0; 
39
 
    int       nret   = 0;     /* number of return params expected*/
40
 
    int       result = 0;
41
 
    Out_Param op[20];
42
 
    int ii; double d;
43
 
 
44
 
    dSP;
45
 
    ENTER;
46
 
    SAVETMPS;
47
 
    PUSHMARK(sp);
48
 
    va_start (vl, str);
49
 
 
50
 
    while (p = va_arg(vl, char *)) {
51
 
        if ((*p != 's') && (*p != 'i') && (*p != 'd')) {
52
 
            return -1;
53
 
        }
54
 
        op[nret].pdata = (void*) va_arg(vl, char *);
55
 
        op[nret++].type = *p;
56
 
    }
57
 
    va_end(vl);
58
 
    PUTBACK;
59
 
    result = perl_eval_sv(sv, (nret == 0) ? G_DISCARD :
60
 
                              (nret == 1) ? G_SCALAR  :
61
 
                                            G_ARRAY  );
62
 
 
63
 
    SPAGAIN;
64
 
/*    if (SvTRUE(GvSV(errgv))) { // errgv == $@ 
65
 
        return -1; 
66
 
    } */
67
 
    SvREFCNT_dec(sv);
68
 
    /*printf ("nret: %d, result: %d\n", nret, result);*/
69
 
    if (nret > result)
70
 
        nret = result;
71
 
 
72
 
    for (i = --nret; i >= 0; i--) {
73
 
        switch (op[i].type) {
74
 
        case 's':
75
 
            str = POPp;
76
 
            /*printf ("String: %s\n", str);*/
77
 
            strcpy((char *)op[i].pdata, str);
78
 
            break;
79
 
        case 'i':
80
 
            ii = POPi;
81
 
            /*printf ("Int: %d\n", ii);*/
82
 
            *((int *)(op[i].pdata)) = ii;
83
 
            break;
84
 
        case 'd':
85
 
            d = POPn;
86
 
            /*printf ("Double: %f\n", d);*/
87
 
            *((double *) (op[i].pdata)) = d;
88
 
            break;
89
 
        }
90
 
   }
91
 
   FREETMPS ;
92
 
   LEAVE;
93
 
   return result;
94
 
}    
95
 
 
96
 
int perl_call_va (char *subname, ...)
97
 
{
98
 
    char *p;
99
 
    char *str = NULL; int i = 0; double d = 0;
100
 
    int  nret = 0; /* number of return params expected*/
101
 
    int  ax;
102
 
    int ii=0;
103
 
    Out_Param op[20];
104
 
    va_list vl;
105
 
    int out = 0;
106
 
    int result = 0;
107
 
 
108
 
    dSP;
109
 
    ENTER;
110
 
    SAVETMPS;
111
 
    PUSHMARK(sp);
112
 
    va_start (vl, subname);
113
 
 
114
 
    /*printf ("Entering perl_call %s\n", subname);*/
115
 
    while (p = va_arg(vl, char *)) {
116
 
        /*printf ("Type: %s\n", p);*/
117
 
        switch (*p)
118
 
        {
119
 
        case 's' :
120
 
            if (out) {
121
 
                op[nret].pdata = (void*) va_arg(vl, char *);
122
 
                op[nret++].type = 's';
123
 
            } else {
124
 
                str = va_arg(vl, char *);
125
 
         /*printf ("IN: String %s\n", str);*/
126
 
         ii = strlen(str);
127
 
                XPUSHs(sv_2mortal(newSVpv(str,ii)));
128
 
            }
129
 
            break;
130
 
        case 'i' :
131
 
            if (out) {
132
 
                op[nret].pdata = (void*) va_arg(vl, int *);
133
 
                op[nret++].type = 'i';
134
 
            } else {
135
 
                ii = va_arg(vl, int);
136
 
         /*printf ("IN: Int %d\n", ii);*/
137
 
                XPUSHs(sv_2mortal(newSViv(ii)));
138
 
            }
139
 
            break;
140
 
        case 'd' :
141
 
            if (out) {
142
 
                op[nret].pdata = (void*) va_arg(vl, double *);
143
 
                op[nret++].type = 'd';
144
 
            } else {
145
 
               d = va_arg(vl, double);
146
 
               /*printf ("IN: Double %f\n", d);*/
147
 
               XPUSHs(sv_2mortal(newSVnv(d)));
148
 
            }
149
 
            break;
150
 
        case 'O':
151
 
            out = 1;  /* Out parameters starting */
152
 
            break;
153
 
        default:
154
 
            return 0;
155
 
        }
156
 
    }
157
 
   
158
 
    va_end(vl);
159
 
 
160
 
    PUTBACK;
161
 
    result = perl_call_pv(subname, (nret == 0) ? G_DISCARD :
162
 
                                   (nret == 1) ? G_SCALAR  :
163
 
                                                 G_ARRAY  );
164
 
 
165
 
    
166
 
 
167
 
    SPAGAIN;
168
 
    /*printf ("nret: %d, result: %d\n", nret, result);*/
169
 
    if (nret > result)
170
 
        nret = result;
171
 
 
172
 
    for (i = --nret; i >= 0; i--) {
173
 
        switch (op[i].type) {
174
 
        case 's':
175
 
            str = POPp;
176
 
            /*printf ("String: %s\n", str);*/
177
 
            strcpy((char *)op[i].pdata, str);
178
 
            break;
179
 
        case 'i':
180
 
            ii = POPi;
181
 
            /*printf ("Int: %d\n", ii);*/
182
 
            *((int *)(op[i].pdata)) = ii;
183
 
            break;
184
 
        case 'd':
185
 
            d = POPn;
186
 
            /*printf ("Double: %f\n", d);*/
187
 
            *((double *) (op[i].pdata)) = d;
188
 
            break;
189
 
        }
190
 
    }
191
 
   
192
 
    FREETMPS ;
193
 
    LEAVE ;
194
 
    return result;
195
 
}
196
 
#endif