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
  34 #include <libxslt/xsltconfig.h>
  35 #include <libxslt/imports.h>
  36
  37 #include "ocaml-io.h"
  38 #include "mlgdomevalue.h"
  39 #include "gdome_xslt.h"
  40
  41 xsltStylesheetPtr XsltStylesheetPtr_val(value);
  42
  43 static void ml_xsltFreeStylesheet(value v)
  44 {
  45    xsltFreeStylesheet(XsltStylesheetPtr_val(v));
  46 }
  47
  48 xsltStylesheetPtr XsltStylesheetPtr_val(value v)
  49 {
  50    CAMLparam1(v);
  51    xsltStylesheetPtr res = *((xsltStylesheetPtr*) Data_custom_val(v));
  52    CAMLreturn(res);
  53 }
  54
  55 value Val_XsltStylesheetPtr(xsltStylesheetPtr obj)
  56 {
  57    CAMLparam0();
  58    CAMLlocal1(v);
  59    static struct custom_operations ops = {
  60       "http://www.cs.unibo.it/helm/gdome_xslt/XsltStylesheetPtr",
  61       ml_xsltFreeStylesheet,
  62       custom_compare_default,
  63       custom_hash_default,
  64       custom_serialize_default,
  65       custom_deserialize_default
  66    };
  67
  68    v = alloc_custom(&ops, sizeof(xsltStylesheetPtr), 0, 1);
  69    *((xsltStylesheetPtr*) Data_custom_val(v)) = obj;
  70
  71    CAMLreturn(v);
  72 }
  73
  74 value ml_processStylesheet(value style)
  75 {
  76    CAMLparam1(style);
  77    xsltStylesheetPtr res;
  78    res = processStylesheet(Document_val(style));
  79    if (res == NULL) {
  80       value* excp;
  81       excp = caml_named_value("ProcessStylesheetException");
  82       assert(excp != NULL);
  83       raise_constant(*excp);
  84    }
  85    CAMLreturn(Val_XsltStylesheetPtr(res));
  86 }
  87
  88 value setXsltMaxDepth(value depth)
  89 {
  90    CAMLparam1(depth);
  91    xsltMaxDepth = Int_val(depth);
  92    CAMLreturn0;
  93 }
  94
  95 value ml_applyStylesheet(value source, value style, value params)
  96 {
  97    CAMLparam3(source,style,params);
  98    CAMLlocal1(list);
  99    GdomeDocument* res;
 100    int i;
 101    const char** c_params;
 102
 103    i = 0 ; list = params;
 104    while(list != Val_int(0)) {
 105       list = Field(list,1);
 106       i++;
 107    }
 108    c_params = (const char **)malloc(sizeof(char *) * (i * 2 + 1));
 109
 110    i = 0; list = params;
 111    while(list != Val_int(0)) {
 112       c_params[i]   = String_val(Field(Field(list,0),0));
 113       c_params[i+1] = String_val(Field(Field(list,0),1));
 114       list = Field(list,1);
 115       i+=2;
 116    }
 117    c_params[i] = NULL;
 118    res = applyStylesheet(Document_val(source),
 119                          XsltStylesheetPtr_val(style),
 120                          c_params);
 121    free(c_params);
 122    if (res == NULL) {
 123       value* excp;
 124       excp = caml_named_value("ApplyStylesheetException");
 125       assert(excp != NULL);
 126       raise_constant(*excp);
 127    }
 128    CAMLreturn(Val_Document(res));
 129 }
 130
 131 value ml_saveResultToChannel(value channel,
 132                              value result,
 133                              value stylesheet)
 134 {
 135         CAMLparam3(channel, result, stylesheet);
 136
 137         saveResultToFd((Channel(channel))->fd,
 138                       Document_val(result),
 139                       XsltStylesheetPtr_val(stylesheet));
 140
 141         CAMLreturn0;
 142 }
 143