1 #include "EXTERN.h" 2 #include "perl.h" 3 #include "XSUB.h" 4 5 #include "ppport.h" 6 7 #include "template.h" 8 #include "perl_tags.h" 9 10 MODULE = Text::Tmpl PACKAGE = Text::Tmpl PREFIX = template_ 11 PROTOTYPES: ENABLE 12 13 context_p 14 template_init() 15 PREINIT: 16 char *CLASS = NULL; 17 MAGIC *mg = NULL; 18 CLEANUP: 19 mg = mg_find(SvRV(ST(0)), '~'); 20 mg->mg_len = 1; 21 22 int 23 template_set_delimiters(ctx, opentag, closetag) 24 context_p ctx 25 char * opentag 26 char * closetag 27 PREINIT: 28 char *CLASS = NULL; 29 30 void 31 template_set_debug(ctx, debug_level) 32 context_p ctx 33 int debug_level 34 PREINIT: 35 char *CLASS = NULL; 36 37 void 38 template_set_strip(ctx, strip) 39 context_p ctx 40 int strip 41 PREINIT: 42 char *CLASS = NULL; 43 44 int 45 template_set_dir(ctx, directory) 46 context_p ctx 47 char * directory 48 PREINIT: 49 char *CLASS = NULL; 50 51 int 52 template_set_value(ctx, name, value) 53 context_p ctx 54 char * name 55 char * value 56 PREINIT: 57 char *CLASS = NULL; 58 59 char * 60 template_strerror() 61 62 int 63 template_errno() 64 CODE: 65 RETVAL = template_errno; 66 OUTPUT: 67 RETVAL 68 69 void 70 template_DESTROY(ctx) 71 context_p ctx 72 PREINIT: 73 char *CLASS = NULL; 74 MAGIC *mg = mg_find(SvRV(ST(0)), '~'); 75 int destroyme = mg->mg_len; 76 CODE: 77 if (destroyme) 78 { 79 template_destroy(ctx); 80 mg->mg_len = 0; 81 } 82 83 context_p 84 template_loop_iteration(ctx, loop_name) 85 context_p ctx 86 SV * loop_name 87 PREINIT: 88 char *CLASS = NULL; 89 char *r_loop_name = NULL; 90 INIT: 91 if (loop_name == &PL_sv_undef) 92 { 93 XSRETURN_UNDEF; 94 } 95 r_loop_name = (char *)SvPV(loop_name, PL_na); 96 CODE: 97 RETVAL = template_loop_iteration(ctx, r_loop_name); 98 OUTPUT: 99 RETVAL 100 101 context_p 102 template_fetch_loop_iteration(ctx, loop_name, iteration) 103 context_p ctx 104 SV * loop_name 105 SV * iteration 106 PREINIT: 107 char *CLASS = NULL; 108 char *r_loop_name = NULL; 109 int r_iteration = -1; 110 INIT: 111 if (loop_name == &PL_sv_undef) 112 { 113 XSRETURN_UNDEF; 114 } 115 if (iteration == &PL_sv_undef) 116 { 117 XSRETURN_UNDEF; 118 } 119 r_loop_name = (char *)SvPV(loop_name, PL_na); 120 r_iteration = SvIV(iteration); 121 CODE: 122 RETVAL = template_fetch_loop_iteration(ctx, r_loop_name, 123 r_iteration); 124 OUTPUT: 125 RETVAL 126 127 SV * 128 template_parse_file(ctx, template_filename) 129 context_p ctx 130 SV * template_filename 131 PREINIT: 132 char *CLASS = NULL; 133 char *output = NULL; 134 char *r_template_filename = NULL; 135 INIT: 136 if (template_filename == &PL_sv_undef) 137 { 138 XSRETURN_UNDEF; 139 } 140 r_template_filename = (char *)SvPV(template_filename, PL_na); 141 CODE: 142 template_parse_file(ctx, r_template_filename, &output); 143 if (output != NULL) 144 { 145 RETVAL = newSVpv(output, strlen(output)); 146 template_free_output(output); 147 } 148 else 149 { 150 XSRETURN_UNDEF; 151 } 152 OUTPUT: 153 RETVAL 154 155 SV * 156 template_parse_string(ctx, template) 157 context_p ctx 158 SV * template 159 PREINIT: 160 char *CLASS = NULL; 161 char *output = NULL; 162 char *r_template = NULL; 163 INIT: 164 if (template == &PL_sv_undef) 165 { 166 XSRETURN_UNDEF; 167 } 168 r_template = (char *)SvPV(template, PL_na); 169 CODE: 170 template_parse_string(ctx, r_template, &output); 171 if (output != NULL) 172 { 173 RETVAL = newSVpv(output, strlen(output)); 174 template_free_output(output); 175 } 176 else 177 { 178 XSRETURN_UNDEF; 179 } 180 OUTPUT: 181 RETVAL 182 183 int 184 template_register_simple(ctx, name, code) 185 context_p ctx 186 char * name 187 CV * code 188 PREINIT: 189 char *CLASS = NULL; 190 HV *stags; 191 HV *perl_simple_tags = perl_get_hv(PERL_TAGS_SIMPLE_TAG_HASH, 192 TRUE); 193 char key[20]; 194 INIT: 195 snprintf(key, 20, "%p", context_root(ctx)); 196 197 if (hv_exists(perl_simple_tags, key, strlen(key))) 198 { 199 stags = (HV *)SvRV(*(hv_fetch(perl_simple_tags, key, 200 strlen(key), FALSE))); 201 } 202 else 203 { 204 stags = newHV(); 205 hv_store(perl_simple_tags, key, strlen(key), 206 newRV((SV *)stags), 0); 207 } 208 CODE: 209 hv_store(stags, name, strlen(name), newRV((SV*)code), 0); 210 RETVAL = template_register_simple(ctx, name, perl_simple_tag); 211 OUTPUT: 212 RETVAL 213 214 int 215 template_alias_simple(ctx, old_name, new_name) 216 context_p ctx 217 char * old_name 218 char * new_name 219 PREINIT: 220 char *CLASS = NULL; 221 HV *perl_simple_tags = perl_get_hv(PERL_TAGS_SIMPLE_TAG_HASH, 222 TRUE); 223 SV *cref = &PL_sv_undef; 224 HV *stags = NULL; 225 char key[20]; 226 INIT: 227 snprintf(key, 20, "%p", context_root(ctx)); 228 229 if (hv_exists(perl_simple_tags, key, strlen(key))) 230 { 231 stags = (HV *)SvRV(*(hv_fetch(perl_simple_tags, key, 232 strlen(key), FALSE))); 233 if (hv_exists(stags, old_name, strlen(old_name))) 234 { 235 cref = *(hv_fetch(stags, old_name, 236 strlen(old_name), FALSE)); 237 } 238 } 239 CODE: 240 if ((cref != &PL_sv_undef) && (SvTYPE(SvRV(cref)) == SVt_PVCV)) 241 { 242 CV *code = (CV *)SvRV(cref); 243 hv_store(stags, new_name, strlen(new_name), 244 newRV((SV *)code), 0); 245 } 246 RETVAL = template_alias_simple(ctx, old_name, new_name); 247 OUTPUT: 248 RETVAL 249 250 251 void 252 template_remove_simple(ctx, name) 253 context_p ctx 254 char * name 255 PREINIT: 256 char *CLASS = NULL; 257 HV *perl_simple_tags = perl_get_hv(PERL_TAGS_SIMPLE_TAG_HASH, 258 TRUE); 259 HV *stags = NULL; 260 char key[20]; 261 INIT: 262 snprintf(key, 20, "%p", context_root(ctx)); 263 264 if (hv_exists(perl_simple_tags, key, strlen(key))) 265 { 266 stags = (HV *)SvRV(*hv_fetch(perl_simple_tags, key, 267 strlen(key), FALSE)); 268 } 269 CODE: 270 if ((stags != NULL) 271 && (hv_exists(stags, name, strlen(name)))) 272 { 273 hv_delete(stags, name, strlen(name), G_DISCARD); 274 } 275 template_remove_simple(ctx, name); 276 277 278 279 int 280 template_register_pair(ctx, named_context, open_name, close_name, code) 281 context_p ctx 282 int named_context 283 char * open_name 284 char * close_name 285 CV * code 286 PREINIT: 287 char *CLASS = NULL; 288 HV *tagps; 289 HV *perl_tag_pairs = perl_get_hv(PERL_TAGS_TAG_PAIR_HASH, TRUE); 290 char key[20]; 291 INIT: 292 snprintf(key, 20, "%p", context_root(ctx)); 293 294 if (hv_exists(perl_tag_pairs, key, strlen(key))) 295 { 296 tagps = (HV *)SvRV(*(hv_fetch(perl_tag_pairs, key, 297 strlen(key), FALSE))); 298 } 299 else 300 { 301 tagps = newHV(); 302 hv_store(perl_tag_pairs, key, strlen(key), 303 newRV((SV *)tagps), 0); 304 } 305 CODE: 306 hv_store(tagps, open_name, strlen(open_name), 307 newRV((SV*)code), 0); 308 RETVAL = template_register_pair(ctx, (char)named_context, 309 open_name, close_name, 310 perl_tag_pair); 311 OUTPUT: 312 RETVAL 313 314 int 315 template_alias_pair(ctx,old_open_name,old_close_name,new_open_name,new_close_name) 316 context_p ctx 317 char * old_open_name 318 char * old_close_name 319 char * new_open_name 320 char * new_close_name 321 PREINIT: 322 char *CLASS = NULL; 323 HV *perl_tag_pairs = perl_get_hv(PERL_TAGS_TAG_PAIR_HASH, 324 TRUE); 325 SV *cref = &PL_sv_undef; 326 HV *tagps = NULL; 327 char key[20]; 328 INIT: 329 snprintf(key, 20, "%p", context_root(ctx)); 330 331 if (hv_exists(perl_tag_pairs, key, strlen(key))) 332 { 333 tagps = (HV *)SvRV(*(hv_fetch(perl_tag_pairs, key, 334 strlen(key), FALSE))); 335 if (hv_exists(tagps, old_open_name, 336 strlen(old_open_name))) 337 { 338 cref = *(hv_fetch(tagps, old_open_name, 339 strlen(old_open_name), 0)); 340 } 341 } 342 CODE: 343 if ((cref != &PL_sv_undef) && (SvTYPE(SvRV(cref)) == SVt_PVCV)) 344 { 345 CV *code = (CV *)SvRV(cref); 346 hv_store(tagps, new_open_name, strlen(new_open_name), 347 newRV((SV *)code), 0); 348 } 349 RETVAL = template_alias_pair(ctx, old_open_name, 350 old_close_name, new_open_name, 351 new_close_name); 352 OUTPUT: 353 RETVAL 354 355 void 356 template_remove_pair(ctx, open_name) 357 context_p ctx 358 char * open_name 359 PREINIT: 360 char *CLASS = NULL; 361 HV *perl_tag_pairs = perl_get_hv(PERL_TAGS_TAG_PAIR_HASH, TRUE); 362 HV *tagps = NULL; 363 char key[20]; 364 INIT: 365 snprintf(key, 20, "%p", context_root(ctx)); 366 367 if (hv_exists(perl_tag_pairs, key, strlen(key))) 368 { 369 tagps = (HV *)SvRV(*hv_fetch(perl_tag_pairs, key, 370 strlen(key), FALSE)); 371 } 372 CODE: 373 if ((tagps != NULL) 374 && (hv_exists(tagps, open_name, strlen(open_name)))) 375 { 376 hv_delete(tagps, open_name, strlen(open_name), 377 G_DISCARD); 378 } 379 template_remove_pair(ctx, open_name); 380 381 char * 382 context_get_value(ctx, name) 383 context_p ctx 384 char * name 385 PREINIT: 386 char *CLASS = NULL; 387 388 context_p 389 context_get_anonymous_child(ctx) 390 context_p ctx 391 PREINIT: 392 char *CLASS = NULL; 393 394 context_p 395 context_get_named_child(ctx, name) 396 context_p ctx 397 char * name 398 PREINIT: 399 char *CLASS = NULL; 400 401 int 402 context_set_named_child(ctx, name) 403 context_p ctx 404 char * name 405 PREINIT: 406 char *CLASS = NULL; 407 408 context_p 409 context_add_peer(ctx) 410 context_p ctx 411 PREINIT: 412 char *CLASS = NULL; 413 414 void 415 context_output_contents(ctx, output_contents) 416 context_p ctx 417 int output_contents 418 PREINIT: 419 char *CLASS = NULL; 420 CODE: 421 context_output_contents(ctx, (char)output_contents); 422