From: rich Date: Fri, 13 Feb 2004 10:37:16 +0000 (+0000) Subject: Contributed Template Toolkit wrapper. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=efab5abed48d08e735c652c8454d14393c006c0e;p=perl4caml.git Contributed Template Toolkit wrapper. --- diff --git a/AUTHORS b/AUTHORS index 99a81d0..eceaec2 100644 --- 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 --- 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 index 0000000..1c830dd --- /dev/null +++ b/wrappers/pl_Template.ml @@ -0,0 +1,173 @@ +(** Wrapper around Perl [Template] class (Template Toolkit). + * + * Author: Dave Benjamin . + *) + +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