Home | History | Annotate | Download | only in perl
      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 
     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 
     35 static NEOERR *output (void *ctx, char *s)
     36 {
     37   sv_catpv((SV*)ctx, s);
     38 
     39   return STATUS_OK;
     40 }
     41 
     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 *
    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