mirror of
https://github.com/samba-team/samba.git
synced 2025-12-04 08:23:50 +03:00
c4ab021ee8
fixed by adding [ref] pointers. This will cause a lot of warnings to be outputted by pidl for now. I will fix these gradually over the next few days. We need to avoid [out] arguments that are not pointers because they are not understood by other IDL compilers and don't work with some of our output modules (Samba3, Samba3NDR and ethereal)
99 lines
2.1 KiB
Perl
99 lines
2.1 KiB
Perl
##########################################
|
|
# Converts ODL stuctures to IDL structures
|
|
# (C) 2004-2005 Jelmer Vernooij <jelmer@samba.org>
|
|
|
|
package Parse::Pidl::ODL;
|
|
|
|
use Parse::Pidl::Util qw(has_property);
|
|
use Parse::Pidl::Typelist qw(hasType getType);
|
|
use strict;
|
|
|
|
use vars qw($VERSION);
|
|
$VERSION = '0.01';
|
|
|
|
#####################################################################
|
|
# find an interface in an array of interfaces
|
|
sub get_interface($$)
|
|
{
|
|
my($if,$n) = @_;
|
|
|
|
foreach(@$if) {
|
|
return $_ if($_->{NAME} eq $n);
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub FunctionAddObjArgs($)
|
|
{
|
|
my $e = shift;
|
|
|
|
unshift(@{$e->{ELEMENTS}}, {
|
|
'NAME' => 'ORPCthis',
|
|
'POINTERS' => 0,
|
|
'PROPERTIES' => { 'in' => '1' },
|
|
'TYPE' => 'ORPCTHIS',
|
|
'FILE' => $e->{FILE},
|
|
'LINE' => $e->{LINE}
|
|
});
|
|
unshift(@{$e->{ELEMENTS}}, {
|
|
'NAME' => 'ORPCthat',
|
|
'POINTERS' => 0,
|
|
'PROPERTIES' => { 'out' => '1' },
|
|
'TYPE' => 'ORPCTHAT',
|
|
'FILE' => $e->{FILE},
|
|
'LINE' => $e->{LINE}
|
|
});
|
|
}
|
|
|
|
sub ReplaceInterfacePointers($)
|
|
{
|
|
my $e = shift;
|
|
|
|
foreach my $x (@{$e->{ELEMENTS}}) {
|
|
next unless (hasType($x->{TYPE}));
|
|
next unless getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
|
|
|
|
$x->{TYPE} = "MInterfacePointer";
|
|
}
|
|
}
|
|
|
|
# Add ORPC specific bits to an interface.
|
|
sub ODL2IDL($)
|
|
{
|
|
my $odl = shift;
|
|
|
|
foreach my $x (@{$odl}) {
|
|
# Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
|
|
# and replace interfacepointers with MInterfacePointer
|
|
# for 'object' interfaces
|
|
if (has_property($x, "object")) {
|
|
foreach my $e (@{$x->{DATA}}) {
|
|
($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
|
|
ReplaceInterfacePointers($e);
|
|
}
|
|
# Object interfaces use ORPC
|
|
my @depends = ();
|
|
if(has_property($x, "depends")) {
|
|
@depends = split /,/, $x->{PROPERTIES}->{depends};
|
|
}
|
|
push @depends, "orpc";
|
|
$x->{PROPERTIES}->{depends} = join(',',@depends);
|
|
}
|
|
|
|
if ($x->{BASE}) {
|
|
my $base = get_interface($odl, $x->{BASE});
|
|
|
|
foreach my $fn (reverse @{$base->{DATA}}) {
|
|
next unless ($fn->{TYPE} eq "FUNCTION");
|
|
unshift (@{$x->{DATA}}, $fn);
|
|
push (@{$x->{INHERITED_FUNCTIONS}}, $fn->{NAME});
|
|
}
|
|
}
|
|
}
|
|
|
|
return $odl;
|
|
}
|
|
|
|
1;
|