+++ /dev/null
-all: idl.pm
-
-idl.pm: idl.yp
- yapp -s idl.yp
-
-clean:
- rm -f idl.pm
--- /dev/null
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ 'NAME' => 'Parse::Pidl',
+ 'VERSION_FROM' => 'Parse/Pidl.pm',
+ 'EXE_FILES' => [ 'pidl' ],
+ 'PMLIBDIRS' => [ 'Parse' ],
+ 'C' => [],
+);
+
+sub MY::postamble {
+<<'EOT';
+Parse/Pidl/IDL.pm :: idl.yp
+ yapp -s -m 'Parse::Pidl::IDL' -o 'Parse/Pidl/IDL.pm' idl.yp
+EOT
+}
--- /dev/null
+###################################################
+# package to parse IDL files and generate code for
+# rpc functions in Samba
+# Copyright tridge@samba.org 2000-2003
+# Copyright jelmer@samba.org 2005
+# released under the GNU GPL
+
+package Parse::Pidl;
+
+use strict;
+
+use vars qw ( $VERSION );
+
+$VERSION = '0.01';
+
+1;
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
-package IDLCompat;
+package Parse::Pidl::Compat;
use strict;
# Copyright tridge@samba.org 2000
# released under the GNU GPL
-package IdlDump;
+package Parse::Pidl::Dump;
use strict;
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
-package EthHeader;
+package Parse::Pidl::Ethereal::NDR::Header;
use strict;
# Copyright jelmer@samba.org 2004-2005
# released under the GNU GPL
-package EthParser;
+package Parse::Pidl::Ethereal::NDR::Parser;
use strict;
-use pidl::typelist;
-use pidl::ndr;
+use Parse::Pidl::Typelist;
+use Parse::Pidl::NDR;
# the list of needed functions
# ANY CHANGE MADE HERE WILL BE LOST !
#
####################################################################
-package idl;
+package Parse::Pidl::IDL;
use vars qw ( @ISA );
use strict;
'optional_base_element', 2,
sub
#line 195 "build/pidl/idl.yp"
-{ $_[2]->{PROPERTIES} = util::FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
+{ $_[2]->{PROPERTIES} = Parse::Pidl::Util::FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
],
[#Rule 45
'union_elements', 0, undef
'property_list', 4,
sub
#line 250 "build/pidl/idl.yp"
-{ util::FlattenHash([$_[1],$_[3]]); }
+{ Parse::Pidl::Util::FlattenHash([$_[1],$_[3]]); }
],
[#Rule 62
'properties', 1,
'properties', 3,
sub
#line 254 "build/pidl/idl.yp"
-{ util::FlattenHash([$_[1], $_[3]]); }
+{ Parse::Pidl::Util::FlattenHash([$_[1], $_[3]]); }
],
[#Rule 64
'property', 1,
#line 305 "build/pidl/idl.yp"
-use pidl::util;
+use Parse::Pidl::Util;
sub _Error {
if (exists $_[0]->YYData->{ERRMSG}) {
my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
- return util::CleanData($idl);
+ return Parse::Pidl::Util::CleanData($idl);
}
1;
# Copyright jelmer@samba.org 2004-2005
# released under the GNU GPL
-package Ndr;
+package Parse::Pidl::NDR;
use strict;
-use pidl::typelist;
+use Parse::Pidl::Typelist;
sub nonfatal($$)
{
my @length_is = ();
my @size_is = ();
- if (util::has_property($e, "size_is")) {
- @size_is = split /,/, util::has_property($e, "size_is");
+ if (Parse::Pidl::Util::has_property($e, "size_is")) {
+ @size_is = split /,/, Parse::Pidl::Util::has_property($e, "size_is");
}
- if (util::has_property($e, "length_is")) {
- @length_is = split /,/, util::has_property($e, "length_is");
+ if (Parse::Pidl::Util::has_property($e, "length_is")) {
+ @length_is = split /,/, Parse::Pidl::Util::has_property($e, "length_is");
}
if (defined($e->{ARRAY_LEN})) {
if ($d eq "*") {
$is_conformant = 1;
if ($size = shift @size_is) {
- } elsif ((scalar(@size_is) == 0) and util::has_property($e, "string")) {
+ } elsif ((scalar(@size_is) == 0) and Parse::Pidl::Util::has_property($e, "string")) {
$is_string = 1;
delete($e->{PROPERTIES}->{string});
} else {
IS_ZERO_TERMINATED => "$is_string",
IS_VARYING => "$is_varying",
IS_CONFORMANT => "$is_conformant",
- IS_FIXED => (not $is_conformant and util::is_constant($size)),
- IS_INLINE => (not $is_conformant and not util::is_constant($size))
+ IS_FIXED => (not $is_conformant and Parse::Pidl::Util::is_constant($size)),
+ IS_INLINE => (not $is_conformant and not Parse::Pidl::Util::is_constant($size))
});
}
}
}
- if (scalar(@size_is) == 0 and util::has_property($e, "string")) {
+ if (scalar(@size_is) == 0 and Parse::Pidl::Util::has_property($e, "string")) {
$is_string = 1;
- $is_varying = $is_conformant = util::has_property($e, "noheader")?0:1;
+ $is_varying = $is_conformant = Parse::Pidl::Util::has_property($e, "noheader")?0:1;
delete($e->{PROPERTIES}->{string});
}
}
}
- if (defined(util::has_property($e, "subcontext"))) {
- my $hdr_size = util::has_property($e, "subcontext");
- my $subsize = util::has_property($e, "subcontext_size");
+ if (defined(Parse::Pidl::Util::has_property($e, "subcontext"))) {
+ my $hdr_size = Parse::Pidl::Util::has_property($e, "subcontext");
+ my $subsize = Parse::Pidl::Util::has_property($e, "subcontext_size");
if (not defined($subsize)) {
$subsize = -1;
}
HEADER_SIZE => $hdr_size,
SUBCONTEXT_SIZE => $subsize,
IS_DEFERRED => $is_deferred,
- COMPRESSION => util::has_property($e, "compression"),
- OBFUSCATION => util::has_property($e, "obfuscation")
+ COMPRESSION => Parse::Pidl::Util::has_property($e, "compression"),
+ OBFUSCATION => Parse::Pidl::Util::has_property($e, "obfuscation")
});
}
- if (my $switch = util::has_property($e, "switch_is")) {
+ if (my $switch = Parse::Pidl::Util::has_property($e, "switch_is")) {
push (@$order, {
TYPE => "SWITCH",
SWITCH_IS => $switch,
nonfatal($e, "length_is() on non-array element");
}
- if (util::has_property($e, "string")) {
+ if (Parse::Pidl::Util::has_property($e, "string")) {
nonfatal($e, "string() attribute on non-array element");
}
my $e = shift;
return 1 if ($e->{POINTERS});
- return 0 if (typelist::is_scalar($e->{TYPE}));
- return 1 unless (typelist::hasType($e->{TYPE})); # assume the worst
+ return 0 if (Parse::Pidl::Typelist::is_scalar($e->{TYPE}));
+ return 1 unless (Parse::Pidl::Typelist::hasType($e->{TYPE})); # assume the worst
- my $type = typelist::getType($e->{TYPE});
+ my $type = Parse::Pidl::Typelist::getType($e->{TYPE});
foreach my $x (@{$type->{DATA}->{ELEMENTS}}) {
return 1 if (can_contain_deferred ($x));
return undef unless $e->{POINTERS};
- return "ref" if (util::has_property($e, "ref"));
- return "ptr" if (util::has_property($e, "ptr"));
- return "sptr" if (util::has_property($e, "sptr"));
- return "unique" if (util::has_property($e, "unique"));
- return "relative" if (util::has_property($e, "relative"));
- return "ignore" if (util::has_property($e, "ignore"));
+ return "ref" if (Parse::Pidl::Util::has_property($e, "ref"));
+ return "ptr" if (Parse::Pidl::Util::has_property($e, "ptr"));
+ return "sptr" if (Parse::Pidl::Util::has_property($e, "sptr"));
+ return "unique" if (Parse::Pidl::Util::has_property($e, "unique"));
+ return "relative" if (Parse::Pidl::Util::has_property($e, "relative"));
+ return "ignore" if (Parse::Pidl::Util::has_property($e, "ignore"));
return undef;
}
{
my $e = shift;
- unless (typelist::hasType($e)) {
+ unless (Parse::Pidl::Typelist::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 = typelist::getType($e)->{DATA};
+ my $dt = Parse::Pidl::Typelist::getType($e)->{DATA};
if ($dt->{TYPE} eq "ENUM") {
- return align_type(typelist::enum_type_fn($dt));
+ return align_type(Parse::Pidl::Typelist::enum_type_fn($dt));
} elsif ($dt->{TYPE} eq "BITMAP") {
- return align_type(typelist::bitmap_type_fn($dt));
+ return align_type(Parse::Pidl::Typelist::bitmap_type_fn($dt));
} elsif (($dt->{TYPE} eq "STRUCT") or ($dt->{TYPE} eq "UNION")) {
return find_largest_alignment($dt);
} elsif ($dt->{TYPE} eq "SCALAR") {
- return typelist::getScalarAlignment($dt->{NAME});
+ return Parse::Pidl::Typelist::getScalarAlignment($dt->{NAME});
}
die("Unknown data type type $dt->{TYPE}");
}
if (defined $e->{TYPE} && $e->{TYPE} eq "string"
- && util::property_matches($e, "flag", ".*LIBNDR_FLAG_STR_CONFORMANT.*")) {
+ && Parse::Pidl::Util::property_matches($e, "flag", ".*LIBNDR_FLAG_STR_CONFORMANT.*")) {
$surrounding = $struct->{ELEMENTS}[-1];
}
{
my $e = shift;
my @elements = ();
- my $switch_type = util::has_property($e, "switch_type");
+ my $switch_type = Parse::Pidl::Util::has_property($e, "switch_type");
unless (defined($switch_type)) { $switch_type = "uint32"; }
- if (util::has_property($e, "nodiscriminant")) { $switch_type = undef; }
+ if (Parse::Pidl::Util::has_property($e, "nodiscriminant")) { $switch_type = undef; }
foreach my $x (@{$e->{ELEMENTS}})
{
} else {
$t = ParseElement($x);
}
- if (util::has_property($x, "default")) {
+ if (Parse::Pidl::Util::has_property($x, "default")) {
$t->{CASE} = "default";
} elsif (defined($x->{PROPERTIES}->{case})) {
$t->{CASE} = "case $x->{PROPERTIES}->{case}";
return {
TYPE => "ENUM",
- BASE_TYPE => typelist::enum_type_fn($e),
+ BASE_TYPE => Parse::Pidl::Typelist::enum_type_fn($e),
ELEMENTS => $e->{ELEMENTS},
PROPERTIES => $e->{PROPERTIES}
};
return {
TYPE => "BITMAP",
- BASE_TYPE => typelist::bitmap_type_fn($e),
+ BASE_TYPE => Parse::Pidl::Typelist::bitmap_type_fn($e),
ELEMENTS => $e->{ELEMENTS},
PROPERTIES => $e->{PROPERTIES}
};
foreach my $x (@{$d->{ELEMENTS}}) {
my $e = ParseElement($x);
- push (@{$e->{DIRECTION}}, "in") if (util::has_property($x, "in"));
- push (@{$e->{DIRECTION}}, "out") if (util::has_property($x, "out"));
+ push (@{$e->{DIRECTION}}, "in") if (Parse::Pidl::Util::has_property($x, "in"));
+ push (@{$e->{DIRECTION}}, "out") if (Parse::Pidl::Util::has_property($x, "out"));
push (@elements, $e);
}
my $default = shift;
foreach my $e (@{$s->{ELEMENTS}}) {
- if ($e->{POINTERS} and not defined(Ndr::pointer_type($e))) {
+ if ($e->{POINTERS} and not defined(pointer_type($e))) {
$e->{PROPERTIES}->{$default} = 1;
}
}
my $opnum = 0;
my $version;
- if (not util::has_property($idl, "pointer_default")) {
+ if (not Parse::Pidl::Util::has_property($idl, "pointer_default")) {
# MIDL defaults to "ptr" in DCE compatible mode (/osf)
# and "unique" in Microsoft Extensions mode (default)
$idl->{PROPERTIES}->{pointer_default} = "unique";
}
- if (not util::has_property($idl, "pointer_default_top")) {
+ if (not Parse::Pidl::Util::has_property($idl, "pointer_default_top")) {
$idl->{PROPERTIES}->{pointer_default_top} = "ref";
}
return {
NAME => $idl->{NAME},
- UUID => util::has_property($idl, "uuid"),
+ UUID => Parse::Pidl::Util::has_property($idl, "uuid"),
VERSION => $version,
TYPE => "INTERFACE",
PROPERTIES => $idl->{PROPERTIES},
do {
return 1 if ($l->{IS_DEFERRED});
return 1 if ($l->{CONTAINS_DEFERRED});
- } while ($l = Ndr::GetNextLevel($e,$l));
+ } while ($l = GetNextLevel($e,$l));
return 0;
}
# Converts ODL stuctures to IDL structures
# (C) 2004-2005 Jelmer Vernooij <jelmer@samba.org>
-package ODL;
+package Parse::Pidl::ODL;
use strict;
my $e = shift;
foreach my $x (@{$e->{ELEMENTS}}) {
- next unless (typelist::hasType($x->{TYPE}));
- next unless typelist::getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
+ next unless (Parse::Pidl::Typelist::hasType($x->{TYPE}));
+ next unless Parse::Pidl::Typelist::getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
$x->{TYPE} = "MInterfacePointer";
}
# Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
# and replace interfacepointers with MInterfacePointer
# for 'object' interfaces
- if (util::has_property($x, "object")) {
+ if (Parse::Pidl::Util::has_property($x, "object")) {
foreach my $e (@{$x->{DATA}}) {
($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
ReplaceInterfacePointers($e);
}
# Object interfaces use ORPC
my @depends = ();
- if(util::has_property($x, "depends")) {
+ if(Parse::Pidl::Util::has_property($x, "depends")) {
@depends = split /,/, $x->{PROPERTIES}->{depends};
}
push @depends, "orpc";
# COM Header generation
# (C) 2005 Jelmer Vernooij <jelmer@samba.org>
-package COMHeader;
+package Parse::Pidl::Samba::COM::Header;
-use pidl::typelist;
+use Parse::Pidl::Typelist;
use strict;
foreach my $a (@{$f->{ELEMENTS}}) {
- $res .= ", " . typelist::mapType($a->{TYPE}) . " ";
+ $res .= ", " . Parse::Pidl::Typelist::mapType($a->{TYPE}) . " ";
my $l = $a->{POINTERS};
- $l-- if (typelist::scalar_is_reference($a->{TYPE}));
+ $l-- if (Parse::Pidl::Typelist::scalar_is_reference($a->{TYPE}));
foreach my $i (1..$l) {
$res .= "*";
}
if (defined $a->{ARRAY_LEN}[0] &&
- !util::is_constant($a->{ARRAY_LEN}[0]) &&
+ !Parse::Pidl::Util::is_constant($a->{ARRAY_LEN}[0]) &&
!$a->{POINTERS}) {
$res .= "*";
}
$res .= $a->{NAME};
- if (defined $a->{ARRAY_LEN}[0] && util::is_constant($a->{ARRAY_LEN}[0])) {
+ if (defined $a->{ARRAY_LEN}[0] && Parse::Pidl::Util::is_constant($a->{ARRAY_LEN}[0])) {
$res .= "[$a->{ARRAY_LEN}[0]]";
}
}
my $data = $interface->{DATA};
foreach my $d (@{$data}) {
- $res .= "\t" . typelist::mapType($d->{RETURN_TYPE}) . " (*$d->{NAME}) (struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . GetArgumentProtoList($d) . ");\\\n" if ($d->{TYPE} eq "FUNCTION");
+ $res .= "\t" . Parse::Pidl::Typelist::mapType($d->{RETURN_TYPE}) . " (*$d->{NAME}) (struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . GetArgumentProtoList($d) . ");\\\n" if ($d->{TYPE} eq "FUNCTION");
}
$res .= "\n";
$res .= "struct $interface->{NAME}_vtable {\n";
my $c = shift;
my $res = "";
$res .= "#define CLSID_" . uc($c->{NAME}) . " $c->{PROPERTIES}->{uuid}\n";
- if (util::has_property($c, "progid")) {
+ if (Parse::Pidl::Util::has_property($c, "progid")) {
$res .= "#define PROGID_" . uc($c->{NAME}) . " $c->{PROPERTIES}->{progid}\n";
}
$res .= "\n";
foreach my $x (@{$idl})
{
- if ($x->{TYPE} eq "INTERFACE" && util::has_property($x, "object")) {
+ if ($x->{TYPE} eq "INTERFACE" && Parse::Pidl::Util::has_property($x, "object")) {
$res.=ParseInterface($x);
}
# Copyright jelmer@samba.org 2003-2005
# released under the GNU GPL
-package DCOMProxy;
+package Parse::Pidl::Samba::COM::Proxy;
-use pidl::com_header;
+use Parse::Pidl::Samba::COM::Header;
use strict;
my $uname = uc $name;
$res.="
-static $fn->{RETURN_TYPE} dcom_proxy_$interface->{NAME}_$name(struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . COMHeader::GetArgumentProtoList($fn) . ")
+static $fn->{RETURN_TYPE} dcom_proxy_$interface->{NAME}_$name(struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . Parse::Pidl::Samba::COM::Header::GetArgumentProtoList($fn) . ")
{
struct dcerpc_pipe *p;
NTSTATUS status = dcom_get_pipe(d, &p);
# Put arguments into r
foreach my $a (@{$fn->{ELEMENTS}}) {
- next unless (util::has_property($a, "in"));
- if (typelist::typeIs($a->{TYPE}, "INTERFACE")) {
+ next unless (Parse::Pidl::Util::has_property($a, "in"));
+ if (Parse::Pidl::Typelist::typeIs($a->{TYPE}, "INTERFACE")) {
$res .="\tNDR_CHECK(dcom_OBJREF_from_IUnknown(&r.in.$a->{NAME}.obj, $a->{NAME}));\n";
} else {
$res .= "\tr.in.$a->{NAME} = $a->{NAME};\n";
# Put r info back into arguments
foreach my $a (@{$fn->{ELEMENTS}}) {
- next unless (util::has_property($a, "out"));
+ next unless (Parse::Pidl::Util::has_property($a, "out"));
- if (typelist::typeIs($a->{TYPE}, "INTERFACE")) {
+ if (Parse::Pidl::Typelist::typeIs($a->{TYPE}, "INTERFACE")) {
$res .="\tNDR_CHECK(dcom_IUnknown_from_OBJREF(d->ctx, &$a->{NAME}, r.out.$a->{NAME}.obj));\n";
} else {
$res .= "\t*$a->{NAME} = r.out.$a->{NAME};\n";
$res .="\tNTSTATUS status = NT_STATUS_OK;\n";
foreach my $interface (@{$idl}) {
next if $interface->{TYPE} ne "INTERFACE";
- next if not util::has_property($interface, "object");
+ next if not Parse::Pidl::Util::has_property($interface, "object");
my $data = $interface->{DATA};
my $count = 0;
foreach my $x (@{$pidl}) {
next if ($x->{TYPE} ne "INTERFACE");
- next if util::has_property($x, "local");
- next unless util::has_property($x, "object");
+ next if Parse::Pidl::Util::has_property($x, "local");
+ next unless Parse::Pidl::Util::has_property($x, "object");
$res .= ParseInterface($x);
}
# Copyright metze@samba.org 2004
# released under the GNU GPL
-package DCOMStub;
+package Parse::Pidl::Samba::COM::Stub;
use strict;
my($data) = $interface->{DATA};
my $name = $interface->{NAME};
my $uname = uc $name;
- my $uuid = util::make_str($interface->{PROPERTIES}->{uuid});
+ my $uuid = Parse::Pidl::Util::make_str($interface->{PROPERTIES}->{uuid});
my $if_version = $interface->{PROPERTIES}->{version};
pidl "
{
my($interface) = shift;
- return "" if util::has_property($interface, "local");
+ return "" if Parse::Pidl::Util::has_property($interface, "local");
my($data) = $interface->{DATA};
my $count = 0;
# Copyright Andrew Tridgell 2005
# released under the GNU GPL
-package EjsClient;
+package Parse::Pidl::Samba::EJS;
use strict;
-use pidl::typelist;
+use Parse::Pidl::Typelist;
my($res);
my %constants;
{
my $fn = shift;
- return "" if (util::has_property($fn, "public"));
+ return "" if (Parse::Pidl::Util::has_property($fn, "public"));
return "static ";
}
{
my ($e, $l, $var, $name, $env) = @_;
- return if (util::has_property($e, "value"));
+ return if (Parse::Pidl::Util::has_property($e, "value"));
$var = get_pointer_to($var);
# have to handle strings specially :(
indent;
pidl "EJS_ALLOC(ejs, $var);";
$var = get_value_of($var);
- EjsPullElement($e, Ndr::GetNextLevel($e, $l), $var, $name, $env);
+ EjsPullElement($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $var, $name, $env);
deindent;
pidl "}";
}
sub EjsPullArray($$$$$)
{
my ($e, $l, $var, $name, $env) = @_;
- my $length = util::ParseExpr($l->{LENGTH_IS}, $env);
- my $pl = Ndr::GetPrevLevel($e, $l);
+ my $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $pl = Parse::Pidl::NDR::GetPrevLevel($e, $l);
if ($pl && $pl->{TYPE} eq "POINTER") {
$var = get_pointer_to($var);
}
pidl "for (i=0;i<$length;i++) {";
indent;
pidl "char *id = talloc_asprintf(ejs, \"%s.%u\", $name, i);";
- EjsPullElement($e, Ndr::GetNextLevel($e, $l), $avar, "id", $env);
+ EjsPullElement($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $avar, "id", $env);
pidl "talloc_free(id);";
deindent;
pidl "}";
sub EjsPullSwitch($$$$$)
{
my ($e, $l, $var, $name, $env) = @_;
- my $switch_var = util::ParseExpr($l->{SWITCH_IS}, $env);
+ my $switch_var = Parse::Pidl::Util::ParseExpr($l->{SWITCH_IS}, $env);
pidl "ejs_set_switch(ejs, $switch_var);";
- EjsPullElement($e, Ndr::GetNextLevel($e, $l), $var, $name, $env);
+ EjsPullElement($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $var, $name, $env);
}
###########################
sub EjsPullElement($$$$$)
{
my ($e, $l, $var, $name, $env) = @_;
- if (util::has_property($e, "charset")) {
+ if (Parse::Pidl::Util::has_property($e, "charset")) {
EjsPullString($e, $l, $var, $name, $env);
} elsif ($l->{TYPE} eq "ARRAY") {
EjsPullArray($e, $l, $var, $name, $env);
my $e = shift;
my $env = shift;
my $l = $e->{LEVELS}[0];
- my $var = util::ParseExpr($e->{NAME}, $env);
+ my $var = Parse::Pidl::Util::ParseExpr($e->{NAME}, $env);
my $name = "\"$e->{NAME}\"";
EjsPullElement($e, $l, $var, $name, $env);
}
my $name = shift;
my $d = shift;
my $type_fn = $d->{BASE_TYPE};
- my($type_decl) = typelist::mapType($d->{BASE_TYPE});
+ my($type_decl) = Parse::Pidl::Typelist::mapType($d->{BASE_TYPE});
pidl fn_prefix($d);
pidl "NTSTATUS ejs_pull_$name(struct ejs_rpc *ejs, struct MprVar *v, const char *name, $type_decl *r)\n{";
indent;
sub EjsTypedefPull($)
{
my $d = shift;
- return if (util::has_property($d, "noejs"));
+ return if (Parse::Pidl::Util::has_property($d, "noejs"));
if ($d->{DATA}->{TYPE} eq 'STRUCT') {
EjsStructPull($d->{NAME}, $d->{DATA});
} elsif ($d->{DATA}->{TYPE} eq 'UNION') {
pidl "} else {";
indent;
$var = get_value_of($var);
- EjsPushElement($e, Ndr::GetNextLevel($e, $l), $var, $name, $env);
+ EjsPushElement($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $var, $name, $env);
deindent;
pidl "}";
}
sub EjsPushSwitch($$$$$)
{
my ($e, $l, $var, $name, $env) = @_;
- my $switch_var = util::ParseExpr($l->{SWITCH_IS}, $env);
+ my $switch_var = Parse::Pidl::Util::ParseExpr($l->{SWITCH_IS}, $env);
pidl "ejs_set_switch(ejs, $switch_var);";
- EjsPushElement($e, Ndr::GetNextLevel($e, $l), $var, $name, $env);
+ EjsPushElement($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $var, $name, $env);
}
sub EjsPushArray($$$$$)
{
my ($e, $l, $var, $name, $env) = @_;
- my $length = util::ParseExpr($l->{LENGTH_IS}, $env);
- my $pl = Ndr::GetPrevLevel($e, $l);
+ my $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $pl = Parse::Pidl::NDR::GetPrevLevel($e, $l);
if ($pl && $pl->{TYPE} eq "POINTER") {
$var = get_pointer_to($var);
}
pidl "for (i=0;i<$length;i++) {";
indent;
pidl "const char *id = talloc_asprintf(ejs, \"%s.%u\", $name, i);";
- EjsPushElement($e, Ndr::GetNextLevel($e, $l), $avar, "id", $env);
+ EjsPushElement($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $avar, "id", $env);
deindent;
pidl "}";
pidl "ejs_push_uint32(ejs, v, $name \".length\", &i);";
sub EjsPushElement($$$$$)
{
my ($e, $l, $var, $name, $env) = @_;
- if (util::has_property($e, "charset")) {
+ if (Parse::Pidl::Util::has_property($e, "charset")) {
EjsPushString($e, $l, $var, $name, $env);
} elsif ($l->{TYPE} eq "ARRAY") {
EjsPushArray($e, $l, $var, $name, $env);
my $e = shift;
my $env = shift;
my $l = $e->{LEVELS}[0];
- my $var = util::ParseExpr($e->{NAME}, $env);
+ my $var = Parse::Pidl::Util::ParseExpr($e->{NAME}, $env);
my $name = "\"$e->{NAME}\"";
EjsPushElement($e, $l, $var, $name, $env);
}
my $name = shift;
my $d = shift;
my $type_fn = $d->{BASE_TYPE};
- my($type_decl) = typelist::mapType($d->{BASE_TYPE});
+ my($type_decl) = Parse::Pidl::Typelist::mapType($d->{BASE_TYPE});
# put the bitmap elements in the constants array
foreach my $e (@{$d->{ELEMENTS}}) {
if ($e =~ /^(\w*)\s*(.*)\s*$/) {
sub EjsTypedefPush($)
{
my $d = shift;
- return if (util::has_property($d, "noejs"));
+ return if (Parse::Pidl::Util::has_property($d, "noejs"));
if ($d->{DATA}->{TYPE} eq 'STRUCT') {
EjsStructPush($d->{NAME}, $d->{DATA});
} elsif ($d->{DATA}->{TYPE} eq 'UNION') {
# Copyright tridge@samba.org 2005
# released under the GNU GPL
-package EjsHeader;
+package Parse::Pidl::Samba::EJSHeader;
use strict;
-use pidl::typelist;
+use Parse::Pidl::Typelist;
my($res);
my $d = shift;
my $name = $d->{NAME};
- return unless util::has_property($d, "public");
+ return unless Parse::Pidl::Util::has_property($d, "public");
- my $type_decl = typelist::mapType($name);
+ my $type_decl = Parse::Pidl::Typelist::mapType($name);
pidl "NTSTATUS ejs_push_$d->{NAME}(struct ejs_rpc *, struct MprVar *, const char *, const $type_decl *);\n";
pidl "NTSTATUS ejs_pull_$d->{NAME}(struct ejs_rpc *, struct MprVar *, const char *, $type_decl *);\n";
# Copyright tridge@samba.org 2003
# released under the GNU GPL
-package NdrClient;
+package Parse::Pidl::Samba::NDR::Client;
use strict;
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
-package NdrHeader;
+package Parse::Pidl::Samba::NDR::Header;
use strict;
-use pidl::typelist;
+use Parse::Pidl::Typelist;
+use Parse::Pidl::Samba::NDR::Parser;
my($res);
my($tab_depth);
foreach my $l (@{$element->{LEVELS}})
{
if (($l->{TYPE} eq "POINTER")) {
- my $nl = Ndr::GetNextLevel($element, $l);
- $nl = Ndr::GetNextLevel($element, $nl) if ($nl->{TYPE} eq "SUBCONTEXT");
- next if ($nl->{TYPE} eq "DATA" and typelist::scalar_is_reference($nl->{DATA_TYPE}));
+ my $nl = Parse::Pidl::NDR::GetNextLevel($element, $l);
+ $nl = Parse::Pidl::NDR::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 = Ndr::GetPrevLevel($element, $l);
+ my $pl = Parse::Pidl::NDR::GetPrevLevel($element, $l);
next if ($pl and $pl->{TYPE} eq "POINTER");
if ($l->{IS_FIXED}) {
}
}
- if (defined $element->{ARRAY_LEN}[0] && util::is_constant($element->{ARRAY_LEN}[0])) {
+ if (defined $element->{ARRAY_LEN}[0] && Parse::Pidl::Util::is_constant($element->{ARRAY_LEN}[0])) {
pidl "[$element->{ARRAY_LEN}[0]]";
}
pidl ";";
my($enum,$name) = @_;
my $first = 1;
- if (not util::useUintEnums()) {
+ if (not Parse::Pidl::Util::useUintEnums()) {
pidl "\nenum $name {\n";
$tab_depth++;
foreach my $e (@{$enum->{ELEMENTS}}) {
return;
}
- if (util::has_property($e, "charset")) {
+ if (Parse::Pidl::Util::has_property($e, "charset")) {
pidl "const char";
} else {
- pidl typelist::mapType($e->{TYPE});
+ pidl Parse::Pidl::Typelist::mapType($e->{TYPE});
}
}
{
my($d) = shift;
- my $tf = NdrParser::get_typefamily($d->{DATA}{TYPE});
+ my $tf = Parse::Pidl::Samba::NDR::Parser::get_typefamily($d->{DATA}{TYPE});
- if (util::has_property($d, "gensize")) {
+ if (Parse::Pidl::Util::has_property($d, "gensize")) {
my $size_args = $tf->{SIZE_FN_ARGS}->($d);
pidl "size_t ndr_size_$d->{NAME}($size_args);\n";
}
- return unless util::has_property($d, "public");
+ return unless Parse::Pidl::Util::has_property($d, "public");
my $pull_args = $tf->{PULL_FN_ARGS}->($d);
my $push_args = $tf->{PUSH_FN_ARGS}->($d);
my $print_args = $tf->{PRINT_FN_ARGS}->($d);
- unless (util::has_property($d, "nopush")) {
+ unless (Parse::Pidl::Util::has_property($d, "nopush")) {
pidl "NTSTATUS ndr_push_$d->{NAME}($push_args);\n";
}
- unless (util::has_property($d, "nopull")) {
+ unless (Parse::Pidl::Util::has_property($d, "nopull")) {
pidl "NTSTATUS ndr_pull_$d->{NAME}($pull_args);\n";
}
- unless (util::has_property($d, "noprint")) {
+ unless (Parse::Pidl::Util::has_property($d, "noprint")) {
pidl "void ndr_print_$d->{NAME}($print_args);\n";
}
}
my($fn,$prop) = @_;
foreach my $e (@{$fn->{ELEMENTS}}) {
- if (util::has_property($e, $prop)) {
+ if (Parse::Pidl::Util::has_property($e, $prop)) {
HeaderElement($e);
}
}
}
foreach my $e (@{$fn->{ELEMENTS}}) {
- if (util::has_property($e, $prop)) {
+ if (Parse::Pidl::Util::has_property($e, $prop)) {
return 1;
}
}
HeaderFunctionInOut($fn, "out");
if ($fn->{RETURN_TYPE}) {
tabs();
- pidl typelist::mapType($fn->{RETURN_TYPE}) . " result;\n";
+ pidl Parse::Pidl::Typelist::mapType($fn->{RETURN_TYPE}) . " result;\n";
}
$tab_depth--;
tabs();
pidl "struct rpc_request *dcerpc_$name\_send(struct dcerpc_pipe *p, TALLOC_CTX *mem_ctx, struct $name *r);\n";
}
- return unless util::has_property($fn, "public");
+ return unless Parse::Pidl::Util::has_property($fn, "public");
pidl "NTSTATUS ndr_push_$name(struct ndr_push *ndr, int flags, const struct $name *r);\n";
pidl "NTSTATUS ndr_pull_$name(struct ndr_pull *ndr, int flags, struct $name *r);\n";
if (defined $interface->{PROPERTIES}->{uuid}) {
my $name = uc $interface->{NAME};
pidl "#define DCERPC_$name\_UUID " .
- util::make_str($interface->{PROPERTIES}->{uuid}) . "\n";
+ Parse::Pidl::Util::make_str($interface->{PROPERTIES}->{uuid}) . "\n";
if(!defined $interface->{PROPERTIES}->{version}) { $interface->{PROPERTIES}->{version} = "0.0"; }
pidl "#define DCERPC_$name\_VERSION $interface->{PROPERTIES}->{version}\n";
# Copyright jelmer@samba.org 2004-2005
# released under the GNU GPL
-package NdrParser;
+package Parse::Pidl::Samba::NDR::Parser;
use strict;
-use pidl::typelist;
-use pidl::ndr;
+use Parse::Pidl::Typelist;
+use Parse::Pidl::NDR;
# list of known types
my %typefamily;
return get_value_of($var_name);
}
} elsif ($l->{TYPE} eq "DATA") {
- if (typelist::scalar_is_reference($l->{DATA_TYPE})) {
+ if (Parse::Pidl::Typelist::scalar_is_reference($l->{DATA_TYPE})) {
return get_value_of($var_name) unless ($pointers);
}
}
return 0 if ($l->{TYPE} ne "ARRAY");
- my $nl = Ndr::GetNextLevel($e,$l);
+ my $nl = Parse::Pidl::NDR::GetNextLevel($e,$l);
return (($nl->{TYPE} eq "DATA") and
- (typelist::is_scalar($nl->{DATA_TYPE})));
+ (Parse::Pidl::Typelist::is_scalar($nl->{DATA_TYPE})));
}
sub get_pointer_to($)
{
my $fn = shift;
- return "" if (util::has_property($fn, "public"));
+ return "" if (Parse::Pidl::Util::has_property($fn, "public"));
return "static ";
}
sub start_flags($)
{
my $e = shift;
- my $flags = util::has_property($e, "flag");
+ my $flags = Parse::Pidl::Util::has_property($e, "flag");
if (defined $flags) {
pidl "{";
indent;
sub end_flags($)
{
my $e = shift;
- my $flags = util::has_property($e, "flag");
+ my $flags = Parse::Pidl::Util::has_property($e, "flag");
if (defined $flags) {
pidl "ndr->flags = _flags_save_$e->{TYPE};";
deindent;
if ($l->{IS_ZERO_TERMINATED}) {
$size = $length = "ndr_string_length($var_name, sizeof(*$var_name))";
} else {
- $size = util::ParseExpr($l->{SIZE_IS}, $env);
- $length = util::ParseExpr($l->{LENGTH_IS}, $env);
+ $size = Parse::Pidl::Util::ParseExpr($l->{SIZE_IS}, $env);
+ $length = Parse::Pidl::Util::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 = util::ParseExpr($l->{SIZE_IS}, $env);
+ $length = $size = Parse::Pidl::Util::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 = util::ParseExpr($l->{SIZE_IS}, $env);
+ my $size = Parse::Pidl::Util::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 = util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $length = Parse::Pidl::Util::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 util::ParseExpr($clen, $env);
+ return Parse::Pidl::Util::ParseExpr($clen, $env);
}
sub compression_dlen($$$)
my $compression = $l->{COMPRESSION};
my ($alg, $clen, $dlen) = split(/ /, $compression);
- return util::ParseExpr($dlen, $env);
+ return Parse::Pidl::Util::ParseExpr($dlen, $env);
}
sub ParseCompressionPushStart($$$)
sub ParseObfuscationPushEnd($$)
{
my ($e,$ndr) = @_;
- my $obfuscation = util::has_property($e, "obfuscation");
+ my $obfuscation = Parse::Pidl::Util::has_property($e, "obfuscation");
pidl "NDR_CHECK(ndr_push_obfuscation($ndr, $obfuscation));";
}
sub ParseObfuscationPullStart($$)
{
my ($e,$ndr) = @_;
- my $obfuscation = util::has_property($e, "obfuscation");
+ my $obfuscation = Parse::Pidl::Util::has_property($e, "obfuscation");
pidl "NDR_CHECK(ndr_pull_obfuscation($ndr, $obfuscation));";
{
my ($e,$l,$ndr_flags,$env) = @_;
my $ndr = "_ndr_$e->{NAME}";
- my $subcontext_size = util::ParseExpr($l->{SUBCONTEXT_SIZE},$env);
+ my $subcontext_size = Parse::Pidl::Util::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 = util::ParseExpr($l->{SUBCONTEXT_SIZE},$env);
+ my $subcontext_size = Parse::Pidl::Util::ParseExpr($l->{SUBCONTEXT_SIZE},$env);
pidl "{";
indent;
my $advance;
if (defined($l->{SUBCONTEXT_SIZE}) and ($l->{SUBCONTEXT_SIZE} ne "-1")) {
- $advance = util::ParseExpr($l->{SUBCONTEXT_SIZE},$env);
+ $advance = Parse::Pidl::Util::ParseExpr($l->{SUBCONTEXT_SIZE},$env);
} elsif ($l->{HEADER_SIZE}) {
$advance = "$ndr->data_size";
} else {
if (defined($ndr_flags)) {
if ($l->{TYPE} eq "SUBCONTEXT") {
$ndr = ParseSubcontextPushStart($e, $l, $ndr, $var_name, $ndr_flags);
- ParseElementPushLevel($e, Ndr::GetNextLevel($e, $l), $ndr, $var_name, $env, 1, 1);
+ ParseElementPushLevel($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $ndr, $var_name, $env, 1, 1);
ParseSubcontextPushEnd($e, $l, $ndr_flags, $env);
} elsif ($l->{TYPE} eq "POINTER") {
ParsePtrPush($e, $l, $var_name);
$var_name = get_pointer_to($var_name);
}
- my $nl = Ndr::GetNextLevel($e, $l);
+ my $nl = Parse::Pidl::NDR::GetNextLevel($e, $l);
- if (util::has_property($e, "charset")) {
- pidl "NDR_CHECK(ndr_push_charset($ndr, $ndr_flags, $var_name, $length, sizeof(" . typelist::mapType($nl->{DATA_TYPE}) . "), CH_$e->{PROPERTIES}->{charset}));";
+ if (Parse::Pidl::Util::has_property($e, "charset")) {
+ pidl "NDR_CHECK(ndr_push_charset($ndr, $ndr_flags, $var_name, $length, sizeof(" . Parse::Pidl::Typelist::mapType($nl->{DATA_TYPE}) . "), CH_$e->{PROPERTIES}->{charset}));";
} else {
pidl "NDR_CHECK(ndr_push_array_$nl->{DATA_TYPE}($ndr, $ndr_flags, $var_name, $length));";
}
}
}
$var_name = get_value_of($var_name);
- ParseElementPushLevel($e, Ndr::GetNextLevel($e, $l), $ndr, $var_name, $env, $primitives, $deferred);
+ ParseElementPushLevel($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $ndr, $var_name, $env, $primitives, $deferred);
if ($l->{POINTER_TYPE} ne "ref") {
deindent;
pidl "}";
}
} elsif ($l->{TYPE} eq "ARRAY" and not is_scalar_array($e,$l)) {
- my $length = util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
my $counter = "cntr_$e->{NAME}_$l->{LEVEL_INDEX}";
$var_name = $var_name . "[$counter]";
if (($primitives and not $l->{IS_DEFERRED}) or ($deferred and $l->{IS_DEFERRED})) {
pidl "for ($counter = 0; $counter < $length; $counter++) {";
indent;
- ParseElementPushLevel($e, Ndr::GetNextLevel($e, $l), $ndr, $var_name, $env, 1, 0);
+ ParseElementPushLevel($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $ndr, $var_name, $env, 1, 0);
deindent;
pidl "}";
}
- if ($deferred and Ndr::ContainsDeferred($e, $l)) {
+ if ($deferred and Parse::Pidl::NDR::ContainsDeferred($e, $l)) {
pidl "for ($counter = 0; $counter < $length; $counter++) {";
indent;
- ParseElementPushLevel($e, Ndr::GetNextLevel($e, $l), $ndr, $var_name, $env, 0, 1);
+ ParseElementPushLevel($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $ndr, $var_name, $env, 0, 1);
deindent;
pidl "}";
}
} elsif ($l->{TYPE} eq "SWITCH") {
- ParseElementPushLevel($e, Ndr::GetNextLevel($e, $l), $ndr, $var_name, $env, $primitives, $deferred);
+ ParseElementPushLevel($e, Parse::Pidl::NDR::GetNextLevel($e, $l), $ndr, $var_name, $env, $primitives, $deferred);
}
}
$var_name = append_prefix($e, $var_name);
- return unless $primitives or ($deferred and Ndr::ContainsDeferred($e, $e->{LEVELS}[0]));
+ return unless $primitives or ($deferred and Parse::Pidl::NDR::ContainsDeferred($e, $e->{LEVELS}[0]));
start_flags($e);
- if (my $value = util::has_property($e, "value")) {
- $var_name = util::ParseExpr($value, $env);
+ if (my $value = Parse::Pidl::Util::has_property($e, "value")) {
+ $var_name = Parse::Pidl::Util::ParseExpr($value, $env);
}
ParseElementPushLevel($e, $e->{LEVELS}[0], $ndr, $var_name, $env, $primitives, $deferred);
my($e,$var_name,$env) = @_;
$var_name = append_prefix($e, $var_name);
- return if (util::has_property($e, "noprint"));
+ return if (Parse::Pidl::Util::has_property($e, "noprint"));
- if (my $value = util::has_property($e, "value")) {
- $var_name = "(ndr->flags & LIBNDR_PRINT_SET_VALUES)?" . util::ParseExpr($value,$env) . ":$var_name";
+ if (my $value = Parse::Pidl::Util::has_property($e, "value")) {
+ $var_name = "(ndr->flags & LIBNDR_PRINT_SET_VALUES)?" . Parse::Pidl::Util::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 = util::ParseExpr($l->{LENGTH_IS}, $env);
+ $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
}
if (is_scalar_array($e, $l)) {
- if (util::has_property($e, "charset")) {
+ if (Parse::Pidl::Util::has_property($e, "charset")) {
pidl "ndr_print_string(ndr, \"$e->{NAME}\", $var_name);";
} else {
- my $nl = Ndr::GetNextLevel($e, $l);
+ my $nl = Parse::Pidl::NDR::GetNextLevel($e, $l);
pidl "ndr_print_array_$nl->{DATA_TYPE}(ndr, \"$e->{NAME}\", $var_name, $length);";
}
last;
if ($l->{IS_VARYING} or $l->{IS_CONFORMANT}){ $var_name = get_pointer_to($var_name); }
} elsif ($l->{TYPE} eq "DATA") {
- if (not typelist::is_scalar($l->{DATA_TYPE}) or typelist::scalar_is_reference($l->{DATA_TYPE})) {
+ if (not Parse::Pidl::Typelist::is_scalar($l->{DATA_TYPE}) or Parse::Pidl::Typelist::scalar_is_reference($l->{DATA_TYPE})) {
$var_name = get_pointer_to($var_name);
}
pidl "ndr_print_$l->{DATA_TYPE}(ndr, \"$e->{NAME}\", $var_name);";
} elsif ($l->{TYPE} eq "SWITCH") {
- my $switch_var = util::ParseExpr($l->{SWITCH_IS}, $env);
+ my $switch_var = Parse::Pidl::Util::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 = util::ParseExpr($l->{SWITCH_IS}, $env);
+ my $switch_var = Parse::Pidl::Util::ParseExpr($l->{SWITCH_IS}, $env);
check_null_pointer($switch_var);
sub ParseSwitchPush($$$$$$)
{
my($e,$l,$ndr,$var_name,$ndr_flags,$env) = @_;
- my $switch_var = util::ParseExpr($l->{SWITCH_IS}, $env);
+ my $switch_var = Parse::Pidl::Util::ParseExpr($l->{SWITCH_IS}, $env);
check_null_pointer($switch_var);
$var_name = get_pointer_to($var_name);
{
my ($e,$l,$ndr,$var_name,$ndr_flags) = @_;
- if (typelist::scalar_is_reference($l->{DATA_TYPE})) {
+ if (Parse::Pidl::Typelist::scalar_is_reference($l->{DATA_TYPE})) {
$var_name = get_pointer_to($var_name);
}
pidl "NDR_CHECK(ndr_pull_$l->{DATA_TYPE}($ndr, $ndr_flags, $var_name));";
- if (my $range = util::has_property($e, "range")) {
+ if (my $range = Parse::Pidl::Util::has_property($e, "range")) {
$var_name = get_value_of($var_name);
my ($low, $high) = split(/ /, $range, 2);
pidl "if ($var_name < $low || $var_name > $high) {";
my ($e,$l,$ndr,$var_name,$ndr_flags) = @_;
# strings are passed by value rather then reference
- if (not typelist::is_scalar($l->{DATA_TYPE}) or typelist::scalar_is_reference($l->{DATA_TYPE})) {
+ if (not Parse::Pidl::Typelist::is_scalar($l->{DATA_TYPE}) or Parse::Pidl::Typelist::scalar_is_reference($l->{DATA_TYPE})) {
$var_name = get_pointer_to($var_name);
}
if (defined($ndr_flags)) {
if ($l->{TYPE} eq "SUBCONTEXT") {
($ndr,$var_name) = ParseSubcontextPullStart($e, $l, $ndr, $var_name, $ndr_flags, $env);
- ParseElementPullLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, 1, 1);
+ ParseElementPullLevel($e,Parse::Pidl::NDR::GetNextLevel($e,$l), $ndr, $var_name, $env, 1, 1);
ParseSubcontextPullEnd($e, $l, $env);
} elsif ($l->{TYPE} eq "ARRAY") {
my $length = ParseArrayPullHeader($e, $l, $ndr, $var_name, $env);
if ($l->{IS_VARYING} or $l->{IS_CONFORMANT}) {
$var_name = get_pointer_to($var_name);
}
- my $nl = Ndr::GetNextLevel($e, $l);
+ my $nl = Parse::Pidl::NDR::GetNextLevel($e, $l);
- if (util::has_property($e, "charset")) {
- pidl "NDR_CHECK(ndr_pull_charset($ndr, $ndr_flags, ".get_pointer_to($var_name).", $length, sizeof(" . typelist::mapType($nl->{DATA_TYPE}) . "), CH_$e->{PROPERTIES}->{charset}));";
+ if (Parse::Pidl::Util::has_property($e, "charset")) {
+ pidl "NDR_CHECK(ndr_pull_charset($ndr, $ndr_flags, ".get_pointer_to($var_name).", $length, sizeof(" . Parse::Pidl::Typelist::mapType($nl->{DATA_TYPE}) . "), CH_$e->{PROPERTIES}->{charset}));";
} else {
pidl "NDR_CHECK(ndr_pull_array_$nl->{DATA_TYPE}($ndr, $ndr_flags, $var_name, $length));";
if ($l->{IS_ZERO_TERMINATED}) {
}
$var_name = get_value_of($var_name);
- ParseElementPullLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, $primitives, $deferred);
+ ParseElementPullLevel($e,Parse::Pidl::NDR::GetNextLevel($e,$l), $ndr, $var_name, $env, $primitives, $deferred);
if ($l->{POINTER_TYPE} ne "ref") {
if ($l->{POINTER_TYPE} eq "relative") {
pidl "}";
}
} elsif ($l->{TYPE} eq "ARRAY" and not is_scalar_array($e,$l)) {
- my $length = util::ParseExpr($l->{LENGTH_IS}, $env);
+ my $length = Parse::Pidl::Util::ParseExpr($l->{LENGTH_IS}, $env);
my $counter = "cntr_$e->{NAME}_$l->{LEVEL_INDEX}";
$var_name = $var_name . "[$counter]";
if (($primitives and not $l->{IS_DEFERRED}) or ($deferred and $l->{IS_DEFERRED})) {
pidl "for ($counter = 0; $counter < $length; $counter++) {";
indent;
- ParseElementPullLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, 1, 0);
+ ParseElementPullLevel($e,Parse::Pidl::NDR::GetNextLevel($e,$l), $ndr, $var_name, $env, 1, 0);
deindent;
pidl "}";
}
}
- if ($deferred and Ndr::ContainsDeferred($e, $l)) {
+ if ($deferred and Parse::Pidl::NDR::ContainsDeferred($e, $l)) {
pidl "for ($counter = 0; $counter < $length; $counter++) {";
indent;
- ParseElementPullLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, 0, 1);
+ ParseElementPullLevel($e,Parse::Pidl::NDR::GetNextLevel($e,$l), $ndr, $var_name, $env, 0, 1);
deindent;
pidl "}";
}
} elsif ($l->{TYPE} eq "SWITCH") {
- ParseElementPullLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, $primitives, $deferred);
+ ParseElementPullLevel($e,Parse::Pidl::NDR::GetNextLevel($e,$l), $ndr, $var_name, $env, $primitives, $deferred);
}
}
$var_name = append_prefix($e, $var_name);
- return unless $primitives or ($deferred and Ndr::ContainsDeferred($e, $e->{LEVELS}[0]));
+ return unless $primitives or ($deferred and Parse::Pidl::NDR::ContainsDeferred($e, $e->{LEVELS}[0]));
start_flags($e);
{
my($e,$l,$ndr,$var_name) = @_;
- my $nl = Ndr::GetNextLevel($e, $l);
+ my $nl = Parse::Pidl::NDR::GetNextLevel($e, $l);
my $next_is_array = ($nl->{TYPE} eq "ARRAY");
my $next_is_string = (($nl->{TYPE} eq "DATA") and
($nl->{DATA_TYPE} eq "string"));
if (defined($e->{LEVELS}[0]) and
$e->{LEVELS}[0]->{TYPE} eq "ARRAY") {
- my $size = util::ParseExpr($e->{LEVELS}[0]->{SIZE_IS}, $env);
+ my $size = Parse::Pidl::Util::ParseExpr($e->{LEVELS}[0]->{SIZE_IS}, $env);
pidl "NDR_CHECK(ndr_push_uint32(ndr, NDR_SCALARS, $size));";
} else {
{
my($enum,$name) = @_;
my($type_fn) = $enum->{BASE_TYPE};
- my($type_v_decl) = typelist::mapType($type_fn);
+ my($type_v_decl) = Parse::Pidl::Typelist::mapType($type_fn);
pidl "$type_v_decl v;";
start_flags($enum);
{
my($bitmap,$name) = @_;
my $type_fn = $bitmap->{BASE_TYPE};
- my($type_decl) = typelist::mapType($bitmap->{BASE_TYPE});
+ my($type_decl) = Parse::Pidl::Typelist::mapType($bitmap->{BASE_TYPE});
pidl "$type_decl v;";
start_flags($bitmap);
sub ParseBitmapPrintElement($$$)
{
my($e,$bitmap,$name) = @_;
- my($type_decl) = typelist::mapType($bitmap->{BASE_TYPE});
+ my($type_decl) = Parse::Pidl::Typelist::mapType($bitmap->{BASE_TYPE});
my($type_fn) = $bitmap->{BASE_TYPE};
my($flag);
sub ParseBitmapPrint($$)
{
my($bitmap,$name) = @_;
- my($type_decl) = typelist::mapType($bitmap->{TYPE});
+ my($type_decl) = Parse::Pidl::Typelist::mapType($bitmap->{TYPE});
my($type_fn) = $bitmap->{BASE_TYPE};
start_flags($bitmap);
sub ArgsBitmapPush($)
{
my $e = shift;
- my $type_decl = typelist::mapType($e->{DATA}->{BASE_TYPE});
+ my $type_decl = Parse::Pidl::Typelist::mapType($e->{DATA}->{BASE_TYPE});
return "struct ndr_push *ndr, int ndr_flags, $type_decl r";
}
sub ArgsBitmapPrint($)
{
my $e = shift;
- my $type_decl = typelist::mapType($e->{DATA}->{BASE_TYPE});
+ my $type_decl = Parse::Pidl::Typelist::mapType($e->{DATA}->{BASE_TYPE});
return "struct ndr_print *ndr, const char *name, $type_decl r";
}
sub ArgsBitmapPull($)
{
my $e = shift;
- my $type_decl = typelist::mapType($e->{DATA}->{BASE_TYPE});
+ my $type_decl = Parse::Pidl::Typelist::mapType($e->{DATA}->{BASE_TYPE});
return "struct ndr_pull *ndr, int ndr_flags, $type_decl *r";
}
my $t = shift;
my $sizevar;
- if (my $flags = util::has_property($t, "flag")) {
+ if (my $flags = Parse::Pidl::Util::has_property($t, "flag")) {
pidl "flags |= $flags;";
}
pidl "return ndr_size_struct(r, flags, (ndr_push_flags_fn_t)ndr_push_$t->{NAME});";
my $t = shift;
my $sizevar;
- if (my $flags = util::has_property($t, "flag")) {
+ if (my $flags = Parse::Pidl::Util::has_property($t, "flag")) {
pidl "flags |= $flags;";
}
pidl "uint32_t _save_relative_base_offset = ndr_pull_get_relative_base_offset(ndr);" if defined($e->{PROPERTIES}{relative_base});
pidl "int level;";
if (defined($switch_type)) {
- if (typelist::typeIs($switch_type, "ENUM")) {
- $switch_type = typelist::enum_type_fn(typelist::getType($switch_type));
+ if (Parse::Pidl::Typelist::typeIs($switch_type, "ENUM")) {
+ $switch_type = Parse::Pidl::Typelist::enum_type_fn(Parse::Pidl::Typelist::getType($switch_type));
}
- pidl typelist::mapType($switch_type) . " _level;";
+ pidl Parse::Pidl::Typelist::mapType($switch_type) . " _level;";
}
start_flags($e);
{
my($fn) = shift;
- return if util::has_property($fn, "noprint");
+ return if Parse::Pidl::Util::has_property($fn, "noprint");
pidl "void ndr_print_$fn->{NAME}(struct ndr_print *ndr, const char *name, int flags, const struct $fn->{NAME} *r)";
pidl "{";
{
my($fn) = shift;
- return if util::has_property($fn, "nopush");
+ return if Parse::Pidl::Util::has_property($fn, "nopush");
pidl fn_prefix($fn) . "NTSTATUS ndr_push_$fn->{NAME}(struct ndr_push *ndr, int flags, const struct $fn->{NAME} *r)";
pidl "{";
{
my ($e,$l,$ndr,$env,$size) = @_;
- return if (util::has_property($e, "charset"));
+ return if (Parse::Pidl::Util::has_property($e, "charset"));
- my $var = util::ParseExpr($e->{NAME}, $env);
+ my $var = Parse::Pidl::Util::ParseExpr($e->{NAME}, $env);
check_null_pointer($size);
- my $pl = Ndr::GetPrevLevel($e, $l);
+ my $pl = Parse::Pidl::NDR::GetPrevLevel($e, $l);
if (defined($pl) and
$pl->{TYPE} eq "POINTER" and
$pl->{POINTER_TYPE} eq "ref"
{
my($fn) = shift;
- return if util::has_property($fn, "nopull");
+ return if Parse::Pidl::Util::has_property($fn, "nopull");
# pull function args
pidl fn_prefix($fn) . "NTSTATUS ndr_pull_$fn->{NAME}(struct ndr_pull *ndr, int flags, struct $fn->{NAME} *r)";
and $e->{LEVELS}[1]->{IS_ZERO_TERMINATED});
if ($e->{LEVELS}[1]->{TYPE} eq "ARRAY") {
- my $size = util::ParseExpr($e->{LEVELS}[1]->{SIZE_IS}, $env);
+ my $size = Parse::Pidl::Util::ParseExpr($e->{LEVELS}[1]->{SIZE_IS}, $env);
check_null_pointer($size);
pidl "NDR_ALLOC_N(ndr, r->out.$e->{NAME}, $size);";
sub NeededTypedef($$)
{
my ($t,$needed) = @_;
- if (util::has_property($t, "public")) {
- $needed->{"pull_$t->{NAME}"} = not util::has_property($t, "nopull");
- $needed->{"push_$t->{NAME}"} = not util::has_property($t, "nopush");
- $needed->{"print_$t->{NAME}"} = not util::has_property($t, "noprint");
+ if (Parse::Pidl::Util::has_property($t, "public")) {
+ $needed->{"pull_$t->{NAME}"} = not Parse::Pidl::Util::has_property($t, "nopull");
+ $needed->{"push_$t->{NAME}"} = not Parse::Pidl::Util::has_property($t, "nopush");
+ $needed->{"print_$t->{NAME}"} = not Parse::Pidl::Util::has_property($t, "noprint");
}
if ($t->{DATA}->{TYPE} eq "STRUCT" or $t->{DATA}->{TYPE} eq "UNION") {
- if (util::has_property($t, "gensize")) {
+ if (Parse::Pidl::Util::has_property($t, "gensize")) {
$needed->{"ndr_size_$t->{NAME}"} = 1;
}
# Copyright metze@samba.org 2004
# released under the GNU GPL
-package NdrServer;
+package Parse::Pidl::Samba::NDR::Server;
use strict;
my($interface) = shift;
my $name = $interface->{NAME};
my $uname = uc $name;
- my $uuid = util::make_str($interface->{PROPERTIES}->{uuid});
+ my $uuid = Parse::Pidl::Util::make_str($interface->{PROPERTIES}->{uuid});
my $if_version = $interface->{PROPERTIES}->{version};
pidl "
# Copyright tpot@samba.org 2004,2005
# released under the GNU GPL
-package IdlSwig;
+package Parse::Pidl::Samba::SWIG;
use strict;
# Copyright tridge@samba.org 2003
# released under the GNU GPL
-package IdlTemplate;
+package Parse::Pidl::Samba::Template;
use strict;
# (C) 2005 Jelmer Vernooij <jelmer@samba.org>
# Published under the GNU General Public License
-package Test;
+package Parse::Pidl::Test;
use strict;
use pidl::util;
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
-package typelist;
+package Parse::Pidl::Typelist;
+use Parse::Pidl::Util;
use strict;
my %typedefs = ();
sub enum_type_fn($)
{
my $enum = shift;
- if (util::has_property($enum->{PARENT}, "enum8bit")) {
+ if (Parse::Pidl::Util::has_property($enum->{PARENT}, "enum8bit")) {
return "uint8";
- } elsif (util::has_property($enum->{PARENT}, "v1_enum")) {
+ } elsif (Parse::Pidl::Util::has_property($enum->{PARENT}, "v1_enum")) {
return "uint32";
}
return "uint16";
{
my $bitmap = shift;
- if (util::has_property($bitmap, "bitmap8bit")) {
+ if (Parse::Pidl::Util::has_property($bitmap, "bitmap8bit")) {
return "uint8";
- } elsif (util::has_property($bitmap, "bitmap16bit")) {
+ } elsif (Parse::Pidl::Util::has_property($bitmap, "bitmap16bit")) {
return "uint16";
- } elsif (util::has_property($bitmap, "bitmap64bit")) {
+ } elsif (Parse::Pidl::Util::has_property($bitmap, "bitmap64bit")) {
return "hyper";
}
return "uint32";
NAME => $x->{NAME},
TYPE => "TYPEDEF",
DATA => $x
- }) if (util::has_property($x, "object"));
+ }) if (Parse::Pidl::Util::has_property($x, "object"));
foreach my $y (@{$x->{DATA}}) {
addType($y) if (
# utility functions to support pidl
# Copyright tridge@samba.org 2000
# released under the GNU GPL
-package util;
-
-#####################################################################
-# load a data structure from a file (as saved with SaveStructure)
-sub LoadStructure($)
-{
- my $f = shift;
- my $contents = FileLoad($f);
- defined $contents || return undef;
- return eval "$contents";
-}
+package Parse::Pidl::Util;
use strict;
return Data::Dumper::Dumper($s);
}
-#####################################################################
-# save a data structure into a file
-sub SaveStructure($$)
-{
- my($filename) = shift;
- my($v) = shift;
- FileSave($filename, MyDumper($v));
-}
-
#####################################################################
# see if a pidl property list contains a given property
sub has_property($$)
# Copyright tridge@samba.org 2003
# released under the GNU GPL
-package IdlValidator;
+package Parse::Pidl::Validator;
use strict;
sub mapToScalar($)
{
my $t = shift;
- my $ti = typelist::getType($t);
+ my $ti = Parse::Pidl::Typelist::getType($t);
if (not defined ($ti)) {
return undef;
} elsif ($ti->{DATA}->{TYPE} eq "ENUM") {
- return typelist::enum_type_fn($ti->{DATA});
+ return Parse::Pidl::Typelist::enum_type_fn($ti->{DATA});
} elsif ($ti->{DATA}->{TYPE} eq "BITMAP") {
- return typelist::enum_type_fn($ti->{DATA});
+ return Parse::Pidl::Typelist::enum_type_fn($ti->{DATA});
} elsif ($ti->{DATA}->{TYPE} eq "SCALAR") {
return $t;
}
ValidProperties($e,"ELEMENT");
- if (util::has_property($e, "ptr")) {
+ if (Parse::Pidl::Util::has_property($e, "ptr")) {
fatal($e, el_name($e) . " : pidl does not support full NDR pointers yet\n");
}
# Check whether switches are used correctly.
- if (my $switch = util::has_property($e, "switch_is")) {
+ if (my $switch = Parse::Pidl::Util::has_property($e, "switch_is")) {
my $e2 = find_sibling($e, $switch);
- my $type = typelist::getType($e->{TYPE});
+ my $type = Parse::Pidl::Typelist::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}");
}
- if (!util::has_property($type, "nodiscriminant") and defined($e2)) {
- my $discriminator_type = util::has_property($type, "switch_type");
+ if (!Parse::Pidl::Util::has_property($type, "nodiscriminant") and defined($e2)) {
+ my $discriminator_type = Parse::Pidl::Util::has_property($type, "switch_type");
$discriminator_type = "uint32" unless defined ($discriminator_type);
my $t1 = mapToScalar($discriminator_type);
}
}
- if (defined (util::has_property($e, "subcontext_size")) and not defined(util::has_property($e, "subcontext"))) {
+ if (defined (Parse::Pidl::Util::has_property($e, "subcontext_size")) and not defined(Parse::Pidl::Util::has_property($e, "subcontext"))) {
fatal($e, el_name($e) . " : subcontext_size() on non-subcontext element");
}
- if (defined (util::has_property($e, "compression")) and not defined(util::has_property($e, "subcontext"))) {
+ if (defined (Parse::Pidl::Util::has_property($e, "compression")) and not defined(Parse::Pidl::Util::has_property($e, "subcontext"))) {
fatal($e, el_name($e) . " : compression() on non-subcontext element");
}
- if (defined (util::has_property($e, "obfuscation")) and not defined(util::has_property($e, "subcontext"))) {
+ if (defined (Parse::Pidl::Util::has_property($e, "obfuscation")) and not defined(Parse::Pidl::Util::has_property($e, "subcontext"))) {
fatal($e, el_name($e) . " : obfuscation() on non-subcontext element");
}
if (!$e->{POINTERS} && (
- util::has_property($e, "ptr") or
- util::has_property($e, "sptr") or
- util::has_property($e, "unique") or
- util::has_property($e, "relative") or
- util::has_property($e, "ref"))) {
+ Parse::Pidl::Util::has_property($e, "ptr") or
+ Parse::Pidl::Util::has_property($e, "sptr") or
+ Parse::Pidl::Util::has_property($e, "unique") or
+ Parse::Pidl::Util::has_property($e, "relative") or
+ Parse::Pidl::Util::has_property($e, "ref"))) {
fatal($e, el_name($e) . " : pointer properties on non-pointer element\n");
}
}
ValidProperties($union,"UNION");
- if (util::has_property($union->{PARENT}, "nodiscriminant") and util::has_property($union->{PARENT}, "switch_type")) {
+ if (Parse::Pidl::Util::has_property($union->{PARENT}, "nodiscriminant") and Parse::Pidl::Util::has_property($union->{PARENT}, "switch_type")) {
fatal($union->{PARENT}, $union->{PARENT}->{NAME} . ": switch_type() on union without discriminant");
}
fatal $e, "Union member $e->{NAME} must have default or case property\n";
}
- if (util::has_property($e, "ref")) {
+ if (Parse::Pidl::Util::has_property($e, "ref")) {
fatal($e, el_name($e) . " : embedded ref pointers are not supported yet\n");
}
foreach my $e (@{$fn->{ELEMENTS}}) {
$e->{PARENT} = $fn;
- if (util::has_property($e, "ref") && !$e->{POINTERS}) {
+ if (Parse::Pidl::Util::has_property($e, "ref") && !$e->{POINTERS}) {
fatal $e, "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})\n";
}
ValidElement($e);
ValidProperties($interface,"INTERFACE");
- if (util::has_property($interface, "pointer_default") &&
+ if (Parse::Pidl::Util::has_property($interface, "pointer_default") &&
$interface->{PROPERTIES}->{pointer_default} eq "ptr") {
fatal $interface, "Full pointers are not supported yet\n";
}
- if (util::has_property($interface, "object")) {
- if (util::has_property($interface, "version") &&
+ if (Parse::Pidl::Util::has_property($interface, "object")) {
+ if (Parse::Pidl::Util::has_property($interface, "version") &&
$interface->{PROPERTIES}->{version} != 0) {
fatal $interface, "Object interfaces must have version 0.0 ($interface->{NAME})\n";
}
+++ /dev/null
-{
- use util;
-}
-
-idl: idl_interface(s)
- {{ util::FlattenArray($item[1]) }}
- | <error>
-
-idl_interface: module_header interface
- { [$item{module_header}, $item{interface}] }
- | <error>
-
-module_header: '[' <commit> module_param(s? /,/) ']'
- {{
- "TYPE" => "MODULEHEADER",
- "PROPERTIES" => util::FlattenHash($item[3])
- }}
- | <error?>
-
-module_param: identifier '(' <commit> text ')'
- {{ "$item{identifier}" => "$item{text}" }}
- | <error>
-
-interface: 'interface' <commit> identifier '{' definition(s?) '}'
- {{
- "TYPE" => "INTERFACE",
- "NAME" => $item{identifier},
- "DATA" => $item[5]
- }}
- | <error?>
-
-definition : typedef { $item[1] }
- | function { $item[1] }
- | const { $item[1] }
-
-const : 'const' <commit> identifier identifier '=' anytext ';'
- {{
- "TYPE" => "CONST",
- "DTYPE" => $item[3],
- "NAME" => $item[4],
- "VALUE" => $item{anytext}
- }}
- | <error?>
-
-typedef : 'typedef' <commit> type identifier array_len(?) ';'
- {{
- "TYPE" => "TYPEDEF",
- "NAME" => $item{identifier},
- "DATA" => $item{type},
- "ARRAY_LEN" => $item[5][0]
- }}
- | <error?>
-
-enum: 'enum' <commit> '{' enum_element(s? /,/) '}'
- {{
- "TYPE" => "ENUM",
- "ELEMENTS" => $item[4]
- }}
- | <error?>
-
-enum_element: /[\w\s=]+/
-
-struct: property_list(s?) 'struct' <commit> '{' element_list1(?) '}'
- {{
- "TYPE" => "STRUCT",
- "PROPERTIES" => util::FlattenArray($item[1]),
- "ELEMENTS" => util::FlattenArray2($item[5])
- }}
- | <error?>
-
-union: property_list(s?) 'union' <commit> '{' union_element(s?) '}'
- {{
- "TYPE" => "UNION",
- "PROPERTIES" => util::FlattenArray($item[1]),
- "DATA" => $item[5]
- }}
- | <error?>
-
-union_element:
- '[' 'case' '(' identifier ')' ']' base_element ';'
- {{
- "TYPE" => "UNION_ELEMENT",
- "CASE" => $item{identifier},
- "DATA" => $item{base_element}
- }}
- | '[' 'case' '(' identifier ')' ']' ';'
- {{
- "TYPE" => "EMPTY",
- "CASE" => $item{identifier},
- }}
- | '[' 'default' ']' base_element ';'
- {{
- "TYPE" => "UNION_ELEMENT",
- "CASE" => "default",
- "DATA" => $item{base_element}
- }}
- | '[' 'default' ']' ';'
- {{
- "TYPE" => "EMPTY",
- "CASE" => "default",
- }}
-
-base_element: property_list(s?) type pointer(s?) identifier array_len(?)
- {{
- "NAME" => $item{identifier},
- "TYPE" => $item{type},
- "PROPERTIES" => util::FlattenArray($item[1]),
- "POINTERS" => $#{$item[3]}==-1?undef:$#{$item[3]}+1,
- "ARRAY_LEN" => $item[5][0]
- }}
- | <error>
-
-array_len:
- '[' ']'
- { "*" }
- | '[' '*' ']'
- { "*" }
- | '[' <commit> anytext ']'
- { "$item{anytext}" }
- | <error?>
-
-element_list1: base_element(s? /;/) ';'
- { $item[1] }
-
-element_list2: 'void'
- | base_element(s? /,/)
- { $item[1] }
-
-pointer: '*'
-
-property_list: '[' <commit> property(s /,/) ']'
- { $item[3] }
- | <error?>
-
-property: 'unique'
- | 'in'
- | 'out'
- | 'ref'
- | 'public'
- | 'noprint'
- | 'relative'
- | 'nodiscriminant'
- | 'subcontext' '(' constant ')' {{ "$item[1]" => "$item{constant}" }}
- | 'flag' '(' anytext ')' {{ "$item[1]" => "$item{anytext}" }}
- | 'size_is' '(' expression ')' {{ "$item[1]" => "$item{expression}" }}
- | 'length_is' '(' expression ')' {{ "$item[1]" => "$item{expression}" }}
- | 'switch_is' '(' expression ')' {{ "$item[1]" => "$item{expression}" }}
- | 'value' '(' anytext ')' {{ "$item[1]" => "$item{anytext}" }}
-
-identifier: /[\w?]+/
-
-expression: /[\w.?\/+*-_]+/
-
-function : property_list(s?) type identifier '(' <commit> element_list2 ');'
- {{
- "TYPE" => "FUNCTION",
- "NAME" => $item{identifier},
- "RETURN_TYPE" => $item{type},
- "PROPERTIES" => util::FlattenArray($item[1]),
- "DATA" => $item{element_list2}
- }}
- | <error?>
-
-type :
- struct { $item[1] }
- | union { $item[1] }
- | enum { $item[1] }
- | identifier { $item[1] }
- | <error>
-
-text: /[\w\s\..?-]*/
-
-text2: /[\|\w\s,\*&\>"\/\..?-]*/
-
-anytext: text2 '(' <commit> anytext ')' anytext
- {{ "$item[1]($item[4])$item[6]" }}
- | text2 '+' anytext
- {{ "$item[1]+$item[3]" }}
- | text2
-
-constant: /-?[\dx]+/
- | '*'
-
base_or_empty: base_element ';' | empty_element;
optional_base_element:
- property_list base_or_empty { $_[2]->{PROPERTIES} = util::FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
+ property_list base_or_empty { $_[2]->{PROPERTIES} = Parse::Pidl::Util::FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
;
union_elements:
property_list:
#empty
- | property_list '[' properties ']' { util::FlattenHash([$_[1],$_[3]]); }
+ | property_list '[' properties ']' { Parse::Pidl::Util::FlattenHash([$_[1],$_[3]]); }
;
properties: property { $_[1] }
- | properties ',' property { util::FlattenHash([$_[1], $_[3]]); }
+ | properties ',' property { Parse::Pidl::Util::FlattenHash([$_[1], $_[3]]); }
;
property: identifier {{ "$_[1]" => "1" }}
# start code
%%
-use pidl::util;
+use Parse::Pidl::Util;
sub _Error {
if (exists $_[0]->YYData->{ERRMSG}) {
my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
- return util::CleanData($idl);
+ return Parse::Pidl::Util::CleanData($idl);
}
use strict;
-use FindBin qw($RealBin);
-use lib "$RealBin/..";
use Getopt::Long;
use File::Basename;
-use pidl::idl;
-use pidl::dump;
-use pidl::ndr_client;
-use pidl::ndr_header;
-use pidl::ndr_parser;
-use pidl::server;
-use pidl::dcom_proxy;
-use pidl::dcom_stub;
-use pidl::com_header;
-use pidl::odl;
-use pidl::eth_parser;
-use pidl::eth_header;
-use pidl::validator;
-use pidl::typelist;
-use pidl::util;
-use pidl::template;
-use pidl::swig;
-use pidl::compat;
-use pidl::ejs;
-use pidl::ejs_header;
+use Parse::Pidl;
+use Parse::Pidl::Util;
+
+#####################################################################
+# save a data structure into a file
+sub SaveStructure($$)
+{
+ my($filename,$v) = @_;
+ Parse::Pidl::Util::FileSave($filename, Parse::Pidl::Util::MyDumper($v));
+}
+
+#####################################################################
+# load a data structure from a file (as saved with SaveStructure)
+sub LoadStructure($)
+{
+ my $f = shift;
+ my $contents = Parse::Pidl::Util::FileLoad($f);
+ defined $contents || return undef;
+ return eval "$contents";
+}
my($opt_help) = 0;
my($opt_parse) = 0;
my($opt_verbose) = 0;
my($opt_warn_compat) = 0;
-my $idl_parser = new idl;
-
#########################################
# display help text
sub ShowHelp()
$output = $opt_output . $basename;
}
- my($pidl_file) = ($opt_keep or util::ChangeExtension($output, ".pidl"));
+ my($pidl_file) = ($opt_keep or Parse::Pidl::Util::ChangeExtension($output, ".pidl"));
unless ($opt_quiet) { print "Compiling $idl_file\n"; }
if ($opt_parse) {
+ require Parse::Pidl::IDL;
+ my $idl_parser = new Parse::Pidl::IDL;
+
$pidl = $idl_parser->parse_idl($idl_file);
defined @$pidl || die "Failed to parse $idl_file";
- typelist::LoadIdl($pidl);
- IdlValidator::Validate($pidl);
- if (defined($opt_keep) && !util::SaveStructure($pidl_file, $pidl)) {
+ require Parse::Pidl::Typelist;
+ Parse::Pidl::Typelist::LoadIdl($pidl);
+ require Parse::Pidl::Validator;
+ Parse::Pidl::Validator::Validate($pidl);
+ if (defined($opt_keep) && !SaveStructure($pidl_file, $pidl)) {
die "Failed to save $pidl_file\n";
}
} else {
- $pidl = util::LoadStructure($pidl_file);
+ $pidl = LoadStructure($pidl_file);
defined $pidl || die "Failed to load $pidl_file - maybe you need --parse\n";
}
if ($opt_uint_enums) {
- util::setUseUintEnums(1);
+ Parse::Pidl::Util::setUseUintEnums(1);
}
if ($opt_dump) {
- print IdlDump::Dump($pidl);
+ require Parse::Pidl::Dump;
+ print Parse::Pidl::Dump($pidl);
}
if ($opt_diff) {
- my($tempfile) = util::ChangeExtension($output, ".tmp");
- util::FileSave($tempfile, IdlDump::Dump($pidl));
+ my($tempfile) = Parse::Pidl::Util::ChangeExtension($output, ".tmp");
+ Parse::Pidl::Util::FileSave($tempfile, IdlDump::Dump($pidl));
system("diff -wu $idl_file $tempfile");
unlink($tempfile);
}
if (defined($opt_com_header)) {
- my $res = COMHeader::Parse($pidl);
+ require Parse::Pidl::Samba::COM::Header;
+ my $res = Parse::Pidl::Samba::COM::Header::Parse($pidl);
if ($res) {
my $comh_filename = ($opt_com_header or (dirname($output) . "/com_$basename.h"));
- util::FileSave($comh_filename,
+ Parse::Pidl::Util::FileSave($comh_filename,
"#include \"librpc/gen_ndr/ndr_orpc.h\"\n" .
"#include \"librpc/gen_ndr/ndr_$basename.h\"\n" .
$res);
}
if (defined($opt_dcom_proxy)) {
- my $res = DCOMProxy::Parse($pidl);
+ require Parse::Pidl::Samba::COM::Proxy;
+ my $res = Parse::Pidl::Samba::COM::Proxy::Parse($pidl);
if ($res) {
- my ($client) = ($opt_dcom_proxy or util::ChangeExtension($output, "_p.c"));
- util::FileSave($client,
+ my ($client) = ($opt_dcom_proxy or Parse::Pidl::Util::ChangeExtension($output, "_p.c"));
+ Parse::Pidl::Util::FileSave($client,
"#include \"includes.h\"\n" .
"#include \"librpc/gen_ndr/com_$basename.h\"\n" .
"#include \"lib/com/dcom/dcom.h\"\n" .$res);
}
if ($opt_warn_compat) {
- IDLCompat::Check($pidl);
+ require Parse::Pidl::Compat;
+ Parse::Pidl::Compat::Check($pidl);
}
if ($opt_odl) {
- $pidl = ODL::ODL2IDL($pidl);
+ require Parse::Pidl::ODL;
+ $pidl = Parse::Pidl::ODL::ODL2IDL($pidl);
}
if (defined($opt_header) or defined($opt_eth_parser) or
defined($opt_eth_header) or defined($opt_client) or
defined($opt_server) or defined($opt_parser) or
defined($opt_ejs)) {
- $ndr = Ndr::Parse($pidl);
+ require Parse::Pidl::NDR;
+ $ndr = Parse::Pidl::NDR::Parse($pidl);
}
if (defined($opt_header)) {
my $header = $opt_header;
if ($header eq "") {
- $header = util::ChangeExtension($output, ".h");
+ $header = Parse::Pidl::Util::ChangeExtension($output, ".h");
}
- util::FileSave($header, NdrHeader::Parse($ndr));
+ require Parse::Pidl::Samba::NDR::Header;
+ Parse::Pidl::Util::FileSave($header, Parse::Pidl::Samba::NDR::Header::Parse($ndr));
if (defined($opt_swig)) {
+ require Parse::Pidl::Samba::SWIG;
my($filename) = $output;
$filename =~ s/\/ndr_/\//;
- $filename = ($opt_swig or util::ChangeExtension($filename, ".i"));
- IdlSwig::RewriteHeader($pidl, $header, $filename);
+ $filename = ($opt_swig or Parse::Pidl::Util::ChangeExtension($filename, ".i"));
+ Parse::Pidl::Samba::SWIG::RewriteHeader($pidl, $header, $filename);
}
}
if (defined($opt_eth_header)) {
+ require Parse::Pidl::Ethereal::NDR::Header;
my($eparserhdr) = ($opt_eth_header or (dirname($output) . "/packet-dcerpc-$basename.h"));
- util::FileSave($eparserhdr, EthHeader::Parse($ndr));
+ Parse::Pidl::Util::FileSave($eparserhdr, Parse::Pidl::Ethereal::NDR::Header::Parse($ndr));
}
- my $h_filename = util::ChangeExtension($output, ".h");
+ my $h_filename = Parse::Pidl::Util::ChangeExtension($output, ".h");
if (defined($opt_client)) {
- my ($client) = ($opt_client or util::ChangeExtension($output, "_c.c"));
+ require Parse::Pidl::Samba::NDR::Client;
+ my ($client) = ($opt_client or Parse::Pidl::Util::ChangeExtension($output, "_c.c"));
- util::FileSave($client, NdrClient::Parse($ndr,$h_filename));
+ Parse::Pidl::Util::FileSave($client, Parse::Pidl::Samba::NDR::Client::Parse($ndr,$h_filename));
}
if (defined($opt_ejs)) {
- my $ejs = ($opt_ejs or util::ChangeExtension($output, "_ejs.c"));
- util::FileSave($ejs, EjsClient::Parse($ndr, $h_filename));
+ require Parse::Pidl::Samba::EJS;
+ require Parse::Pidl::Samba::EJSHeader;
+ my $ejs = ($opt_ejs or Parse::Pidl::Util::ChangeExtension($output, "_ejs.c"));
+ Parse::Pidl::Util::FileSave($ejs, Parse::Pidl::Samba::EJS::Parse($ndr, $h_filename));
- $ejs = ($opt_ejs or util::ChangeExtension($output, "_ejs.h"));
- util::FileSave($ejs, EjsHeader::Parse($ndr));
+ $ejs = ($opt_ejs or Parse::Pidl::Util::ChangeExtension($output, "_ejs.h"));
+ Parse::Pidl::Util::FileSave($ejs, Parse::Pidl::Samba::EJSHeader::Parse($ndr));
}
if (defined($opt_server)) {
+ require Parse::Pidl::Samba::NDR::Server;
my $dcom = "";
foreach my $x (@{$pidl}) {
next if ($x->{TYPE} ne "INTERFACE");
- if (util::has_property($x, "object")) {
- $dcom .= DCOMStub::ParseInterface($x);
+ if (Parse::Pidl::Util::has_property($x, "object")) {
+ require Parse::Pidl::Samba::COM::Stub;
+ $dcom .= Parse::Pidl::Samba::COM::Stub::ParseInterface($x);
}
}
- util::FileSave(($opt_server or util::ChangeExtension($output, "_s.c")), NdrServer::Parse($ndr,$h_filename));
+ Parse::Pidl::Util::FileSave(($opt_server or Parse::Pidl::Util::ChangeExtension($output, "_s.c")), Parse::Pidl::Samba::NDR::Server::Parse($ndr,$h_filename));
if ($dcom ne "") {
$dcom = "
$dcom
";
- util::FileSave(util::ChangeExtension($output, "_d.c"), $dcom);
+ Parse::Pidl::Util::FileSave(Parse::Pidl::Util::ChangeExtension($output, "_d.c"), $dcom);
}
}
if (defined($opt_parser)) {
- my $parser = ($opt_parser or util::ChangeExtension($output, ".c"));
-
- util::FileSave($parser, NdrParser::Parse($ndr, $parser));
+ my $parser = ($opt_parser or Parse::Pidl::Util::ChangeExtension($output, ".c"));
+ require Parse::Pidl::Samba::NDR::Parser;
+ Parse::Pidl::Util::FileSave($parser, Parse::Pidl::Samba::NDR::Parser::Parse($ndr, $parser));
}
if (defined($opt_eth_parser)) {
+ require Parse::Pidl::Ethereal::NDR::Parser;
my($eparser) = ($opt_eth_parser or dirname($output) . "/packet-dcerpc-$basename.c");
- util::FileSave($eparser, EthParser::Parse($ndr, $basename, $eparser));
+ Parse::Pidl::Util::FileSave($eparser, Parse::Pidl::Ethereal::NDR::Parser::Parse($ndr, $basename, $eparser));
}
if ($opt_template) {
- print IdlTemplate::Parse($pidl);
+ require Parse::Pidl::Samba::Template;
+ print Parse::Pidl::Samba::Template::Parse($pidl);
}
}
my $ctx = shift;
return << '__EOD__';
-idl_full: build/pidl/idl.pm
+idl_full: build/pidl/Parse/Pidl/IDL.pm
CPP="@CPP@" PERL="$(PERL)" script/build_idl.sh FULL @PIDL_ARGS@
-idl: build/pidl/idl.pm
+idl: build/pidl/Parse/Pidl/IDL.pm
@CPP="@CPP@" PERL="$(PERL)" script/build_idl.sh PARTIAL @PIDL_ARGS@
-build/pidl/idl.pm: build/pidl/idl.yp
- -yapp -s build/pidl/idl.yp
+build/pidl/Parse/Pidl/IDL.pm: build/pidl/idl.yp
+ -yapp -s -m 'Parse::Pidl::IDL' -o build/pidl/Parse/Pidl/IDL.pm build/pidl/idl.yp
pch: proto include/includes.h.gch
[ -d librpc/gen_ndr ] || mkdir -p librpc/gen_ndr || exit 1
-PIDL="$PERL ./build/pidl/pidl --output librpc/gen_ndr/ndr_ --parse --header --parser --server --client --dcom-proxy --com-header --swig --odl --ejs -- $PIDL_EXTRA_ARGS"
+PIDL="$PERL -Ibuild/pidl ./build/pidl/pidl --output librpc/gen_ndr/ndr_ --parse --header --parser --server --client --dcom-proxy --com-header --swig --odl --ejs -- $PIDL_EXTRA_ARGS"
if [ x$FULLBUILD = xFULL ]; then
echo Rebuilding all idl files in librpc/idl
git.samba.org / jelmer / samba4-debian.git / commitdiff