134 lines
2.7 KiB
Perl
134 lines
2.7 KiB
Perl
|
###################################################
|
||
|
|
# Common Samba4 functions
|
||
|
|
# Copyright jelmer@samba.org 2006
|
||
|
|
# released under the GNU GPL
|
||
|
|
|
||
|
|
package Parse::Pidl::Samba4;
|
||
|
|
|
||
|
|
require Exporter;
|
||
|
|
@ISA = qw(Exporter);
|
||
|
|
@EXPORT = qw(is_intree choose_header NumStars ElementStars ArrayBrackets DeclLong ArrayDynamicallyAllocated);
|
||
|
|
|
||
|
|
use Parse::Pidl::Util qw(has_property is_constant);
|
||
|
|
use Parse::Pidl::NDR qw(GetNextLevel);
|
||
|
|
use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
|
||
|
|
use Parse::Pidl qw(fatal error);
|
||
|
|
use strict;
|
||
|
|
|
||
|
|
use vars qw($VERSION);
|
||
|
|
$VERSION = '0.01';
|
||
|
|
|
||
|
|
|
||
|
|
# return true if we are using pidl within the samba source tree. This changes
|
||
|
|
# the names of include files, as some include files (such as ntstatus.h) have
|
||
|
|
# different paths when installed to the patch in the source tree
|
||
|
|
sub is_intree()
|
||
|
|
{
|
||
|
|
my $srcdir = $ENV{srcdir};
|
||
|
|
$srcdir = $srcdir ? "$srcdir/" : "";
|
||
|
|
return 1 if (-f "${srcdir}kdc/kdc.c");
|
||
|
|
return 1 if (-d "${srcdir}source4");
|
||
|
|
return 1 if (-f "${srcdir}include/smb.h");
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
# Return an #include line depending on whether this build is an in-tree
|
||
|
|
# build or not.
|
||
|
|
sub choose_header($$)
|
||
|
|
{
|
||
|
|
my ($in,$out) = @_;
|
||
|
|
return "#include \"$in\"" if (is_intree());
|
||
|
|
return "#include <$out>";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub ArrayDynamicallyAllocated($$)
|
||
|
|
{
|
||
|
|
my ($e, $l) = @_;
|
||
|
|
die("Not an array") unless ($l->{TYPE} eq "ARRAY");
|
||
|
|
return 0 if ($l->{IS_FIXED} and not has_property($e, "charset"));
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub NumStars($;$)
|
||
|
|
{
|
||
|
|
my ($e, $d) = @_;
|
||
|
|
$d = 0 unless defined($d);
|
||
|
|
my $n = 0;
|
||
|
|
|
||
|
|
foreach my $l (@{$e->{LEVELS}}) {
|
||
|
|
next unless ($l->{TYPE} eq "POINTER");
|
||
|
|
|
||
|
|
my $nl = GetNextLevel($e, $l);
|
||
|
|
next if (defined($nl) and $nl->{TYPE} eq "ARRAY");
|
||
|
|
|
||
|
|
$n++;
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($n >= 1) {
|
||
|
|
$n-- if (scalar_is_reference($e->{TYPE}));
|
||
|
|
}
|
||
|
|
|
||
|
|
foreach my $l (@{$e->{LEVELS}}) {
|
||
|
|
next unless ($l->{TYPE} eq "ARRAY");
|
||
|
|
next unless (ArrayDynamicallyAllocated($e, $l));
|
||
|
|
$n++;
|
||
|
|
}
|
||
|
|
|
||
|
|
error($e->{ORIGINAL}, "Too few pointers $n < $d") if ($n < $d);
|
||
|
|
|
||
|
|
$n -= $d;
|
||
|
|
|
||
|
|
return $n;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub ElementStars($;$)
|
||
|
|
{
|
||
|
|
my ($e, $d) = @_;
|
||
|
|
my $res = "";
|
||
|
|
my $n = 0;
|
||
|
|
|
||
|
|
$n = NumStars($e, $d);
|
||
|
|
$res .= "*" foreach (1..$n);
|
||
|
|
|
||
|
|
return $res;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub ArrayBrackets($)
|
||
|
|
{
|
||
|
|
my ($e) = @_;
|
||
|
|
my $res = "";
|
||
|
|
|
||
|
|
foreach my $l (@{$e->{LEVELS}}) {
|
||
|
|
next unless ($l->{TYPE} eq "ARRAY");
|
||
|
|
next if ArrayDynamicallyAllocated($e, $l);
|
||
|
|
$res .= "[$l->{SIZE_IS}]";
|
||
|
|
}
|
||
|
|
|
||
|
|
return $res;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub DeclLong($;$)
|
||
|
|
{
|
||
|
|
my ($e, $p) = @_;
|
||
|
|
my $res = "";
|
||
|
|
$p = "" unless defined($p);
|
||
|
|
|
||
|
|
if (has_property($e, "represent_as")) {
|
||
|
|
$res .= mapTypeName($e->{PROPERTIES}->{represent_as})." ";
|
||
|
|
} else {
|
||
|
|
if (has_property($e, "charset")) {
|
||
|
|
$res .= "const char ";
|
||
|
|
} else {
|
||
|
|
$res .= mapTypeName($e->{TYPE})." ";
|
||
|
|
}
|
||
|
|
|
||
|
|
$res .= ElementStars($e);
|
||
|
|
}
|
||
|
|
$res .= $p.$e->{NAME};
|
||
|
|
$res .= ArrayBrackets($e);
|
||
|
|
|
||
|
|
return $res;
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|