1 /* This file is part of an ocaml binding of an XSLT engine working on Gdome
4 * The code is largely based on the code of T.J. Mather's XML::GDOME::XSLT
5 * Perl module (http://kobesearch.cpan.org/search?dist=XML-GDOME-XSLT)
8 * Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>
9 * Stefano Zacchiroli <zack@cs.unibo.it>
11 * This library is free software; you can redistribute it and/or
12 * modify it under the terms of the GNU Lesser General Public
13 * License as published by the Free Software Foundation; either
14 * version 2.1 of the License, or (at your option) any later version.
16 * This library is distributed in the hope that it will be useful,
17 * but WITHOUT ANY WARRANTY; without even the implied warranty of
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 * Lesser General Public License for more details.
21 * You should have received a copy of the GNU Lesser General Public
22 * License along with this library; if not, write to the Free Software
23 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25 * For more information, please send an email to {sacerdot,zack}@cs.unibo.it
30 #include <caml/memory.h>
31 #include <caml/custom.h>
32 #include <caml/callback.h>
33 #include <caml/mlvalues.h>
35 #include <libxslt/xsltconfig.h>
36 #include <libxslt/imports.h>
39 #include "mlgdomevalue.h"
40 #include "gdome_xslt.h"
42 xsltStylesheetPtr XsltStylesheetPtr_val(value);
44 static void ml_xsltFreeStylesheet(value v)
46 xsltFreeStylesheet(XsltStylesheetPtr_val(v));
49 xsltStylesheetPtr XsltStylesheetPtr_val(value v)
52 xsltStylesheetPtr res = *((xsltStylesheetPtr*) Data_custom_val(v));
56 value Val_XsltStylesheetPtr(xsltStylesheetPtr obj)
60 static struct custom_operations ops = {
61 "http://www.cs.unibo.it/helm/gdome_xslt/XsltStylesheetPtr",
62 ml_xsltFreeStylesheet,
63 custom_compare_default,
65 custom_serialize_default,
66 custom_deserialize_default
69 v = alloc_custom(&ops, sizeof(xsltStylesheetPtr), 0, 1);
70 *((xsltStylesheetPtr*) Data_custom_val(v)) = obj;
75 value ml_processStylesheet(value style)
78 xsltStylesheetPtr res;
79 res = processStylesheet(Document_val(style));
82 excp = caml_named_value("ProcessStylesheetException");
84 raise_constant(*excp);
86 CAMLreturn(Val_XsltStylesheetPtr(res));
89 value setXsltMaxDepth(value depth)
92 xsltMaxDepth = Int_val(depth);
96 value ml_applyStylesheet(value source, value style, value params)
98 CAMLparam3(source,style,params);
102 const char** c_params;
104 i = 0 ; list = params;
105 while(list != Val_int(0)) {
106 list = Field(list,1);
109 c_params = (const char **)malloc(sizeof(char *) * (i * 2 + 1));
111 i = 0; list = params;
112 while(list != Val_int(0)) {
113 c_params[i] = String_val(Field(Field(list,0),0));
114 c_params[i+1] = String_val(Field(Field(list,0),1));
115 list = Field(list,1);
119 enter_blocking_section();
120 res = applyStylesheet(Document_val(source),
121 XsltStylesheetPtr_val(style),
123 leave_blocking_section();
127 excp = caml_named_value("ApplyStylesheetException");
128 assert(excp != NULL);
129 raise_constant(*excp);
131 CAMLreturn(Val_Document(res));
134 value ml_saveResultToChannel(value channel,
138 CAMLparam3(channel, result, stylesheet);
140 saveResultToFd((Channel(channel))->fd,
141 Document_val(result),
142 XsltStylesheetPtr_val(stylesheet));
147 /* error callback handling */
149 static void ml_gdomeXsltErrorCallback(const char *msg) {
150 callback(*caml_named_value("error_callback"), copy_string(msg));
155 value ml_enableErrorCallback(value unit) {
157 setErrorCallback(ml_gdomeXsltErrorCallback);
158 CAMLreturn(Val_unit);
161 value ml_disableErrorCallback(value unit) {
163 setErrorCallback(NULL);
164 CAMLreturn(Val_unit);
167 /* debug callback handling */
169 static void ml_gdomeXsltDebugCallback(const char *msg) {
170 callback(*caml_named_value("debug_callback"), copy_string(msg));
175 value ml_enableDebugCallback(value unit) {
177 setDebugCallback(ml_gdomeXsltDebugCallback);
178 CAMLreturn(Val_unit);
181 value ml_disableDebugCallback(value unit) {
183 setDebugCallback(NULL);
184 CAMLreturn(Val_unit);