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

   1 ##########################################
   2 # Converts ODL stuctures to IDL structures
   3 # (C) 2004-2005, 2008 Jelmer Vernooij <jelmer@samba.org>
   4
   5 package Parse::Pidl::ODL;
   6
   7 use Parse::Pidl qw(error);
   8 use Parse::Pidl::IDL;
   9 use Parse::Pidl::Util qw(has_property unmake_str);
  10 use Parse::Pidl::Typelist qw(hasType getType);
  11 use strict;
  12
  13 use vars qw($VERSION);
  14 $VERSION = '0.01';
  15
  16 sub FunctionAddObjArgs($)
  17 {
  18         my $e = shift;
  19
  20         unshift(@{$e->{ELEMENTS}}, {
  21                 'NAME' => 'ORPCthis',
  22                 'POINTERS' => 0,
  23                 'PROPERTIES' => { 'in' => '1' },
  24                 'TYPE' => 'ORPCTHIS',
  25                 'FILE' => $e->{FILE},
  26                 'LINE' => $e->{LINE}
  27         });
  28         unshift(@{$e->{ELEMENTS}}, {
  29                 'NAME' => 'ORPCthat',
  30                 'POINTERS' => 1,
  31                 'PROPERTIES' => { 'out' => '1', 'ref' => '1' },
  32                 'TYPE' => 'ORPCTHAT',
  33                 'FILE' => $e->{FILE},
  34                 'LINE' => $e->{LINE}
  35         });
  36 }
  37
  38 sub ReplaceInterfacePointers($)
  39 {
  40         my ($e) = @_;
  41         foreach my $x (@{$e->{ELEMENTS}}) {
  42                 next unless (hasType($x->{TYPE}));
  43                 next unless getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
  44
  45                 $x->{TYPE} = "MInterfacePointer";
  46         }
  47 }
  48
  49 # Add ORPC specific bits to an interface.
  50 sub ODL2IDL
  51 {
  52         my ($odl, $basedir, $opt_incdirs) = (@_);
  53         my $addedorpc = 0;
  54         my $interfaces = {};
  55
  56         foreach my $x (@$odl) {
  57                 if ($x->{TYPE} eq "IMPORT") {
  58                         foreach my $idl_file (@{$x->{PATHS}}) {
  59                                 $idl_file = unmake_str($idl_file);
  60                                 my $podl = Parse::Pidl::IDL::parse_file("$basedir/$idl_file", $opt_incdirs);
  61                                 if (defined(@$podl)) {
  62                                         require Parse::Pidl::Typelist;
  63
  64                                         Parse::Pidl::Typelist::LoadIdl($podl);
  65                                         my $pidl = ODL2IDL($podl, $basedir, $opt_incdirs);
  66
  67                                         foreach my $y (@$pidl) {
  68                                                 if ($y->{TYPE} eq "INTERFACE") {
  69                                                         $interfaces->{$y->{NAME}} = $y;
  70                                                 }
  71                                         }
  72                                 } else {
  73                                         error($x, "Failed to parse $idl_file");
  74                                 }
  75                         }
  76                 }
  77
  78                 if ($x->{TYPE} eq "INTERFACE") {
  79                         $interfaces->{$x->{NAME}} = $x;
  80                         # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
  81                         # and replace interfacepointers with MInterfacePointer
  82                         # for 'object' interfaces
  83                         if (has_property($x, "object")) {
  84                                 foreach my $e (@{$x->{DATA}}) {
  85                                         ($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
  86                                         ReplaceInterfacePointers($e);
  87                                 }
  88                                 $addedorpc = 1;
  89                         }
  90
  91                         if ($x->{BASE}) {
  92                                 my $base = $interfaces->{$x->{BASE}};
  93
  94                                 unless (defined($base)) {
  95                                         error($x, "Undefined base interface `$x->{BASE}'");
  96                                 } else {
  97                                         foreach my $fn (reverse @{$base->{DATA}}) {
  98                                                 next unless ($fn->{TYPE} eq "FUNCTION");
  99                                                 push (@{$x->{INHERITED_FUNCTIONS}}, $fn);
 100                                         }
 101                                 }
 102                         }
 103                 }
 104         }
 105
 106         unshift (@$odl, {
 107                 TYPE => "IMPORT",
 108                 PATHS => [ "\"orpc.idl\"" ],
 109                 FILE => undef,
 110                 LINE => undef
 111         }) if ($addedorpc);
 112
 113
 114         return $odl;
 115 }
 116
 117 1;