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