pidl/lib/Parse/Pidl/Samba4.pm

   1 ###################################################
   2 # Common Samba4 functions
   3 # Copyright jelmer@samba.org 2006
   4 # released under the GNU GPL
   5
   6 package Parse::Pidl::Samba4;
   7
   8 require Exporter;
   9 @ISA = qw(Exporter);
  10 @EXPORT = qw(is_intree choose_header NumStars ElementStars ArrayBrackets DeclLong ArrayDynamicallyAllocated);
  11
  12 use Parse::Pidl::Util qw(has_property is_constant);
  13 use Parse::Pidl::NDR qw(GetNextLevel);
  14 use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
  15 use Parse::Pidl qw(fatal error);
  16 use strict;
  17
  18 use vars qw($VERSION);
  19 $VERSION = '0.01';
  20
  21
  22 # return true if we are using pidl within the samba source tree. This changes
  23 # the names of include files, as some include files (such as ntstatus.h) have
  24 # different paths when installed to the patch in the source tree
  25 sub is_intree()
  26 {
  27         my $srcdir = $ENV{srcdir};
  28         $srcdir = $srcdir ? "$srcdir/" : "";
  29         return 1 if (-f "${srcdir}kdc/kdc.c");
  30         return 1 if (-d "${srcdir}source4");
  31         return 1 if (-f "${srcdir}include/smb.h");
  32         return 0;
  33 }
  34
  35 # Return an #include line depending on whether this build is an in-tree
  36 # build or not.
  37 sub choose_header($$)
  38 {
  39         my ($in,$out) = @_;
  40         return "#include \"$in\"" if (is_intree());
  41         return "#include <$out>";
  42 }
  43
  44 sub ArrayDynamicallyAllocated($$)
  45 {
  46         my ($e, $l) = @_;
  47         die("Not an array") unless ($l->{TYPE} eq "ARRAY");
  48         return 0 if ($l->{IS_FIXED} and not has_property($e, "charset"));
  49         return 1;
  50 }
  51
  52 sub NumStars($;$)
  53 {
  54         my ($e, $d) = @_;
  55         $d = 0 unless defined($d);
  56         my $n = 0;
  57
  58         foreach my $l (@{$e->{LEVELS}}) {
  59                 next unless ($l->{TYPE} eq "POINTER");
  60
  61                 my $nl = GetNextLevel($e, $l);
  62                 next if (defined($nl) and $nl->{TYPE} eq "ARRAY");
  63
  64                 $n++;
  65         }
  66
  67         if ($n >= 1) {
  68                 $n-- if (scalar_is_reference($e->{TYPE}));
  69         }
  70
  71         foreach my $l (@{$e->{LEVELS}}) {
  72                 next unless ($l->{TYPE} eq "ARRAY");
  73                 next unless (ArrayDynamicallyAllocated($e, $l));
  74                 $n++;
  75         }
  76
  77         error($e->{ORIGINAL}, "Too few pointers $n < $d") if ($n < $d);
  78
  79         $n -= $d;
  80
  81         return $n;
  82 }
  83
  84 sub ElementStars($;$)
  85 {
  86         my ($e, $d) = @_;
  87         my $res = "";
  88         my $n = 0;
  89
  90         $n = NumStars($e, $d);
  91         $res .= "*" foreach (1..$n);
  92
  93         return $res;
  94 }
  95
  96 sub ArrayBrackets($)
  97 {
  98         my ($e) = @_;
  99         my $res = "";
 100
 101         foreach my $l (@{$e->{LEVELS}}) {
 102                 next unless ($l->{TYPE} eq "ARRAY");
 103                 next if ArrayDynamicallyAllocated($e, $l);
 104                 $res .= "[$l->{SIZE_IS}]";
 105         }
 106
 107         return $res;
 108 }
 109
 110 sub DeclLong($;$)
 111 {
 112         my ($e, $p) = @_;
 113         my $res = "";
 114         $p = "" unless defined($p);
 115
 116         if (has_property($e, "represent_as")) {
 117                 $res .= mapTypeName($e->{PROPERTIES}->{represent_as})." ";
 118         } else {
 119                 if (has_property($e, "charset")) {
 120                         $res .= "const char ";
 121                 } else {
 122                         $res .= mapTypeName($e->{TYPE})." ";
 123                 }
 124
 125                 $res .= ElementStars($e);
 126         }
 127         $res .= $p.$e->{NAME};
 128         $res .= ArrayBrackets($e);
 129
 130         return $res;
 131 }
 132
 133 1;