+++ /dev/null
-/* This file is part of an ocaml binding of an XSLT engine working on Gdome
- * documents.
- *
- * The code is largely based on the code of T.J. Mather's XML::GDOME::XSLT
- * Perl module (http://kobesearch.cpan.org/search?dist=XML-GDOME-XSLT)
- *
- * Copyright (C) 2002:
- * Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>
- * Stefano Zacchiroli <zack@cs.unibo.it>
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- *
- * For more information, please send an email to {sacerdot,zack}@cs.unibo.it
- */
-
-#include <assert.h>
-
-#include <caml/memory.h>
-#include <caml/custom.h>
-#include <caml/callback.h>
-#include <caml/mlvalues.h>
-
-#include <libxslt/xsltconfig.h>
-#include <libxslt/imports.h>
-
-#include "ocaml-io.h"
-#include "mlgdomevalue.h"
-#include "gdome_xslt.h"
-
-xsltStylesheetPtr XsltStylesheetPtr_val(value);
-
-static void ml_xsltFreeStylesheet(value v)
-{
- xsltFreeStylesheet(XsltStylesheetPtr_val(v));
-}
-
-xsltStylesheetPtr XsltStylesheetPtr_val(value v)
-{
- CAMLparam1(v);
- xsltStylesheetPtr res = *((xsltStylesheetPtr*) Data_custom_val(v));
- CAMLreturn(res);
-}
-
-value Val_XsltStylesheetPtr(xsltStylesheetPtr obj)
-{
- CAMLparam0();
- CAMLlocal1(v);
- static struct custom_operations ops = {
- "http://www.cs.unibo.it/helm/gdome_xslt/XsltStylesheetPtr",
- ml_xsltFreeStylesheet,
- custom_compare_default,
- custom_hash_default,
- custom_serialize_default,
- custom_deserialize_default
- };
-
- v = alloc_custom(&ops, sizeof(xsltStylesheetPtr), 0, 1);
- *((xsltStylesheetPtr*) Data_custom_val(v)) = obj;
-
- CAMLreturn(v);
-}
-
-value ml_processStylesheet(value style)
-{
- CAMLparam1(style);
- xsltStylesheetPtr res;
- res = processStylesheet(Document_val(style));
- if (res == NULL) {
- value* excp;
- excp = caml_named_value("ProcessStylesheetException");
- assert(excp != NULL);
- raise_constant(*excp);
- }
- CAMLreturn(Val_XsltStylesheetPtr(res));
-}
-
-value setXsltMaxDepth(value depth)
-{
- CAMLparam1(depth);
- xsltMaxDepth = Int_val(depth);
- CAMLreturn0;
-}
-
-value ml_applyStylesheet(value source, value style, value params)
-{
- CAMLparam3(source,style,params);
- CAMLlocal1(list);
- GdomeDocument* res;
- int i;
- const char** c_params;
-
- i = 0 ; list = params;
- while(list != Val_int(0)) {
- list = Field(list,1);
- i++;
- }
- c_params = (const char **)malloc(sizeof(char *) * (i * 2 + 1));
-
- i = 0; list = params;
- while(list != Val_int(0)) {
- c_params[i] = String_val(Field(Field(list,0),0));
- c_params[i+1] = String_val(Field(Field(list,0),1));
- list = Field(list,1);
- i+=2;
- }
- c_params[i] = NULL;
- enter_blocking_section();
- res = applyStylesheet(Document_val(source),
- XsltStylesheetPtr_val(style),
- c_params);
- leave_blocking_section();
- free(c_params);
- if (res == NULL) {
- value* excp;
- excp = caml_named_value("ApplyStylesheetException");
- assert(excp != NULL);
- raise_constant(*excp);
- }
- CAMLreturn(Val_Document(res));
-}
-
-value ml_saveResultToChannel(value channel,
- value result,
- value stylesheet)
-{
- CAMLparam3(channel, result, stylesheet);
-
- saveResultToFd((Channel(channel))->fd,
- Document_val(result),
- XsltStylesheetPtr_val(stylesheet));
-
- CAMLreturn0;
-}
-
- /* error callback handling */
-
-static void ml_gdomeXsltErrorCallback(const char *msg) {
- callback(*caml_named_value("error_callback"), copy_string(msg));
-
- return;
-}
-
-value ml_enableErrorCallback(value unit) {
- CAMLparam1(unit);
- setErrorCallback(ml_gdomeXsltErrorCallback);
- CAMLreturn(Val_unit);
-}
-
-value ml_disableErrorCallback(value unit) {
- CAMLparam1(unit);
- setErrorCallback(NULL);
- CAMLreturn(Val_unit);
-}
-
- /* debug callback handling */
-
-static void ml_gdomeXsltDebugCallback(const char *msg) {
- callback(*caml_named_value("debug_callback"), copy_string(msg));
-
- return;
-}
-
-value ml_enableDebugCallback(value unit) {
- CAMLparam1(unit);
- setDebugCallback(ml_gdomeXsltDebugCallback);
- CAMLreturn(Val_unit);
-}
-
-value ml_disableDebugCallback(value unit) {
- CAMLparam1(unit);
- setDebugCallback(NULL);
- CAMLreturn(Val_unit);
-}
-