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 $idl_path = undef;
  61                                 foreach ($basedir, @$opt_incdirs) {
  62                                         if (-f "$_/$idl_file") {
  63                                                 $idl_path = "$_/$idl_file";
  64                                                 last;
  65                                         }
  66                                 }
  67                                 unless ($idl_path) {
  68                                         error($x, "Unable to open include file `$idl_file'");
  69                                         next;
  70                                 }
  71                                 my $podl = Parse::Pidl::IDL::parse_file($idl_path, $opt_incdirs);
  72                                 if (defined(@$podl)) {
  73                                         require Parse::Pidl::Typelist;
  74
  75                                         Parse::Pidl::Typelist::LoadIdl($podl);
  76                                         my $pidl = ODL2IDL($podl, $basedir, $opt_incdirs);
  77
  78                                         foreach my $y (@$pidl) {
  79                                                 if ($y->{TYPE} eq "INTERFACE") {
  80                                                         $interfaces->{$y->{NAME}} = $y;
  81                                                 }
  82                                         }
  83                                 } else {
  84                                         error($x, "Failed to parse $idl_path");
  85                                 }
  86                         }
  87                 }
  88
  89                 if ($x->{TYPE} eq "INTERFACE") {
  90                         $interfaces->{$x->{NAME}} = $x;
  91                         # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
  92                         # and replace interfacepointers with MInterfacePointer
  93                         # for 'object' interfaces
  94                         if (has_property($x, "object")) {
  95                                 foreach my $e (@{$x->{DATA}}) {
  96                                         ($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
  97                                         ReplaceInterfacePointers($e);
  98                                 }
  99                                 $addedorpc = 1;
 100                         }
 101
 102                         if ($x->{BASE}) {
 103                                 my $base = $interfaces->{$x->{BASE}};
 104
 105                                 unless (defined($base)) {
 106                                         error($x, "Undefined base interface `$x->{BASE}'");
 107                                 } else {
 108                                         foreach my $fn (reverse @{$base->{DATA}}) {
 109                                                 next unless ($fn->{TYPE} eq "FUNCTION");
 110                                                 push (@{$x->{INHERITED_FUNCTIONS}}, $fn);
 111                                         }
 112                                 }
 113                         }
 114                 }
 115         }
 116
 117         unshift (@$odl, {
 118                 TYPE => "IMPORT",
 119                 PATHS => [ "\"orpc.idl\"" ],
 120                 FILE => undef,
 121                 LINE => undef
 122         }) if ($addedorpc);
 123
 124
 125         return $odl;
 126 }
 127
 128 1;