source/pidl/lib/Parse/Pidl/ODL.pm

   1 ##########################################
   2 # Converts ODL stuctures to IDL structures
   3 # (C) 2004-2005 Jelmer Vernooij <jelmer@samba.org>
   4
   5 package Parse::Pidl::ODL;
   6
   7 use Parse::Pidl::Util qw(has_property);
   8 use Parse::Pidl::Typelist qw(hasType getType);
   9 use strict;
  10
  11 #####################################################################
  12 # find an interface in an array of interfaces
  13 sub get_interface($$)
  14 {
  15         my($if) = shift;
  16         my($n) = shift;
  17
  18         foreach(@{$if}) {
  19                 if($_->{NAME} eq $n) { return $_; }
  20         }
  21
  22         return 0;
  23 }
  24
  25 sub FunctionAddObjArgs($)
  26 {
  27         my $e = shift;
  28
  29         unshift(@{$e->{ELEMENTS}}, {
  30                 'NAME' => 'ORPCthis',
  31                 'POINTERS' => 0,
  32                 'PROPERTIES' => { 'in' => '1' },
  33                 'TYPE' => 'ORPCTHIS'
  34         });
  35         unshift(@{$e->{ELEMENTS}}, {
  36                 'NAME' => 'ORPCthat',
  37                 'POINTERS' => 0,
  38                 'PROPERTIES' => { 'out' => '1' },
  39                 'TYPE' => 'ORPCTHAT'
  40         });
  41 }
  42
  43 sub ReplaceInterfacePointers($)
  44 {
  45         my $e = shift;
  46
  47         foreach my $x (@{$e->{ELEMENTS}}) {
  48                 next unless (hasType($x->{TYPE}));
  49                 next unless getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
  50
  51                 $x->{TYPE} = "MInterfacePointer";
  52         }
  53 }
  54
  55 # Add ORPC specific bits to an interface.
  56 sub ODL2IDL($)
  57 {
  58         my $odl = shift;
  59
  60         foreach my $x (@{$odl}) {
  61                 # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
  62                 # and replace interfacepointers with MInterfacePointer
  63                 # for 'object' interfaces
  64                 if (has_property($x, "object")) {
  65                         foreach my $e (@{$x->{DATA}}) {
  66                                 ($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
  67                                 ReplaceInterfacePointers($e);
  68                         }
  69                         # Object interfaces use ORPC
  70                         my @depends = ();
  71                         if(has_property($x, "depends")) {
  72                                 @depends = split /,/, $x->{PROPERTIES}->{depends};
  73                         }
  74                         push @depends, "orpc";
  75                         $x->{PROPERTIES}->{depends} = join(',',@depends);
  76                 }
  77
  78                 if ($x->{BASE}) {
  79                         my $base = get_interface($odl, $x->{BASE});
  80
  81                         foreach my $fn (reverse @{$base->{DATA}}) {
  82                                 next unless ($fn->{TYPE} eq "FUNCTION");
  83                                 unshift (@{$x->{DATA}}, $fn);
  84                                 push (@{$x->{INHERITED_FUNCTIONS}}, $fn->{NAME});
  85                         }
  86                 }
  87         }
  88
  89         return $odl;
  90 }
  91
  92 1;