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 sub is_intree()
  22 {
  23         my $srcdir = $ENV{srcdir};
  24         $srcdir = $srcdir ? "$srcdir/" : "";
  25         return 4 if (-f "${srcdir}kdc/kdc.c");
  26         return 3 if (-f "${srcdir}include/smb.h");
  27         return 0;
  28 }
  29
  30 # Return an #include line depending on whether this build is an in-tree
  31 # build or not.
  32 sub choose_header($$)
  33 {
  34         my ($in,$out) = @_;
  35         return "#include \"$in\"" if (is_intree());
  36         return "#include <$out>";
  37 }
  38
  39 sub ArrayDynamicallyAllocated($$)
  40 {
  41         my ($e, $l) = @_;
  42         die("Not an array") unless ($l->{TYPE} eq "ARRAY");
  43         return 0 if ($l->{IS_FIXED} and not has_property($e, "charset"));
  44         return 1;
  45 }
  46
  47 sub NumStars($;$)
  48 {
  49         my ($e, $d) = @_;
  50         $d = 0 unless defined($d);
  51         my $n = 0;
  52
  53         foreach my $l (@{$e->{LEVELS}}) {
  54                 next unless ($l->{TYPE} eq "POINTER");
  55
  56                 my $nl = GetNextLevel($e, $l);
  57                 next if (defined($nl) and $nl->{TYPE} eq "ARRAY");
  58
  59                 $n++;
  60         }
  61
  62         if ($n >= 1) {
  63                 $n-- if (scalar_is_reference($e->{TYPE}));
  64         }
  65
  66         foreach my $l (@{$e->{LEVELS}}) {
  67                 next unless ($l->{TYPE} eq "ARRAY");
  68                 next unless (ArrayDynamicallyAllocated($e, $l));
  69                 $n++;
  70         }
  71
  72         error($e->{ORIGINAL}, "Too few pointers $n < $d") if ($n < $d);
  73
  74         $n -= $d;
  75
  76         return $n;
  77 }
  78
  79 sub ElementStars($;$)
  80 {
  81         my ($e, $d) = @_;
  82         my $res = "";
  83         my $n = 0;
  84
  85         $n = NumStars($e, $d);
  86         $res .= "*" foreach (1..$n);
  87
  88         return $res;
  89 }
  90
  91 sub ArrayBrackets($)
  92 {
  93         my ($e) = @_;
  94         my $res = "";
  95
  96         foreach my $l (@{$e->{LEVELS}}) {
  97                 next unless ($l->{TYPE} eq "ARRAY");
  98                 next if ArrayDynamicallyAllocated($e, $l);
  99                 $res .= "[$l->{SIZE_IS}]";
 100         }
 101
 102         return $res;
 103 }
 104
 105 sub DeclLong($)
 106 {
 107         my ($e) = shift;
 108         my $res = "";
 109
 110         if (has_property($e, "represent_as")) {
 111                 $res .= mapTypeName($e->{PROPERTIES}->{represent_as})." ";
 112         } else {
 113                 if (has_property($e, "charset")) {
 114                         $res .= "const char ";
 115                 } else {
 116                         $res .= mapTypeName($e->{TYPE})." ";
 117                 }
 118
 119                 $res .= ElementStars($e);
 120         }
 121         $res .= $e->{NAME};
 122         $res .= ArrayBrackets($e);
 123
 124         return $res;
 125 }
 126
 127 1;