Contributed Template Toolkit wrapper.

diff --git a/AUTHORS b/AUTHORS
index 99a81d0..eceaec2 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -4,4 +4,8 @@ Richard W.M. Jones (rich@annexia.org)
 
 Olivier Andrieu
 
-- Helped me to work around OCaml initialization bug.
\ No newline at end of file
+- Helped me to work around OCaml initialization bug.
+
+Dave Benjamin (dave at 3dex dot com)
+
+- Implemented Template Toolkit wrapper.
\ No newline at end of file

diff --git a/Makefile b/Makefile
index 517d4eb..61ec162 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
 # Interface to Perl from OCaml.
 # Copyright (C) 2003 Merjis Ltd.
-# $Id: Makefile,v 1.19 2003-11-19 16:28:22 rich Exp $
+# $Id: Makefile,v 1.20 2004-02-13 10:37:16 rich Exp $
 
 include Makefile.config
 
@@ -46,7 +46,8 @@ WRAPPERS := \
        wrappers/pl_HTTP_Message.cmo \
        wrappers/pl_HTTP_Request.cmo \
        wrappers/pl_HTTP_Response.cmo \
-       wrappers/pl_LWP_UserAgent.cmo
+       wrappers/pl_LWP_UserAgent.cmo \
+       wrappers/pl_Template.cmo
 
 all:   perl4caml.cma perl4caml.cmxa META all-examples html
 

diff --git a/wrappers/pl_Template.ml b/wrappers/pl_Template.ml
new file mode 100644 (file)
index 0000000..1c830dd
--- /dev/null
+++ b/wrappers/pl_Template.ml
@@ -0,0 +1,173 @@
+(** Wrapper around Perl [Template] class (Template Toolkit).
+  * 
+  * Author: Dave Benjamin <dave@3dex.com>.
+  *)
+
+open Perl
+
+let _ = eval "use Template"
+
+exception Not_implemented
+exception Error of string
+
+module Variant =
+
+struct
+
+  type variant =
+    | Null
+    | String of string
+    | Int of int
+    | Float of float
+    | Bool of bool
+    | Array of variant list
+    | Hash of (string * variant) list;;
+
+end
+
+let rec sv_of_variant = function
+  | Variant.Null -> sv_undef ()
+  | Variant.String s -> sv_of_string s
+  | Variant.Int i -> sv_of_int i
+  | Variant.Float f -> sv_of_float f
+  | Variant.Bool b -> sv_of_bool b
+  | Variant.Array xs -> arrayref (av_of_sv_list (List.map sv_of_variant xs))
+  | Variant.Hash xs -> hashref
+      (let hv = hv_empty () in
+         List.iter (fun (k, v) -> hv_set hv k (sv_of_variant v)) xs;
+         hv
+      );;
+
+let hv_of_string_pair_list pairs =
+  let hv = hv_empty () in
+    List.iter (fun (k, v) -> hv_set hv k (sv_of_string v)) pairs;
+    hv
+
+class template sv =
+
+object (self)
+
+  method process file vars =
+    let output = sv_of_string "" in
+    let args = [sv_of_string file; sv_of_variant vars; scalarref output] in
+    let result = call_method sv "process" args in
+      if not (sv_is_true result) then
+        raise (Error self#error)
+      else
+        string_of_sv output
+
+  method error =
+    string_of_sv (call_method sv "error" [])
+
+end
+
+let may f = function None -> () | Some v -> f v
+
+let new_ ?start_tag ?end_tag ?tag_style ?pre_chomp ?post_chomp ?trim
+  ?interpolate ?anycase ?include_path ?delimiter ?absolute ?relative
+  ?default ?blocks ?auto_reset ?recursion ?variables ?constants
+  ?constant_namespace ?namespace ?pre_process ?post_process ?process
+  ?wrapper ?error ?errors ?eval_perl ?output ?output_path ?debug ?debug_format
+  ?cache_size ?compile_ext ?compile_dir ?plugins ?plugin_base ?load_perl
+  ?filters ?v1dollar ?load_templates ?load_plugins ?load_filters
+  ?tolerant ?service ?context ?stash ?parser ?grammar () =
+
+  let args = ref [] in
+    may (fun v ->
+           args := sv_of_string "START_TAG" :: sv_of_string v :: !args) start_tag;
+    may (fun v ->
+           args := sv_of_string "END_TAG" :: sv_of_string v :: !args) end_tag;
+    may (fun v ->
+           args := sv_of_string "TAG_STYLE" :: sv_of_string v :: !args) end_tag;
+    may (fun v ->
+           args := sv_of_string "PRE_CHOMP" :: sv_of_bool v :: !args) pre_chomp;
+    may (fun v ->
+           args := sv_of_string "POST_CHOMP" :: sv_of_bool v :: !args) post_chomp;
+    may (fun v ->
+           args := sv_of_string "TRIM" :: sv_of_bool v :: !args) trim;
+    may (fun v ->
+           args := sv_of_string "INTERPOLATE" :: sv_of_bool v :: !args) interpolate;
+    may (fun v ->
+           args := sv_of_string "ANYCASE" :: sv_of_bool v :: !args) anycase;
+    may (fun v ->
+           args := sv_of_string "INCLUDE_PATH" :: arrayref (av_of_string_list v) :: !args) include_path;
+    may (fun v ->
+           args := sv_of_string "DELIMITER" :: sv_of_string v :: !args) delimiter;
+    may (fun v ->
+           args := sv_of_string "ABSOLUTE" :: sv_of_bool v :: !args) absolute;
+    may (fun v ->
+           args := sv_of_string "RELATIVE" :: sv_of_bool v :: !args) relative;
+    may (fun v ->
+           args := sv_of_string "DEFAULT" :: sv_of_string v :: !args) default;
+    may (fun v ->
+           args := sv_of_string "BLOCKS" :: hashref (hv_of_string_pair_list v) :: !args) blocks;
+    may (fun v ->
+           args := sv_of_string "AUTO_RESET" :: sv_of_bool v :: !args) auto_reset;
+    may (fun v ->
+           args := sv_of_string "RECURSION" :: sv_of_bool v :: !args) recursion;
+    may (fun v ->
+           args := sv_of_string "VARIABLES" :: sv_of_variant v :: !args) variables;
+    may (fun v ->
+           args := sv_of_string "CONSTANTS" :: sv_of_variant v :: !args) constants;
+    may (fun v ->
+           args := sv_of_string "CONSTANT_NAMESPACE" :: sv_of_string v :: !args) constant_namespace;
+    may (fun v ->
+           args := sv_of_string "NAMESPACE" :: sv_of_variant v :: !args) namespace;
+    may (fun v ->
+           args := sv_of_string "PRE_PROCESS" :: arrayref (av_of_string_list v) :: !args) pre_process;
+    may (fun v ->
+           args := sv_of_string "POST_PROCESS" :: arrayref (av_of_string_list v) :: !args) post_process;
+    may (fun v ->
+           args := sv_of_string "PROCESS" :: arrayref (av_of_string_list v) :: !args) process;
+    may (fun v ->
+           args := sv_of_string "WRAPPER" :: arrayref (av_of_string_list v) :: !args) wrapper;
+    may (fun v ->
+           args := sv_of_string "ERROR" :: sv_of_string v :: !args) error;
+    may (fun v ->
+           args := sv_of_string "ERRORS" :: hashref (hv_of_string_pair_list v) :: !args) errors;
+    may (fun v ->
+           args := sv_of_string "EVAL_PERL" :: sv_of_bool v :: !args) eval_perl;
+    may (fun v ->
+           raise Not_implemented) output;
+    may (fun v ->
+           raise Not_implemented) output_path;
+    may (fun v ->
+           args := sv_of_string "DEBUG" :: sv_of_string v :: !args) debug;
+    may (fun v ->
+           args := sv_of_string "DEBUG_FORMAT" :: sv_of_string v :: !args) debug_format;
+    may (fun v ->
+           args := sv_of_string "CACHE_SIZE" :: sv_of_int v :: !args) cache_size;
+    may (fun v ->
+           args := sv_of_string "COMPILE_EXT" :: sv_of_string v :: !args) compile_ext;
+    may (fun v ->
+           args := sv_of_string "COMPILE_DIR" :: sv_of_string v :: !args) compile_dir;
+    may (fun v ->
+           args := sv_of_string "PLUGINS" :: hashref (hv_of_string_pair_list v) :: !args) plugins;
+    may (fun v ->
+           args := sv_of_string "PLUGIN_BASE" :: arrayref (av_of_string_list v) :: !args) plugin_base;
+    may (fun v ->
+           args := sv_of_string "LOAD_PERL" :: sv_of_bool v :: !args) load_perl;
+    may (fun v ->
+           raise Not_implemented) filters;
+    may (fun v ->
+           args := sv_of_string "V1DOLLAR" :: sv_of_bool v :: !args) v1dollar;
+    may (fun v ->
+           raise Not_implemented) load_templates;
+    may (fun v ->
+           raise Not_implemented) load_plugins;
+    may (fun v ->
+           raise Not_implemented) load_filters;
+    may (fun v ->
+           args := sv_of_string "TOLERANT" :: sv_of_bool v :: !args) tolerant;
+    may (fun v ->
+           raise Not_implemented) service;
+    may (fun v ->
+           raise Not_implemented) context;
+    may (fun v ->
+           raise Not_implemented) stash;
+    may (fun v ->
+           raise Not_implemented) parser;
+    may (fun v ->
+           raise Not_implemented) grammar;
+    let sv = call_class_method "Template" "new" !args in
+      new template sv