r15260: Don't dereference NULL pointers to obtain array lengths - found by
[samba.git] / source / pidl / lib / Parse / Pidl / Util.pm
1 ###################################################
2 # utility functions to support pidl
3 # Copyright tridge@samba.org 2000
4 # released under the GNU GPL
5 package Parse::Pidl::Util;
6
7 require Exporter;
8 @ISA = qw(Exporter);
9 @EXPORT = qw(has_property property_matches ParseExpr is_constant make_str print_uuid);
10 use vars qw($VERSION);
11 $VERSION = '0.01';
12
13 use strict;
14
15 #####################################################################
16 # a dumper wrapper to prevent dependence on the Data::Dumper module
17 # unless we actually need it
18 sub MyDumper($)
19 {
20         require Data::Dumper;
21         my $s = shift;
22         return Data::Dumper::Dumper($s);
23 }
24
25 #####################################################################
26 # see if a pidl property list contains a given property
27 sub has_property($$)
28 {
29         my($e) = shift;
30         my($p) = shift;
31
32         if (!defined $e->{PROPERTIES}) {
33                 return undef;
34         }
35
36         return $e->{PROPERTIES}->{$p};
37 }
38
39 #####################################################################
40 # see if a pidl property matches a value
41 sub property_matches($$$)
42 {
43         my($e) = shift;
44         my($p) = shift;
45         my($v) = shift;
46
47         if (!defined has_property($e, $p)) {
48                 return undef;
49         }
50
51         if ($e->{PROPERTIES}->{$p} =~ /$v/) {
52                 return 1;
53         }
54
55         return undef;
56 }
57
58 # return 1 if the string is a C constant
59 sub is_constant($)
60 {
61         my $s = shift;
62         if (defined $s && $s =~ /^\d/) {
63                 return 1;
64         }
65         return 0;
66 }
67
68 # return a "" quoted string, unless already quoted
69 sub make_str($)
70 {
71         my $str = shift;
72         if (substr($str, 0, 1) eq "\"") {
73                 return $str;
74         }
75         return "\"" . $str . "\"";
76 }
77
78 sub print_uuid($)
79 {
80         my ($uuid) = @_;
81         $uuid =~ s/"//g;
82         my ($time_low,$time_mid,$time_hi,$clock_seq,$node) = split /-/, $uuid;
83
84         my @clock_seq = $clock_seq =~ /(..)/g;
85         my @node = $node =~ /(..)/g;
86
87         return "{0x$time_low,0x$time_mid,0x$time_hi," .
88                 "{".join(',', map {"0x$_"} @clock_seq)."}," .
89                 "{".join(',', map {"0x$_"} @node)."}}";
90 }
91
92 # a hack to build on platforms that don't like negative enum values
93 my $useUintEnums = 0;
94 sub setUseUintEnums($)
95 {
96         $useUintEnums = shift;
97 }
98 sub useUintEnums()
99 {
100         return $useUintEnums;
101 }
102
103 sub ParseExpr($$)
104 {
105         my($expr,$varlist) = @_;
106
107         die("Undefined value in ParseExpr") if not defined($expr);
108
109         my @tokens = split /((?:[A-Za-z_])(?:(?:(?:[A-Za-z0-9_.])|(?:->))+))/, $expr;
110         my $ret = "";
111
112         foreach my $t (@tokens) {
113                 if (defined($varlist->{$t})) {
114                         $ret .= $varlist->{$t};
115                 } else {
116                         $ret .= $t;
117                 }
118         }
119
120         return $ret;
121 }
122
123 1;