1 (** Wrapper around Perl [Template] class (Template Toolkit). *)
2 (* Copyright (C) 2003 Dave Benjamin <dave@3dex.com>.
4 This library is free software; you can redistribute it and/or
5 modify it under the terms of the GNU Library General Public
6 License as published by the Free Software Foundation; either
7 version 2 of the License, or (at your option) any later version.
9 This library is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 Library General Public License for more details.
14 You should have received a copy of the GNU General Public License
15 along with this library; see the file COPYING. If not, write to
16 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17 Boston, MA 02111-1307, USA.
19 $Id: pl_Template.ml,v 1.3 2008-03-01 13:02:21 rich Exp $
24 let _ = eval "use Template"
26 exception Not_implemented
27 exception Error of string
40 | Hash of (string * t) list;;
44 let rec sv_of_variant = function
45 | Variant.Null -> sv_undef ()
46 | Variant.String s -> sv_of_string s
47 | Variant.Int i -> sv_of_int i
48 | Variant.Float f -> sv_of_float f
49 | Variant.Bool b -> sv_of_bool b
50 | Variant.Array xs -> arrayref (av_of_sv_list (List.map sv_of_variant xs))
51 | Variant.Hash xs -> hashref
52 (let hv = hv_empty () in
53 List.iter (fun (k, v) -> hv_set hv k (sv_of_variant v)) xs;
57 let hv_of_string_pair_list pairs =
58 let hv = hv_empty () in
59 List.iter (fun (k, v) -> hv_set hv k (sv_of_string v)) pairs;
66 method process file vars =
67 let output = sv_of_string "" in
68 let args = [sv_of_string file; sv_of_variant vars; scalarref output] in
69 let result = call_method sv "process" args in
70 if not (sv_is_true result) then
71 raise (Error self#error)
76 string_of_sv (call_method sv "error" [])
80 let may f = function None -> () | Some v -> f v
82 let new_ ?start_tag ?end_tag ?tag_style ?pre_chomp ?post_chomp ?trim
83 ?interpolate ?anycase ?include_path ?delimiter ?absolute ?relative
84 ?default ?blocks ?auto_reset ?recursion ?variables ?constants
85 ?constant_namespace ?namespace ?pre_process ?post_process ?process
86 ?wrapper ?error ?errors ?eval_perl ?output ?output_path ?debug ?debug_format
87 ?cache_size ?compile_ext ?compile_dir ?plugins ?plugin_base ?load_perl
88 ?filters ?v1dollar ?load_templates ?load_plugins ?load_filters
89 ?tolerant ?service ?context ?stash ?parser ?grammar () =
93 args := sv_of_string "START_TAG" :: sv_of_string v :: !args) start_tag;
95 args := sv_of_string "END_TAG" :: sv_of_string v :: !args) end_tag;
97 args := sv_of_string "TAG_STYLE" :: sv_of_string v :: !args) tag_style;
99 args := sv_of_string "PRE_CHOMP" :: sv_of_bool v :: !args) pre_chomp;
101 args := sv_of_string "POST_CHOMP" :: sv_of_bool v :: !args) post_chomp;
103 args := sv_of_string "TRIM" :: sv_of_bool v :: !args) trim;
105 args := sv_of_string "INTERPOLATE" :: sv_of_bool v :: !args) interpolate;
107 args := sv_of_string "ANYCASE" :: sv_of_bool v :: !args) anycase;
109 args := sv_of_string "INCLUDE_PATH" :: arrayref (av_of_string_list v) :: !args) include_path;
111 args := sv_of_string "DELIMITER" :: sv_of_string v :: !args) delimiter;
113 args := sv_of_string "ABSOLUTE" :: sv_of_bool v :: !args) absolute;
115 args := sv_of_string "RELATIVE" :: sv_of_bool v :: !args) relative;
117 args := sv_of_string "DEFAULT" :: sv_of_string v :: !args) default;
119 args := sv_of_string "BLOCKS" :: hashref (hv_of_string_pair_list v) :: !args) blocks;
121 args := sv_of_string "AUTO_RESET" :: sv_of_bool v :: !args) auto_reset;
123 args := sv_of_string "RECURSION" :: sv_of_bool v :: !args) recursion;
125 args := sv_of_string "VARIABLES" :: sv_of_variant v :: !args) variables;
127 args := sv_of_string "CONSTANTS" :: sv_of_variant v :: !args) constants;
129 args := sv_of_string "CONSTANT_NAMESPACE" :: sv_of_string v :: !args) constant_namespace;
131 args := sv_of_string "NAMESPACE" :: sv_of_variant v :: !args) namespace;
133 args := sv_of_string "PRE_PROCESS" :: arrayref (av_of_string_list v) :: !args) pre_process;
135 args := sv_of_string "POST_PROCESS" :: arrayref (av_of_string_list v) :: !args) post_process;
137 args := sv_of_string "PROCESS" :: arrayref (av_of_string_list v) :: !args) process;
139 args := sv_of_string "WRAPPER" :: arrayref (av_of_string_list v) :: !args) wrapper;
141 args := sv_of_string "ERROR" :: sv_of_string v :: !args) error;
143 args := sv_of_string "ERRORS" :: hashref (hv_of_string_pair_list v) :: !args) errors;
145 args := sv_of_string "EVAL_PERL" :: sv_of_bool v :: !args) eval_perl;
147 raise Not_implemented) output;
149 raise Not_implemented) output_path;
151 args := sv_of_string "DEBUG" :: sv_of_string v :: !args) debug;
153 args := sv_of_string "DEBUG_FORMAT" :: sv_of_string v :: !args) debug_format;
155 args := sv_of_string "CACHE_SIZE" :: sv_of_int v :: !args) cache_size;
157 args := sv_of_string "COMPILE_EXT" :: sv_of_string v :: !args) compile_ext;
159 args := sv_of_string "COMPILE_DIR" :: sv_of_string v :: !args) compile_dir;
161 args := sv_of_string "PLUGINS" :: hashref (hv_of_string_pair_list v) :: !args) plugins;
163 args := sv_of_string "PLUGIN_BASE" :: arrayref (av_of_string_list v) :: !args) plugin_base;
165 args := sv_of_string "LOAD_PERL" :: sv_of_bool v :: !args) load_perl;
167 raise Not_implemented) filters;
169 args := sv_of_string "V1DOLLAR" :: sv_of_bool v :: !args) v1dollar;
171 raise Not_implemented) load_templates;
173 raise Not_implemented) load_plugins;
175 raise Not_implemented) load_filters;
177 args := sv_of_string "TOLERANT" :: sv_of_bool v :: !args) tolerant;
179 raise Not_implemented) service;
181 raise Not_implemented) context;
183 raise Not_implemented) stash;
185 raise Not_implemented) parser;
187 raise Not_implemented) grammar;
188 let sv = call_class_method "Template" "new" !args in