use strict;
+use Parse::Pidl::Util qw(has_property);
+
my($res);
my($tab_depth);
{
my($d) = shift;
- my $tf = EthParser::get_typefamily($d->{DATA}{TYPE});
+ my $tf = Parse::Pidl::Ethereal::NDR::Parser::get_typefamily($d->{DATA}{TYPE});
- return unless util::has_property($d, "public");
+ return unless has_property($d, "public");
- unless (util::has_property($d, "nopull")) {
+ unless (has_property($d, "nopull")) {
pidl "dcerpc_dissect_fnct_t $d->{NAME};\n";
}
}
use strict;
use Parse::Pidl::Typelist;
+use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::NDR;
# the list of needed functions
my $t = shift;
my $needed = shift;
- if (util::has_property($t, "public")) {
- $needed->{"pull_$t->{NAME}"} = not util::has_property($t, "nopull");
- $needed->{"decl_$t->{NAME}"} = not util::has_property($t, "nopull");
+ if (has_property($t, "public")) {
+ $needed->{"pull_$t->{NAME}"} = not has_property($t, "nopull");
+ $needed->{"decl_$t->{NAME}"} = not has_property($t, "nopull");
}
if ($t->{DATA}->{TYPE} eq "STRUCT" or $t->{DATA}->{TYPE} eq "UNION") {
{
my($e) = shift;
- if (my $base = util::has_property($e, "display")) {
+ if (my $base = has_property($e, "display")) {
return "BASE_" . uc($base);
}
{
my $e = shift;
- return "16", if util::has_property($e->{DATA}, "bitmap16bit");
- return "8", if util::has_property($e->{DATA}, "bitmap8bit");
+ return "16", if has_property($e->{DATA}, "bitmap16bit");
+ return "8", if has_property($e->{DATA}, "bitmap8bit");
return "32";
}
{
my $fn = shift;
- return "" if (util::has_property($fn, "public"));
+ return "" if (has_property($fn, "public"));
return "static ";
}
sub start_flags($)
{
my $e = shift;
- my $flags = util::has_property($e, "flag");
+ my $flags = has_property($e, "flag");
if (defined $flags) {
pidl "{ uint32_t _flags_save_$e->{TYPE} = ndr->flags;";
pidl "ndr_set_flags(&ndr->flags, $flags);";
sub end_flags($)
{
my $e = shift;
- my $flags = util::has_property($e, "flag");
+ my $flags = has_property($e, "flag");
if (defined $flags) {
pidl "ndr->flags = _flags_save_$e->{TYPE};\n\t}";
deindent;
my $compression = $l->{COMPRESSION};
my ($alg, $clen, $dlen) = split(/ /, $compression);
- return util::ParseExpr($clen, $env);
+ return ParseExpr($clen, $env);
}
sub compression_dlen($$$)
my $compression = $l->{COMPRESSION};
my ($alg, $clen, $dlen) = split(/ /, $compression);
- return util::ParseExpr($dlen, $env);
+ return ParseExpr($dlen, $env);
}
sub ParseCompressionStart($$$$)
{
my $e = shift;
my $ndr = shift;
- my $obfuscation = util::has_property($e, "obfuscation");
+ my $obfuscation = has_property($e, "obfuscation");
pidl "ndr_pull_obfuscation($ndr, $obfuscation);";
my($var_name) = shift;
my($ndr_flags) = shift;
my $env = shift;
- my $switch_var = util::ParseExpr($l->{SWITCH_IS}, $env);
+ my $switch_var = ParseExpr($l->{SWITCH_IS}, $env);
check_null_pointer($switch_var);
pidl "offset += dissect_$l->{DATA_TYPE}(tvb, offset, pinfo, tree, drep, hf_FIXME, NULL);";
- if (my $range = util::has_property($e, "range")) {
+ if (my $range = has_property($e, "range")) {
$var_name = get_value_of($var_name);
my ($low, $high) = split(/ /, $range, 2);
if (($l->{DATA_TYPE} =~ /^uint/) and ($low eq "0")) {
pidl "}";
}
} elsif ($l->{TYPE} eq "ARRAY") {
- my $length = util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $length = ParseExpr($l->{LENGTH_IS}, $env);
my $counter = "cntr_$e->{NAME}_$l->{LEVEL_INDEX}";
$var_name = $var_name . "[$counter]";
# $var_name contains the name of the first argument here
- my $length = util::ParseExpr($l->{SIZE_IS}, $env);
+ my $length = ParseExpr($l->{SIZE_IS}, $env);
my $size = $length;
if ($l->{IS_CONFORMANT}) {
}
if ($l->{IS_CONFORMANT}) {
- my $size = util::ParseExpr($l->{SIZE_IS}, $env);
+ my $size = ParseExpr($l->{SIZE_IS}, $env);
check_null_pointer($size);
pidl "NDR_CHECK(ndr_check_array_size(ndr, (void*)" . get_pointer_to($var_name) . ", $size));";
}
if ($l->{IS_VARYING}) {
- my $length = util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $length = ParseExpr($l->{LENGTH_IS}, $env);
check_null_pointer($length);
pidl "NDR_CHECK(ndr_check_array_length(ndr, (void*)" . get_pointer_to($var_name) . ", $length));";
}
# in epan/dissctors are deleted.
my $name = "\"" . uc($x->{NAME}) . " (pidl)\"";
- if (util::has_property($x, "helpstring")) {
+ if (has_property($x, "helpstring")) {
$name = $x->{PROPERTIES}->{helpstring};
}
my $short_name = "pidl_$x->{NAME}";
[#Rule 2
'idl', 2,
sub
-#line 19 "idl.yp"
+#line 19 "build/pidl/idl.yp"
{ push(@{$_[1]}, $_[2]); $_[1] }
],
[#Rule 3
'idl', 2,
sub
-#line 20 "idl.yp"
+#line 20 "build/pidl/idl.yp"
{ push(@{$_[1]}, $_[2]); $_[1] }
],
[#Rule 4
'coclass', 7,
sub
-#line 24 "idl.yp"
+#line 24 "build/pidl/idl.yp"
{$_[3] => {
"TYPE" => "COCLASS",
"PROPERTIES" => $_[1],
[#Rule 6
'interface_names', 4,
sub
-#line 36 "idl.yp"
+#line 36 "build/pidl/idl.yp"
{ push(@{$_[1]}, $_[2]); $_[1] }
],
[#Rule 7
'interface', 8,
sub
-#line 40 "idl.yp"
+#line 40 "build/pidl/idl.yp"
{$_[3] => {
"TYPE" => "INTERFACE",
"PROPERTIES" => $_[1],
[#Rule 9
'base_interface', 2,
sub
-#line 53 "idl.yp"
+#line 53 "build/pidl/idl.yp"
{ $_[2] }
],
[#Rule 10
'definitions', 1,
sub
-#line 57 "idl.yp"
+#line 57 "build/pidl/idl.yp"
{ [ $_[1] ] }
],
[#Rule 11
'definitions', 2,
sub
-#line 58 "idl.yp"
+#line 58 "build/pidl/idl.yp"
{ push(@{$_[1]}, $_[2]); $_[1] }
],
[#Rule 12
[#Rule 16
'const', 6,
sub
-#line 66 "idl.yp"
+#line 66 "build/pidl/idl.yp"
{{
"TYPE" => "CONST",
"DTYPE" => $_[2],
[#Rule 17
'const', 7,
sub
-#line 75 "idl.yp"
+#line 75 "build/pidl/idl.yp"
{{
"TYPE" => "CONST",
"DTYPE" => $_[2],
[#Rule 18
'function', 7,
sub
-#line 88 "idl.yp"
+#line 88 "build/pidl/idl.yp"
{{
"TYPE" => "FUNCTION",
"NAME" => $_[3],
[#Rule 19
'declare', 5,
sub
-#line 100 "idl.yp"
+#line 100 "build/pidl/idl.yp"
{{
"TYPE" => "DECLARE",
"PROPERTIES" => $_[2],
[#Rule 22
'decl_enum', 1,
sub
-#line 114 "idl.yp"
+#line 114 "build/pidl/idl.yp"
{{
"TYPE" => "ENUM"
}}
[#Rule 23
'decl_bitmap', 1,
sub
-#line 120 "idl.yp"
+#line 120 "build/pidl/idl.yp"
{{
"TYPE" => "BITMAP"
}}
[#Rule 24
'typedef', 6,
sub
-#line 126 "idl.yp"
+#line 126 "build/pidl/idl.yp"
{{
"TYPE" => "TYPEDEF",
"PROPERTIES" => $_[2],
[#Rule 30
'type', 1,
sub
-#line 138 "idl.yp"
+#line 138 "build/pidl/idl.yp"
{ "void" }
],
[#Rule 31
'enum', 4,
sub
-#line 143 "idl.yp"
+#line 143 "build/pidl/idl.yp"
{{
"TYPE" => "ENUM",
"ELEMENTS" => $_[3]
[#Rule 32
'enum_elements', 1,
sub
-#line 150 "idl.yp"
+#line 150 "build/pidl/idl.yp"
{ [ $_[1] ] }
],
[#Rule 33
'enum_elements', 3,
sub
-#line 151 "idl.yp"
+#line 151 "build/pidl/idl.yp"
{ push(@{$_[1]}, $_[3]); $_[1] }
],
[#Rule 34
[#Rule 35
'enum_element', 3,
sub
-#line 155 "idl.yp"
+#line 155 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 36
'bitmap', 4,
sub
-#line 159 "idl.yp"
+#line 159 "build/pidl/idl.yp"
{{
"TYPE" => "BITMAP",
"ELEMENTS" => $_[3]
[#Rule 37
'bitmap_elements', 1,
sub
-#line 166 "idl.yp"
+#line 166 "build/pidl/idl.yp"
{ [ $_[1] ] }
],
[#Rule 38
'bitmap_elements', 3,
sub
-#line 167 "idl.yp"
+#line 167 "build/pidl/idl.yp"
{ push(@{$_[1]}, $_[3]); $_[1] }
],
[#Rule 39
'bitmap_element', 3,
sub
-#line 170 "idl.yp"
+#line 170 "build/pidl/idl.yp"
{ "$_[1] ( $_[3] )" }
],
[#Rule 40
'struct', 4,
sub
-#line 174 "idl.yp"
+#line 174 "build/pidl/idl.yp"
{{
"TYPE" => "STRUCT",
"ELEMENTS" => $_[3]
[#Rule 41
'empty_element', 2,
sub
-#line 181 "idl.yp"
+#line 181 "build/pidl/idl.yp"
{{
"NAME" => "",
"TYPE" => "EMPTY",
[#Rule 44
'optional_base_element', 2,
sub
-#line 195 "idl.yp"
+#line 195 "build/pidl/idl.yp"
{ $_[2]->{PROPERTIES} = Parse::Pidl::Util::FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
],
[#Rule 45
[#Rule 46
'union_elements', 2,
sub
-#line 200 "idl.yp"
+#line 200 "build/pidl/idl.yp"
{ push(@{$_[1]}, $_[2]); $_[1] }
],
[#Rule 47
'union', 4,
sub
-#line 204 "idl.yp"
+#line 204 "build/pidl/idl.yp"
{{
"TYPE" => "UNION",
"ELEMENTS" => $_[3]
[#Rule 48
'base_element', 5,
sub
-#line 211 "idl.yp"
+#line 211 "build/pidl/idl.yp"
{{
"NAME" => $_[4],
"TYPE" => $_[2],
[#Rule 49
'pointers', 0,
sub
-#line 225 "idl.yp"
+#line 225 "build/pidl/idl.yp"
{ 0 }
],
[#Rule 50
'pointers', 2,
sub
-#line 226 "idl.yp"
+#line 226 "build/pidl/idl.yp"
{ $_[1]+1 }
],
[#Rule 51
[#Rule 52
'element_list1', 3,
sub
-#line 231 "idl.yp"
+#line 231 "build/pidl/idl.yp"
{ push(@{$_[1]}, $_[2]); $_[1] }
],
[#Rule 53
[#Rule 55
'element_list2', 1,
sub
-#line 237 "idl.yp"
+#line 237 "build/pidl/idl.yp"
{ [ $_[1] ] }
],
[#Rule 56
'element_list2', 3,
sub
-#line 238 "idl.yp"
+#line 238 "build/pidl/idl.yp"
{ push(@{$_[1]}, $_[3]); $_[1] }
],
[#Rule 57
[#Rule 58
'array_len', 3,
sub
-#line 243 "idl.yp"
+#line 243 "build/pidl/idl.yp"
{ push(@{$_[3]}, "*"); $_[3] }
],
[#Rule 59
'array_len', 4,
sub
-#line 244 "idl.yp"
+#line 244 "build/pidl/idl.yp"
{ push(@{$_[4]}, "$_[2]"); $_[4] }
],
[#Rule 60
[#Rule 61
'property_list', 4,
sub
-#line 250 "idl.yp"
+#line 250 "build/pidl/idl.yp"
{ Parse::Pidl::Util::FlattenHash([$_[1],$_[3]]); }
],
[#Rule 62
'properties', 1,
sub
-#line 253 "idl.yp"
+#line 253 "build/pidl/idl.yp"
{ $_[1] }
],
[#Rule 63
'properties', 3,
sub
-#line 254 "idl.yp"
+#line 254 "build/pidl/idl.yp"
{ Parse::Pidl::Util::FlattenHash([$_[1], $_[3]]); }
],
[#Rule 64
'property', 1,
sub
-#line 257 "idl.yp"
+#line 257 "build/pidl/idl.yp"
{{ "$_[1]" => "1" }}
],
[#Rule 65
'property', 4,
sub
-#line 258 "idl.yp"
+#line 258 "build/pidl/idl.yp"
{{ "$_[1]" => "$_[3]" }}
],
[#Rule 66
[#Rule 67
'listtext', 3,
sub
-#line 263 "idl.yp"
+#line 263 "build/pidl/idl.yp"
{ "$_[1] $_[3]" }
],
[#Rule 68
[#Rule 69
'commalisttext', 3,
sub
-#line 268 "idl.yp"
+#line 268 "build/pidl/idl.yp"
{ "$_[1],$_[3]" }
],
[#Rule 70
'anytext', 0,
sub
-#line 272 "idl.yp"
+#line 272 "build/pidl/idl.yp"
{ "" }
],
[#Rule 71
[#Rule 74
'anytext', 3,
sub
-#line 274 "idl.yp"
+#line 274 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 75
'anytext', 3,
sub
-#line 275 "idl.yp"
+#line 275 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 76
'anytext', 3,
sub
-#line 276 "idl.yp"
+#line 276 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 77
'anytext', 3,
sub
-#line 277 "idl.yp"
+#line 277 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 78
'anytext', 3,
sub
-#line 278 "idl.yp"
+#line 278 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 79
'anytext', 3,
sub
-#line 279 "idl.yp"
+#line 279 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 80
'anytext', 3,
sub
-#line 280 "idl.yp"
+#line 280 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 81
'anytext', 3,
sub
-#line 281 "idl.yp"
+#line 281 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 82
'anytext', 3,
sub
-#line 282 "idl.yp"
+#line 282 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 83
'anytext', 3,
sub
-#line 283 "idl.yp"
+#line 283 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]" }
],
[#Rule 84
'anytext', 5,
sub
-#line 284 "idl.yp"
+#line 284 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]$_[4]$_[5]" }
],
[#Rule 85
'anytext', 5,
sub
-#line 285 "idl.yp"
+#line 285 "build/pidl/idl.yp"
{ "$_[1]$_[2]$_[3]$_[4]$_[5]" }
],
[#Rule 86
[#Rule 88
'text', 1,
sub
-#line 294 "idl.yp"
+#line 294 "build/pidl/idl.yp"
{ "\"$_[1]\"" }
],
[#Rule 89
bless($self,$class);
}
-#line 305 "idl.yp"
+#line 305 "build/pidl/idl.yp"
use Parse::Pidl::Util;
+#####################################################################
+# traverse a perl data structure removing any empty arrays or
+# hashes and any hash elements that map to undef
+sub CleanData($)
+{
+ sub CleanData($);
+ my($v) = shift;
+ if (ref($v) eq "ARRAY") {
+ foreach my $i (0 .. $#{$v}) {
+ CleanData($v->[$i]);
+ 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};
+ } elsif (ref($v) eq "HASH") {
+ foreach my $x (keys %{$v}) {
+ CleanData($v->{$x});
+ if (!defined $v->{$x}) { delete($v->{$x}); next; }
+ if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
+ }
+ }
+ return $v;
+}
+
sub _Error {
if (exists $_[0]->YYData->{ERRMSG}) {
print $_[0]->YYData->{ERRMSG};
my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
- return Parse::Pidl::Util::CleanData($idl);
+ return CleanData($idl);
}
1;
package Parse::Pidl::NDR;
+use Exporter 'import';
+@EXPORT_OK = qw(GetPrevLevel GetNextLevel);
+
use strict;
-use Parse::Pidl::Typelist;
+use Parse::Pidl::Typelist qw(hasType getType);
use Parse::Pidl::Util qw(has_property property_matches);
sub nonfatal($$)
return 1 if ($e->{POINTERS});
return 0 if (Parse::Pidl::Typelist::is_scalar($e->{TYPE}));
- return 1 unless (Parse::Pidl::Typelist::hasType($e->{TYPE})); # assume the worst
+ return 1 unless (hasType($e->{TYPE})); # assume the worst
- my $type = Parse::Pidl::Typelist::getType($e->{TYPE});
+ my $type = getType($e->{TYPE});
foreach my $x (@{$type->{DATA}->{ELEMENTS}}) {
return 1 if (can_contain_deferred ($x));
{
my $e = shift;
- unless (Parse::Pidl::Typelist::hasType($e)) {
+ unless (hasType($e)) {
# it must be an external type - all we can do is guess
# print "Warning: assuming alignment of unknown type '$e' is 4\n";
return 4;
}
- my $dt = Parse::Pidl::Typelist::getType($e)->{DATA};
+ my $dt = getType($e)->{DATA};
if ($dt->{TYPE} eq "ENUM") {
return align_type(Parse::Pidl::Typelist::enum_type_fn($dt));
package Parse::Pidl::ODL;
use Parse::Pidl::Util qw(has_property);
+use Parse::Pidl::Typelist qw(hasType getType);
use strict;
#####################################################################
my $e = shift;
foreach my $x (@{$e->{ELEMENTS}}) {
- next unless (Parse::Pidl::Typelist::hasType($x->{TYPE}));
- next unless Parse::Pidl::Typelist::getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
+ next unless (hasType($x->{TYPE}));
+ next unless getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
$x->{TYPE} = "MInterfacePointer";
}
use strict;
use Parse::Pidl::Typelist;
use Parse::Pidl::Util qw(has_property);
+use Parse::Pidl::NDR qw(GetNextLevel GetPrevLevel);
use Parse::Pidl::Samba::NDR::Parser;
my($res);
foreach my $l (@{$element->{LEVELS}})
{
if (($l->{TYPE} eq "POINTER")) {
- my $nl = Parse::Pidl::NDR::GetNextLevel($element, $l);
- $nl = Parse::Pidl::NDR::GetNextLevel($element, $nl) if ($nl->{TYPE} eq "SUBCONTEXT");
+ my $nl = GetNextLevel($element, $l);
+ $nl = GetNextLevel($element, $nl) if ($nl->{TYPE} eq "SUBCONTEXT");
next if ($nl->{TYPE} eq "DATA" and Parse::Pidl::Typelist::scalar_is_reference($nl->{DATA_TYPE}));
$prefix .= "*";
} elsif ($l->{TYPE} eq "ARRAY") {
- my $pl = Parse::Pidl::NDR::GetPrevLevel($element, $l);
+ my $pl = GetPrevLevel($element, $l);
next if ($pl and $pl->{TYPE} eq "POINTER");
if ($l->{IS_FIXED}) {
use strict;
use Parse::Pidl::Typelist;
-use Parse::Pidl::Util qw(has_property);
+use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::NDR;
# list of known types
if ($l->{IS_ZERO_TERMINATED}) {
$size = $length = "ndr_string_length($var_name, sizeof(*$var_name))";
} else {
- $size = Parse::Pidl::Util::ParseExpr($l->{SIZE_IS}, $env);
- $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
+ $size = ParseExpr($l->{SIZE_IS}, $env);
+ $length = ParseExpr($l->{LENGTH_IS}, $env);
}
if ((!$l->{IS_SURROUNDING}) and $l->{IS_CONFORMANT}) {
} elsif ($l->{IS_ZERO_TERMINATED}) { # Noheader arrays
$length = $size = "ndr_get_string_size($ndr, sizeof(*$var_name))";
} else {
- $length = $size = Parse::Pidl::Util::ParseExpr($l->{SIZE_IS}, $env);
+ $length = $size = ParseExpr($l->{SIZE_IS}, $env);
}
if ((!$l->{IS_SURROUNDING}) and $l->{IS_CONFORMANT}) {
}
if ($l->{IS_CONFORMANT} and not $l->{IS_ZERO_TERMINATED}) {
- my $size = Parse::Pidl::Util::ParseExpr($l->{SIZE_IS}, $env);
+ my $size = ParseExpr($l->{SIZE_IS}, $env);
check_null_pointer($size);
pidl "NDR_CHECK(ndr_check_array_size(ndr, (void*)" . get_pointer_to($var_name) . ", $size));";
}
if ($l->{IS_VARYING} and not $l->{IS_ZERO_TERMINATED}) {
- my $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $length = ParseExpr($l->{LENGTH_IS}, $env);
check_null_pointer($length);
pidl "NDR_CHECK(ndr_check_array_length(ndr, (void*)" . get_pointer_to($var_name) . ", $length));";
}
my $compression = $l->{COMPRESSION};
my ($alg, $clen, $dlen) = split(/ /, $compression);
- return Parse::Pidl::Util::ParseExpr($clen, $env);
+ return ParseExpr($clen, $env);
}
sub compression_dlen($$$)
my $compression = $l->{COMPRESSION};
my ($alg, $clen, $dlen) = split(/ /, $compression);
- return Parse::Pidl::Util::ParseExpr($dlen, $env);
+ return ParseExpr($dlen, $env);
}
sub ParseCompressionPushStart($$$)
{
my ($e,$l,$ndr_flags,$env) = @_;
my $ndr = "_ndr_$e->{NAME}";
- my $subcontext_size = Parse::Pidl::Util::ParseExpr($l->{SUBCONTEXT_SIZE},$env);
+ my $subcontext_size = ParseExpr($l->{SUBCONTEXT_SIZE},$env);
if (defined $l->{COMPRESSION}) {
ParseCompressionPushEnd($e, $l, $ndr);
{
my ($e,$l,$ndr,$var_name,$ndr_flags,$env) = @_;
my $retndr = "_ndr_$e->{NAME}";
- my $subcontext_size = Parse::Pidl::Util::ParseExpr($l->{SUBCONTEXT_SIZE},$env);
+ my $subcontext_size = ParseExpr($l->{SUBCONTEXT_SIZE},$env);
pidl "{";
indent;
my $advance;
if (defined($l->{SUBCONTEXT_SIZE}) and ($l->{SUBCONTEXT_SIZE} ne "-1")) {
- $advance = Parse::Pidl::Util::ParseExpr($l->{SUBCONTEXT_SIZE},$env);
+ $advance = ParseExpr($l->{SUBCONTEXT_SIZE},$env);
} elsif ($l->{HEADER_SIZE}) {
$advance = "$ndr->data_size";
} else {
pidl "}";
}
} elsif ($l->{TYPE} eq "ARRAY" and not is_scalar_array($e,$l)) {
- my $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $length = ParseExpr($l->{LENGTH_IS}, $env);
my $counter = "cntr_$e->{NAME}_$l->{LEVEL_INDEX}";
$var_name = $var_name . "[$counter]";
start_flags($e);
if (my $value = has_property($e, "value")) {
- $var_name = Parse::Pidl::Util::ParseExpr($value, $env);
+ $var_name = ParseExpr($value, $env);
}
ParseElementPushLevel($e, $e->{LEVELS}[0], $ndr, $var_name, $env, $primitives, $deferred);
return if (has_property($e, "noprint"));
if (my $value = has_property($e, "value")) {
- $var_name = "(ndr->flags & LIBNDR_PRINT_SET_VALUES)?" . Parse::Pidl::Util::ParseExpr($value,$env) . ":$var_name";
+ $var_name = "(ndr->flags & LIBNDR_PRINT_SET_VALUES)?" . ParseExpr($value,$env) . ":$var_name";
}
foreach my $l (@{$e->{LEVELS}}) {
if ($l->{IS_ZERO_TERMINATED}) {
$length = "ndr_string_length($var_name, sizeof(*$var_name))";
} else {
- $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
+ $length = ParseExpr($l->{LENGTH_IS}, $env);
}
if (is_scalar_array($e, $l)) {
}
pidl "ndr_print_$l->{DATA_TYPE}(ndr, \"$e->{NAME}\", $var_name);";
} elsif ($l->{TYPE} eq "SWITCH") {
- my $switch_var = Parse::Pidl::Util::ParseExpr($l->{SWITCH_IS}, $env);
+ my $switch_var = ParseExpr($l->{SWITCH_IS}, $env);
check_null_pointer_void($switch_var);
pidl "ndr_print_set_switch_value(ndr, " . get_pointer_to($var_name) . ", $switch_var);";
}
sub ParseSwitchPull($$$$$$)
{
my($e,$l,$ndr,$var_name,$ndr_flags,$env) = @_;
- my $switch_var = Parse::Pidl::Util::ParseExpr($l->{SWITCH_IS}, $env);
+ my $switch_var = ParseExpr($l->{SWITCH_IS}, $env);
check_null_pointer($switch_var);
sub ParseSwitchPush($$$$$$)
{
my($e,$l,$ndr,$var_name,$ndr_flags,$env) = @_;
- my $switch_var = Parse::Pidl::Util::ParseExpr($l->{SWITCH_IS}, $env);
+ my $switch_var = ParseExpr($l->{SWITCH_IS}, $env);
check_null_pointer($switch_var);
$var_name = get_pointer_to($var_name);
pidl "}";
}
} elsif ($l->{TYPE} eq "ARRAY" and not is_scalar_array($e,$l)) {
- my $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $length = ParseExpr($l->{LENGTH_IS}, $env);
my $counter = "cntr_$e->{NAME}_$l->{LEVEL_INDEX}";
$var_name = $var_name . "[$counter]";
if (defined($e->{LEVELS}[0]) and
$e->{LEVELS}[0]->{TYPE} eq "ARRAY") {
- my $size = Parse::Pidl::Util::ParseExpr($e->{LEVELS}[0]->{SIZE_IS}, $env);
+ my $size = ParseExpr($e->{LEVELS}[0]->{SIZE_IS}, $env);
pidl "NDR_CHECK(ndr_push_uint32(ndr, NDR_SCALARS, $size));";
} else {
return if (has_property($e, "charset"));
- my $var = Parse::Pidl::Util::ParseExpr($e->{NAME}, $env);
+ my $var = ParseExpr($e->{NAME}, $env);
check_null_pointer($size);
my $pl = Parse::Pidl::NDR::GetPrevLevel($e, $l);
and $e->{LEVELS}[1]->{IS_ZERO_TERMINATED});
if ($e->{LEVELS}[1]->{TYPE} eq "ARRAY") {
- my $size = Parse::Pidl::Util::ParseExpr($e->{LEVELS}[1]->{SIZE_IS}, $env);
+ my $size = ParseExpr($e->{LEVELS}[1]->{SIZE_IS}, $env);
check_null_pointer($size);
pidl "NDR_ALLOC_N(ndr, r->out.$e->{NAME}, $size);";
package Parse::Pidl::Typelist;
+use Exporter 'import';
+@EXPORT_OK = qw(hasType getType);
+
use Parse::Pidl::Util qw(has_property);
use strict;
package Parse::Pidl::Util;
use Exporter 'import';
-@EXPORT_OK = qw(has_property property_matches);
+@EXPORT_OK = qw(has_property property_matches ParseExpr);
use strict;
return \%b;
}
-#####################################################################
-# traverse a perl data structure removing any empty arrays or
-# hashes and any hash elements that map to undef
-sub CleanData($)
-{
- sub CleanData($);
- my($v) = shift;
- if (ref($v) eq "ARRAY") {
- foreach my $i (0 .. $#{$v}) {
- CleanData($v->[$i]);
- 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};
- } elsif (ref($v) eq "HASH") {
- foreach my $x (keys %{$v}) {
- CleanData($v->{$x});
- if (!defined $v->{$x}) { delete($v->{$x}); next; }
- if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
- }
- }
- return $v;
-}
-
#####################################################################
# return the modification time of a file
sub FileModtime($)
package Parse::Pidl::Validator;
use Parse::Pidl::Util qw(has_property);
+use Parse::Pidl::Typelist qw(hasType getType);
use strict;
sub mapToScalar($)
{
my $t = shift;
- my $ti = Parse::Pidl::Typelist::getType($t);
+ my $ti = getType($t);
if (not defined ($ti)) {
return undef;
# Check whether switches are used correctly.
if (my $switch = has_property($e, "switch_is")) {
my $e2 = find_sibling($e, $switch);
- my $type = Parse::Pidl::Typelist::getType($e->{TYPE});
+ my $type = getType($e->{TYPE});
if (defined($type) and $type->{DATA}->{TYPE} ne "UNION") {
fatal($e, el_name($e) . ": switch_is() used on non-union type $e->{TYPE} which is a $type->{DATA}->{TYPE}");
use Parse::Pidl::Util;
+#####################################################################
+# traverse a perl data structure removing any empty arrays or
+# hashes and any hash elements that map to undef
+sub CleanData($)
+{
+ sub CleanData($);
+ my($v) = shift;
+ if (ref($v) eq "ARRAY") {
+ foreach my $i (0 .. $#{$v}) {
+ CleanData($v->[$i]);
+ 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};
+ } elsif (ref($v) eq "HASH") {
+ foreach my $x (keys %{$v}) {
+ CleanData($v->{$x});
+ if (!defined $v->{$x}) { delete($v->{$x}); next; }
+ if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
+ }
+ }
+ return $v;
+}
+
sub _Error {
if (exists $_[0]->YYData->{ERRMSG}) {
print $_[0]->YYData->{ERRMSG};
my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
- return Parse::Pidl::Util::CleanData($idl);
+ return CleanData($idl);
}