source4/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 use vars qw($VERSION);
  12 $VERSION = '0.01';
  13
  14 #####################################################################
  15 # find an interface in an array of interfaces
  16 sub get_interface($$)
  17 {
  18         my($if,$n) = @_;
  19
  20         foreach(@$if) {
  21                 next if ($_->{TYPE} ne "INTERFACE");
  22                 return $_ if($_->{NAME} eq $n);
  23         }
  24
  25         return 0;
  26 }
  27
  28 sub FunctionAddObjArgs($)
  29 {
  30         my $e = shift;
  31
  32         unshift(@{$e->{ELEMENTS}}, {
  33                 'NAME' => 'ORPCthis',
  34                 'POINTERS' => 0,
  35                 'PROPERTIES' => { 'in' => '1' },
  36                 'TYPE' => 'ORPCTHIS',
  37                 'FILE' => $e->{FILE},
  38                 'LINE' => $e->{LINE}
  39         });
  40         unshift(@{$e->{ELEMENTS}}, {
  41                 'NAME' => 'ORPCthat',
  42                 'POINTERS' => 1,
  43                 'PROPERTIES' => { 'out' => '1', 'ref' => '1' },
  44                 'TYPE' => 'ORPCTHAT',
  45                 'FILE' => $e->{FILE},
  46                 'LINE' => $e->{LINE}
  47         });
  48 }
  49
  50 sub ReplaceInterfacePointers($)
  51 {
  52         my $e = shift;
  53
  54         foreach my $x (@{$e->{ELEMENTS}}) {
  55                 next unless (hasType($x->{TYPE}));
  56                 next unless getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
  57
  58                 $x->{TYPE} = "MInterfacePointer";
  59         }
  60 }
  61
  62 # Add ORPC specific bits to an interface.
  63 sub ODL2IDL($)
  64 {
  65         my $odl = shift;
  66         my $addedorpc = 0;
  67
  68         foreach my $x (@$odl) {
  69                 next if ($x->{TYPE} ne "INTERFACE");
  70                 # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
  71                 # and replace interfacepointers with MInterfacePointer
  72                 # for 'object' interfaces
  73                 if (has_property($x, "object")) {
  74                         foreach my $e (@{$x->{DATA}}) {
  75                                 ($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
  76                                 ReplaceInterfacePointers($e);
  77                         }
  78                         $addedorpc = 1;
  79                 }
  80
  81                 if ($x->{BASE}) {
  82                         my $base = get_interface($odl, $x->{BASE});
  83
  84                         foreach my $fn (reverse @{$base->{DATA}}) {
  85                                 next unless ($fn->{TYPE} eq "FUNCTION");
  86                                 unshift (@{$x->{DATA}}, $fn);
  87                                 push (@{$x->{INHERITED_FUNCTIONS}}, $fn->{NAME});
  88                         }
  89                 }
  90         }
  91
  92         unshift (@$odl, {
  93                 TYPE => "IMPORT",
  94                 PATHS => [ "\"orpc.idl\"" ],
  95                 FILE => undef,
  96                 LINE => undef
  97         }) if ($addedorpc);
  98
  99         return $odl;
 100 }
 101
 102 1;