• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4 
5 #include "ClearSilver.h"
6 
7 /* #define DEBUG_MODE 1
8  */
9 
10 typedef struct {
11   HDF*      hdf;
12   NEOERR* err;
13 } perlHDF;
14 
15 typedef struct {
16   CSPARSE* cs;
17   NEOERR* err;
18 } perlCS;
19 
20 typedef perlHDF* ClearSilver__HDF;
21 typedef perlCS* ClearSilver__CS;
22 
23 static char* g_sort_func_name;
24 
debug(char * fmt,...)25 static void debug(char* fmt, ...)
26 {
27 #ifdef DEBUG_MODE
28   va_list argp;
29   va_start(argp, fmt);
30   vprintf(fmt, argp);
31   va_end(argp);
32 #endif
33 }
34 
output(void * ctx,char * s)35 static NEOERR *output (void *ctx, char *s)
36 {
37   sv_catpv((SV*)ctx, s);
38 
39   return STATUS_OK;
40 }
41 
sortFunction(const void * in_a,const void * in_b)42 static int sortFunction(const void* in_a, const void* in_b)
43 {
44   HDF** hdf_a;
45   HDF** hdf_b;
46   perlHDF a, b;
47   SV* sv_a;
48   SV* sv_b;
49   int count;
50   int ret;
51 
52   dSP;
53 
54   hdf_a = (HDF**)in_a;
55   hdf_b = (HDF**)in_b;
56 
57   /* convert to a type Perl can access */
58   a.hdf = *hdf_a;
59   a.err = STATUS_OK;
60   b.hdf = *hdf_b;
61   b.err = STATUS_OK;
62 
63   ENTER;
64   SAVETMPS;
65 
66   PUSHMARK(SP);
67   sv_a = sv_newmortal();
68   sv_setref_pv(sv_a, "ClearSilver::HDF", (void*)&a);
69 
70   sv_b = sv_newmortal();
71   sv_setref_pv(sv_b, "ClearSilver::HDF", (void*)&b);
72 
73   XPUSHs(sv_a);
74   XPUSHs(sv_b);
75 
76   PUTBACK;
77 
78   count = call_pv(g_sort_func_name, G_SCALAR);
79 
80   SPAGAIN;
81 
82   if (count != 1)
83     croak("Big trouble\n");
84 
85   PUTBACK;
86 
87   ret = POPi;
88 
89   FREETMPS;
90   LEAVE;
91 
92   return ret;
93 }
94 
95 
96 
97 
98 
99 MODULE = ClearSilver		PACKAGE = ClearSilver::HDF	PREFIX = perlhdf_
100 
101 ClearSilver::HDF
102 perlhdf_new(self)
103         char* self
104     PREINIT:
105 	ClearSilver__HDF hdf;
106     CODE:
107 	debug("%s\n", self);
108 	hdf = (ClearSilver__HDF)malloc(sizeof(perlHDF));
109 	if (!hdf) {
110 	  RETVAL = NULL;
111 	} else {
112 	  hdf->err = hdf_init(&(hdf->hdf));
113 	  RETVAL = hdf;
114 	}
115     OUTPUT:
116         RETVAL
117 
118 void
119 perlhdf_DESTROY(hdf)
120         ClearSilver::HDF hdf;
121     CODE:
122         debug("hdf_DESTROY:%x\n", hdf);
123         hdf_destroy(&(hdf->hdf));
124 
125 
126 int
127 perlhdf_setValue(hdf, key, value)
128 	ClearSilver::HDF hdf
129 	char* key
130 	char* value
131     CODE:
132         hdf->err = hdf_set_value(hdf->hdf, key, value);
133 	if (hdf->err == STATUS_OK) {
134 	    RETVAL = 0;
135 	} else {
136 	    RETVAL = 1;
137 	}
138     OUTPUT:
139         RETVAL
140 
141 
142 char*
143 perlhdf_getValue(hdf, key, default_value)
144 	ClearSilver::HDF hdf
145 	char* key
146 	char* default_value
147     CODE:
148         RETVAL = hdf_get_value(hdf->hdf, key, default_value);
149     OUTPUT:
150         RETVAL
151 
152 
153 int
154 perlhdf_copy(hdf, name, src);
155         ClearSilver::HDF hdf
156         char* name
157         ClearSilver::HDF src
158     CODE:
159         hdf->err = hdf_copy(hdf->hdf, name, src->hdf);
160         if (hdf->err == STATUS_OK) {
161             RETVAL = 0;
162         } else {
163             RETVAL = 1;
164         }
165     OUTPUT:
166         RETVAL
167 
168 int
169 perlhdf_readFile(hdf, filename)
170 	ClearSilver::HDF hdf
171 	char* filename
172     CODE:
173         hdf->err = hdf_read_file(hdf->hdf, filename);
174 	if (hdf->err == STATUS_OK) {
175 	    RETVAL = 1;
176 	} else {
177 	    RETVAL = 0;
178 	}
179     OUTPUT:
180         RETVAL
181 
182 int
183 perlhdf_writeFile(hdf, filename)
184        ClearSilver::HDF hdf
185        char* filename
186     CODE:
187         hdf->err = hdf_write_file(hdf->hdf, filename);
188        if (hdf->err == STATUS_OK) {
189            RETVAL = 1;
190        } else {
191            RETVAL = 0;
192        }
193     OUTPUT:
194         RETVAL
195 
196 ClearSilver::HDF
197 perlhdf_getObj(hdf, name)
198 	ClearSilver::HDF hdf;
199 	char* name
200     PREINIT:
201 	HDF* tmp_hdf;
202 	perlHDF* perlhdf;
203     CODE:
204 	do {
205 	    tmp_hdf = hdf_get_obj(hdf->hdf, name);
206 	    if (!tmp_hdf) {
207 	        RETVAL = NULL;
208 		break;
209 	    }
210 	    perlhdf = (perlHDF*)malloc(sizeof(perlHDF));
211 	    if (!perlhdf) {
212 	        RETVAL = NULL;
213 	        break;
214 	    }
215             perlhdf->hdf = tmp_hdf;
216 	    perlhdf->err = STATUS_OK;
217 	    RETVAL = perlhdf;
218 	} while (0);
219     OUTPUT:
220         RETVAL
221 
222 ClearSilver::HDF
223 perlhdf_objChild(hdf)
224 	ClearSilver::HDF hdf;
225     PREINIT:
226 	HDF* tmp_hdf;
227 	perlHDF* child;
228     CODE:
229 	do {
230 	    tmp_hdf = hdf_obj_child(hdf->hdf);
231 	    if (!tmp_hdf) {
232 	        RETVAL = NULL;
233 		break;
234 	    }
235 	    child = (perlHDF*)malloc(sizeof(perlHDF));
236 	    if (!child) {
237 	        RETVAL = NULL;
238 	        break;
239 	    }
240             child->hdf = tmp_hdf;
241 	    child->err = STATUS_OK;
242 	    RETVAL = child;
243 	} while (0);
244     OUTPUT:
245         RETVAL
246 
247 
248 ClearSilver::HDF
249 perlhdf_getChild(hdf, name)
250 	ClearSilver::HDF hdf;
251 	char* name;
252     PREINIT:
253 	HDF* tmp_hdf;
254 	perlHDF* child;
255     CODE:
256 	do {
257 	    tmp_hdf = hdf_get_child(hdf->hdf, name);
258 	    if (!tmp_hdf) {
259 	        RETVAL = NULL;
260 		break;
261 	    }
262 	    child = (perlHDF*)malloc(sizeof(perlHDF));
263 	    if (!child) {
264 	        RETVAL = NULL;
265 	        break;
266 	    }
267             child->hdf = tmp_hdf;
268 	    child->err = STATUS_OK;
269 	    RETVAL = child;
270 	} while (0);
271     OUTPUT:
272         RETVAL
273 
274 char*
275 perlhdf_objValue(hdf)
276 	ClearSilver::HDF hdf;
277     CODE:
278 	RETVAL = hdf_obj_value(hdf->hdf);
279     OUTPUT:
280         RETVAL
281 
282 char*
283 perlhdf_objName(hdf)
284 	ClearSilver::HDF hdf;
285     CODE:
286 	RETVAL = hdf_obj_name(hdf->hdf);
287     OUTPUT:
288         RETVAL
289 
290 ClearSilver::HDF
291 perlhdf_objNext(hdf)
292 	ClearSilver::HDF hdf;
293     PREINIT:
294 	HDF* tmp_hdf;
295 	perlHDF* next;
296     CODE:
297 	do {
298 	    tmp_hdf = hdf_obj_next(hdf->hdf);
299 	    if (!tmp_hdf) {
300 	        RETVAL = NULL;
301 		break;
302 	    }
303 	    next = (perlHDF*)malloc(sizeof(perlHDF));
304 	    if (!next) {
305 	      RETVAL = NULL;
306 	      break;
307             }
308 	    next->hdf = tmp_hdf;
309 	    next->err = STATUS_OK;
310 	    RETVAL = next;
311 	} while (0);
312     OUTPUT:
313         RETVAL
314 
315 int
316 perlhdf_sortObj(hdf, func_name)
317 	ClearSilver::HDF hdf;
318 	char* func_name;
319     PREINIT:
320         NEOERR* err;
321     CODE:
322 	g_sort_func_name = func_name;
323         err = hdf_sort_obj(hdf->hdf, sortFunction);
324         RETVAL = 0;
325     OUTPUT:
326         RETVAL
327 
328 
329 int
330 perlhdf_setSymlink(hdf, src, dest)
331 	ClearSilver::HDF hdf;
332 	char* src;
333 	char* dest;
334     PREINIT:
335 	NEOERR* err;
336     CODE:
337       	err = hdf_set_symlink (hdf->hdf, src, dest);
338        	if (err == STATUS_OK) {
339        	    RETVAL = 1;
340        	} else {
341        	    RETVAL = 0;
342        	}
343     OUTPUT:
344         RETVAL
345 
346 
347 int
348 perlhdf_removeTree(hdf, name)
349 	ClearSilver::HDF hdf;
350 	char* name;
351     PREINIT:
352         NEOERR* err;
353     CODE:
354         err = hdf_remove_tree(hdf->hdf, name);
355        	if (err == STATUS_OK) {
356        	    RETVAL = 1;
357        	} else {
358        	    RETVAL = 0;
359        	}
360     OUTPUT:
361         RETVAL
362 
363 
364 MODULE = ClearSilver		PACKAGE = ClearSilver::CS	PREFIX = perlcs_
365 
366 ClearSilver::CS
367 perlcs_new(self, hdf)
368 	char* self
369         ClearSilver::HDF hdf;
370     PREINIT:
371         perlCS* cs;
372     CODE:
373 	cs = (perlCS*)malloc(sizeof(perlCS));
374 	if (!cs) {
375 	  RETVAL = NULL;
376 	} else {
377 	  cs->err = cs_init(&(cs->cs), hdf->hdf);
378 	  if (cs->err == STATUS_OK) {
379 	    cs->err = cgi_register_strfuncs(cs->cs);
380 	  }
381 	  RETVAL = cs;
382 	}
383     OUTPUT:
384         RETVAL
385 
386 void
387 perlcs_DESTROY(cs)
388 	ClearSilver::CS cs;
389     CODE:
390 	debug("perlcs_DESTROY() is called\n");
391 	cs_destroy(&(cs->cs));
392 
393 void
394 perlcs_displayError(cs)
395 	ClearSilver::CS cs;
396     CODE:
397 	nerr_log_error(cs->err);
398 
399 char *
perlcs_render(cs)400 perlcs_render(cs)
401 	ClearSilver::CS cs
402     CODE:
403     {
404 	SV *str = newSV(0);
405 	cs->err = cs_render(cs->cs, str, output);
406 	if (cs->err == STATUS_OK) {
407 	  ST(0) = sv_2mortal(str);
408 	} else {
409 	  SvREFCNT_dec(str);
410 	  ST(0) = &PL_sv_undef;
411 	}
412 	XSRETURN(1);
413     }
414 
415 int
416 perlcs_parseFile(cs, cs_file)
417         ClearSilver::CS cs
418 	char* cs_file
419     CODE:
420 	do {
421 	    cs->err =  cs_parse_file(cs->cs, cs_file);
422 	    if (cs->err != STATUS_OK) {
423 	        cs->err = nerr_pass(cs->err);
424 		RETVAL = 0;
425 		break;
426 	    }
427 	    RETVAL = 1;
428         } while (0);
429     OUTPUT:
430         RETVAL
431 
432 int
433 perlcs_parseString(cs, in_str)
434         ClearSilver::CS cs
435 	char* in_str
436     PREINIT:
437 	char* cs_str;
438 	int len;
439     CODE:
440 	do {
441 	    len = strlen(in_str);
442 	    cs_str = (char *)malloc(len);
443 	    if (!cs_str) {
444 	        RETVAL = 0;
445 		break;
446 	    }
447 	    strcpy(cs_str, in_str);
448             cs->err =  cs_parse_string(cs->cs, cs_str, len);
449 	    if (cs->err != STATUS_OK)
450 		RETVAL = 0;
451 	    RETVAL = 1;
452        } while (0);
453     OUTPUT:
454         RETVAL
455 
456 
457 
458