helm/DEVEL/gdome_xslt/ocaml/gdome_xslt/ml_gdome_xslt.c

   1 /* This file is part of an ocaml binding of an XSLT engine working on Gdome
   2  * documents.
   3  *
   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)
   6  *
   7  * Copyright (C) 2002:
   8  *      Claudio Sacerdoti Coen  <sacerdot@cs.unibo.it>
   9  *      Stefano Zacchiroli      <zack@cs.unibo.it>
  10  *
  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.
  15  *
  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.
  20  *
  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
  24  *
  25  * For more information, please send an email to {sacerdot,zack}@cs.unibo.it
  26  */
  27
  28 #include <assert.h>
  29
  30 #include <caml/memory.h>
  31 #include <caml/custom.h>
  32 #include <caml/callback.h>
  33 #include <caml/mlvalues.h>
  34
  35 #include <libxslt/xsltconfig.h>
  36 #include <libxslt/imports.h>
  37
  38 #include "ocaml-io.h"
  39 #include "mlgdomevalue.h"
  40 #include "gdome_xslt.h"
  41
  42 xsltStylesheetPtr XsltStylesheetPtr_val(value);
  43
  44 static void ml_xsltFreeStylesheet(value v)
  45 {
  46    xsltFreeStylesheet(XsltStylesheetPtr_val(v));
  47 }
  48
  49 xsltStylesheetPtr XsltStylesheetPtr_val(value v)
  50 {
  51    CAMLparam1(v);
  52    xsltStylesheetPtr res = *((xsltStylesheetPtr*) Data_custom_val(v));
  53    CAMLreturn(res);
  54 }
  55
  56 value Val_XsltStylesheetPtr(xsltStylesheetPtr obj)
  57 {
  58    CAMLparam0();
  59    CAMLlocal1(v);
  60    static struct custom_operations ops = {
  61       "http://www.cs.unibo.it/helm/gdome_xslt/XsltStylesheetPtr",
  62       ml_xsltFreeStylesheet,
  63       custom_compare_default,
  64       custom_hash_default,
  65       custom_serialize_default,
  66       custom_deserialize_default
  67    };
  68
  69    v = alloc_custom(&ops, sizeof(xsltStylesheetPtr), 0, 1);
  70    *((xsltStylesheetPtr*) Data_custom_val(v)) = obj;
  71
  72    CAMLreturn(v);
  73 }
  74
  75 value ml_processStylesheet(value style)
  76 {
  77    CAMLparam1(style);
  78    xsltStylesheetPtr res;
  79    res = processStylesheet(Document_val(style));
  80    if (res == NULL) {
  81       value* excp;
  82       excp = caml_named_value("ProcessStylesheetException");
  83       assert(excp != NULL);
  84       raise_constant(*excp);
  85    }
  86    CAMLreturn(Val_XsltStylesheetPtr(res));
  87 }
  88
  89 value setXsltMaxDepth(value depth)
  90 {
  91    CAMLparam1(depth);
  92    xsltMaxDepth = Int_val(depth);
  93    CAMLreturn0;
  94 }
  95
  96 value ml_applyStylesheet(value source, value style, value params)
  97 {
  98    CAMLparam3(source,style,params);
  99    CAMLlocal1(list);
 100    GdomeDocument* res;
 101    int i;
 102    const char** c_params;
 103
 104    i = 0 ; list = params;
 105    while(list != Val_int(0)) {
 106       list = Field(list,1);
 107       i++;
 108    }
 109    c_params = (const char **)malloc(sizeof(char *) * (i * 2 + 1));
 110
 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);
 116       i+=2;
 117    }
 118    c_params[i] = NULL;
 119    enter_blocking_section();
 120    res = applyStylesheet(Document_val(source),
 121                          XsltStylesheetPtr_val(style),
 122                          c_params);
 123    leave_blocking_section();
 124    free(c_params);
 125    if (res == NULL) {
 126       value* excp;
 127       excp = caml_named_value("ApplyStylesheetException");
 128       assert(excp != NULL);
 129       raise_constant(*excp);
 130    }
 131    CAMLreturn(Val_Document(res));
 132 }
 133
 134 value ml_saveResultToChannel(value channel,
 135                              value result,
 136                              value stylesheet)
 137 {
 138         CAMLparam3(channel, result, stylesheet);
 139
 140         saveResultToFd((Channel(channel))->fd,
 141                       Document_val(result),
 142                       XsltStylesheetPtr_val(stylesheet));
 143
 144         CAMLreturn0;
 145 }
 146
 147         /* error callback handling */
 148
 149 static void ml_gdomeXsltErrorCallback(const char *msg) {
 150         callback(*caml_named_value("error_callback"), copy_string(msg));
 151
 152         return;
 153 }
 154
 155 value ml_enableErrorCallback(value unit) {
 156         CAMLparam1(unit);
 157         setErrorCallback(ml_gdomeXsltErrorCallback);
 158         CAMLreturn(Val_unit);
 159 }
 160
 161 value ml_disableErrorCallback(value unit) {
 162         CAMLparam1(unit);
 163         setErrorCallback(NULL);
 164         CAMLreturn(Val_unit);
 165 }
 166
 167         /* debug callback handling */
 168
 169 static void ml_gdomeXsltDebugCallback(const char *msg) {
 170         callback(*caml_named_value("debug_callback"), copy_string(msg));
 171
 172         return;
 173 }
 174
 175 value ml_enableDebugCallback(value unit) {
 176         CAMLparam1(unit);
 177         setDebugCallback(ml_gdomeXsltDebugCallback);
 178         CAMLreturn(Val_unit);
 179 }
 180
 181 value ml_disableDebugCallback(value unit) {
 182         CAMLparam1(unit);
 183         setDebugCallback(NULL);
 184         CAMLreturn(Val_unit);
 185 }
 186