# released under the GNU GPL
package util;
-use Data::Dumper;
-
-sub dumpit($)
+#####################################################################
+# load a data structure from a file (as saved with SaveStructure)
+sub LoadStructure($)
{
- my $a = shift;
- return Dumper $a;
+ my $f = shift;
+ my $contents = FileLoad($f);
+ defined $contents || return undef;
+ return eval "$contents";
}
+use strict;
+
#####################################################################
# flatten an array of arrays into a single array
sub FlattenArray2($)
if (ref($v) eq "ARRAY") {
foreach my $i (0 .. $#{$v}) {
CleanData($v->[$i]);
- if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) { delete($v->[$i]); next; }
+ if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) {
+ $v->[$i] = undef;
+ next;
+ }
}
# this removes any undefined elements from the array
@{$v} = grep { defined $_ } @{$v};
{
my($filename) = shift;
local(*INPUTFILE);
- open(INPUTFILE, $filename) || die "can't load $filename";
+ open(INPUTFILE, $filename) || return undef;
my($saved_delim) = $/;
undef $/;
my($data) = <INPUTFILE>;
my($fname) = shift;
my($ext) = shift;
if ($fname =~ /^(.*)\.(.*?)$/) {
- return "$1.$ext";
+ return "$1$ext";
}
- return "$fname.$ext";
+ return "$fname$ext";
+}
+
+#####################################################################
+# a dumper wrapper to prevent dependence on the Data::Dumper module
+# unless we actually need it
+sub MyDumper($)
+{
+ require Data::Dumper;
+ my $s = shift;
+ return Data::Dumper::Dumper($s);
}
#####################################################################
# save a data structure into a file
sub SaveStructure($$)
{
- my($filename) = shift;
- my($v) = shift;
- FileSave($filename, Dumper($v));
+ my($filename) = shift;
+ my($v) = shift;
+ FileSave($filename, MyDumper($v));
}
#####################################################################
-# load a data structure from a file (as saved with SaveStructure)
-sub LoadStructure($)
+# find an interface in an array of interfaces
+sub get_interface($$)
{
- return eval FileLoad(shift);
+ my($if) = shift;
+ my($n) = shift;
+
+ foreach(@{$if}) {
+ if($_->{NAME} eq $n) { return $_; }
+ }
+
+ return 0;
}
#####################################################################
-# see if a pidl property list contains a give property
+# see if a pidl property list contains a given property
sub has_property($$)
{
my($e) = shift;
my($p) = shift;
if (!defined $e->{PROPERTIES}) {
- return;
- }
-
- my($props) = $e->{PROPERTIES};
-
- foreach my $d (@{$props}) {
- if (ref($d) ne "HASH") {
- if ($d eq $p) {
- return 1;
- }
- } else {
- foreach my $k (keys %{$d}) {
- if ($k eq $p) {
- return $d->{$k};
- }
- }
- }
+ return undef;
}
- return undef;
-}
-
-
-sub is_scalar_type($)
-{
- my($type) = shift;
-
- return 1, if ($type eq "uint32");
- return 1, if ($type eq "long");
- return 1, if ($type eq "short");
- return 1, if ($type eq "char");
- return 1, if ($type eq "uint8");
- return 1, if ($type eq "uint16");
- return 1, if ($type eq "NTTIME");
- return 1, if ($type eq "HYPER_T");
- return 1, if ($type eq "wchar_t");
- return 1, if ($type eq "DATA_BLOB");
-
- return 0;
+ return $e->{PROPERTIES}->{$p};
}
-# return the NDR alignment for a type
-sub type_align($)
-{
- my($e) = shift;
- my $type = $e->{TYPE};
-
- if (need_wire_pointer($e)) {
- return 4;
- }
-
- return 4, if ($type eq "uint32");
- return 4, if ($type eq "long");
- return 2, if ($type eq "short");
- return 1, if ($type eq "char");
- return 1, if ($type eq "uint8");
- return 2, if ($type eq "uint16");
- return 4, if ($type eq "NTTIME");
- return 8, if ($type eq "HYPER_T");
- return 2, if ($type eq "wchar_t");
- return 4, if ($type eq "DATA_BLOB");
-
- # it must be an external type - all we can do is guess
- return 4;
-}
-
-# this is used to determine if the ndr push/pull functions will need
-# a ndr_flags field to split by buffers/scalars
-sub is_builtin_type($)
+#####################################################################
+# see if a pidl property matches a value
+sub property_matches($$$)
{
- my($type) = shift;
-
- return 1, if (is_scalar_type($type));
- return 1, if ($type =~ "unistr.*");
- return 1, if ($type eq "policy_handle");
+ my($e) = shift;
+ my($p) = shift;
+ my($v) = shift;
- return 0;
-}
+ if (!defined has_property($e, $p)) {
+ return undef;
+ }
-# determine if an element needs a reference pointer on the wire
-# in its NDR representation
-sub need_wire_pointer($)
-{
- my $e = shift;
- if ($e->{POINTERS} &&
- !has_property($e, "ref")) {
- return $e->{POINTERS};
+ if ($e->{PROPERTIES}->{$p} =~ /$v/) {
+ return 1;
}
+
return undef;
}
-
# determine if an element is a pass-by-reference structure
sub is_ref_struct($)
{
return 0;
}
-# determine if an element is a pure scalar. pure scalars do not
-# have a "buffers" section in NDR
-sub is_pure_scalar($)
-{
- my $e = shift;
- if (has_property($e, "ref")) {
- return 1;
- }
- if (is_scalar_type($e->{TYPE}) &&
- !$e->{POINTERS} &&
- !array_size($e)) {
- return 1;
- }
- return 0;
-}
-
# determine the array size (size_is() or ARRAY_LEN)
sub array_size($)
{
return undef;
}
-# see if a variable needs to be allocated by the NDR subsystem on pull
-sub need_alloc($)
-{
- my $e = shift;
-
- if (has_property($e, "ref")) {
- return 0;
- }
-
- if ($e->{POINTERS} || array_size($e)) {
- return 1;
- }
-
- return 0;
-}
-
-# determine the C prefix used to refer to a variable when passing to a push
-# function. This will be '*' for pointers to scalar types, '' for scalar
-# types and normal pointers and '&' for pass-by-reference structures
-sub c_push_prefix($)
-{
- my $e = shift;
- if (is_scalar_type($e->{TYPE}) &&
- $e->{POINTERS}) {
- return "*";
- }
- if (!is_scalar_type($e->{TYPE}) &&
- !$e->{POINTERS} &&
- !array_size($e)) {
- return "&";
- }
- return "";
-}
-
-# determine the C prefix used to refer to a variable when passing to a pull
-# return '&' or ''
-sub c_pull_prefix($)
-{
- my $e = shift;
-
- if (!$e->{POINTERS} && !array_size($e)) {
- return "&";
- }
-
- if ($e->{TYPE} =~ "unistr.*" ||
- $e->{TYPE} =~ "nstring.*" ||
- $e->{TYPE} =~ "lstring.*") {
- return "&";
- }
-
- return "";
-}
-
-# determine if an element has a direct buffers component
-sub has_direct_buffers($)
-{
- my $e = shift;
- if ($e->{POINTERS} || array_size($e)) {
- return 1;
- }
- return 0;
-}
-
# return 1 if the string is a C constant
sub is_constant($)
{
my $s = shift;
- if ($s =~ /^\d/) {
+ if (defined $s && $s =~ /^\d/) {
return 1;
}
return 0;
}
-# return 1 if this is a fixed array
-sub is_fixed_array($)
+# return a "" quoted string, unless already quoted
+sub make_str($)
{
- my $e = shift;
- my $len = $e->{"ARRAY_LEN"};
- if (defined $len && is_constant($len)) {
- return 1;
+ my $str = shift;
+ if (substr($str, 0, 1) eq "\"") {
+ return $str;
}
- return 0;
-}
-
-# return 1 if this is a inline array
-sub is_inline_array($)
-{
- my $e = shift;
- my $len = $e->{"ARRAY_LEN"};
- if (is_fixed_array($e) ||
- defined $len && $len ne "*") {
- return 1;
- }
- return 0;
-}
-
-sub dump($)
-{
- print Dumper shift;
+ return "\"" . $str . "\"";
}
1;
-
git.samba.org / samba.git / blobdiff