source4/build/pidl/swig.pm

   1 ###################################################
   2 # Samba4 parser generator for swig wrappers
   3 # Copyright tpot@samba.org 2004
   4 # released under the GNU GPL
   5
   6 package IdlSwig;
   7
   8 use strict;
   9 use Data::Dumper;
  10
  11 my($res);
  12 my($name);
  13
  14 sub ParseFunction($)
  15 {
  16     my($fn) = shift;
  17
  18     # Input typemap
  19
  20     $res .= "%typemap(in) struct $fn->{NAME} * (struct $fn->{NAME} temp) {\n";
  21 #    $res .= "\tif (!PyDict_Check(\$input)) {\n";
  22 #    $res .= "\t\tPyErr_SetString(PyExc_TypeError, \"dict arg expected\");\n";
  23 #    $res .= "\t\treturn NULL;\n";
  24 #    $res .= "\t}\n\n";
  25     $res .= "\tmemset(&temp, 0, sizeof(temp));\n";
  26 #    foreach my $e (@{$fn->{DATA}}) {
  27 #       if (util::has_property($e, "in")) {
  28 #           $res .= "\ttemp.in.$e->{NAME} = $e->{TYPE}_from_python(PyDict_GetItem(\$input, PyString_FromString(\"$e->{NAME}\")));\n";
  29 #       }
  30 #    }
  31
  32 #    $res .= "\n";
  33     $res .= "\t\$1 = &temp;\n";
  34     $res .= "}\n\n";
  35
  36     # Output typemap
  37
  38     $res .= "%typemap(argout) struct $fn->{NAME} * {\n";
  39     $res .= "\tlong status = PyLong_AsLong(resultobj);\n";
  40     $res .= "\tPyObject *dict;\n";
  41     $res .= "\n";
  42     $res .= "\tif (status != 0) {\n";
  43     $res .= "\t\tset_ntstatus_exception(status);\n";
  44     $res .= "\t\treturn NULL;\n";
  45     $res .= "\t}\n";
  46     $res .= "\n";
  47     $res .= "\tdict = PyDict_New();\n";
  48
  49 #    foreach my $e (@{$fn->{DATA}}) {
  50 #       if (util::has_property($e, "out")) {
  51 #           $res .= "\t// PyDict_SetItem(dict, PyString_FromString(\"$e->{NAME}\"),\n";
  52 #           $res .= "\t//\t$e->{TYPE}_to_python(\$1->out.$e->{NAME}));\n";
  53 #       }
  54 #    }
  55
  56     $res .= "\n";
  57     $res .= "\tresultobj = dict;\n";
  58     $res .= "}\n\n";
  59
  60     # Function definitions
  61
  62     $res .= "%rename($fn->{NAME}) dcerpc_$fn->{NAME};\n";
  63     $res .= "$fn->{RETURN_TYPE} dcerpc_$fn->{NAME}(struct dcerpc_pipe *p, TALLOC_CTX *mem_ctx, struct $fn->{NAME} *r);\n\n";
  64 }
  65
  66 sub ParseStruct($)
  67 {
  68     my($s) = shift;
  69
  70     $res .= "%{\n\n";
  71     $res .= "\t/* $s->{NAME} */\n\n";
  72
  73     foreach my $e (@{$s->{DATA}{ELEMENTS}}) {
  74     }
  75
  76     $res .= "\n%}\n\n";
  77 }
  78
  79 sub ParseTypedef($)
  80 {
  81     my($t) = shift;
  82
  83     foreach my $e ($t) {
  84         ($e->{DATA}{TYPE} eq "STRUCT") && ParseStruct($e);
  85     }
  86 }
  87
  88 sub ParseInheritedData($)
  89 {
  90     my($data) = shift;
  91
  92     foreach my $e (@{$data}) {
  93         ($e->{TYPE} eq "FUNCTION") && ParseFunction($e);
  94         ($e->{TYPE} eq "TYPEDEF") && ParseTypedef($e);
  95     }
  96 }
  97
  98 sub ParseHeader($)
  99 {
 100     my($hdr) = shift;
 101
 102     $name = $hdr->{NAME};
 103     $res .= "#define DCERPC_" . uc($name) . "_UUID \"$hdr->{PROPERTIES}->{uuid}\"\n";
 104     $res .= "const int DCERPC_" . uc($name) . "_VERSION = " . $hdr->{PROPERTIES}->{version} . ";\n";
 105     $res .= "#define DCERPC_" . uc($name) . "_NAME \"" . $name . "\"\n";
 106     $res .= "\n";
 107
 108     ParseInheritedData($hdr->{INHERITED_DATA});
 109 }
 110
 111 sub Parse($)
 112 {
 113     my($idl) = shift;
 114
 115     $res = "/* auto-generated by pidl */\n\n";
 116
 117     foreach my $x (@{$idl}) {
 118         ($x->{TYPE} eq "INTERFACE") && ParseHeader($x);
 119     }
 120
 121     return $res;
 122 }
 123
 124 1;