Make RPC code generator a little more flexible

Update the gendispatch.pl script to get a little closer to
being able to generate code for the LXC monitor, by passing
in the struct prefix separately from the procedure prefix.
Also allow method names using virCapitalLetters instead
of vir_underscore_separator
Signed-off-by: NDaniel P. Berrange <berrange@redhat.com>

daemon/Makefile.am

@@ -58,12 +58,12 @@ QEMU_PROTOCOL = $(top_srcdir)/src/remote/qemu_protocol.x
 
 $(srcdir)/remote_dispatch.h: $(srcdir)/../src/rpc/gendispatch.pl \
 		$(REMOTE_PROTOCOL)
-	$(AM_V_GEN)$(PERL) -w $(srcdir)/../src/rpc/gendispatch.pl -b remote \
+	$(AM_V_GEN)$(PERL) -w $(srcdir)/../src/rpc/gendispatch.pl -b remote REMOTE \
 	  $(REMOTE_PROTOCOL) > $@
 
 $(srcdir)/qemu_dispatch.h: $(srcdir)/../src/rpc/gendispatch.pl \
 		$(QEMU_PROTOCOL)
-	$(AM_V_GEN)$(PERL) -w $(srcdir)/../src/rpc/gendispatch.pl -b qemu \
+	$(AM_V_GEN)$(PERL) -w $(srcdir)/../src/rpc/gendispatch.pl -b qemu QEMU \
 	  $(QEMU_PROTOCOL) > $@
 
 if WITH_LIBVIRTD

src/Makefile.am

@@ -230,12 +230,12 @@ REMOTE_DRIVER_PROTOCOL = $(REMOTE_PROTOCOL) $(QEMU_PROTOCOL)
 $(srcdir)/remote/remote_client_bodies.h: $(srcdir)/rpc/gendispatch.pl \
 		$(REMOTE_PROTOCOL)
 	$(AM_V_GEN)$(PERL) -w $(srcdir)/rpc/gendispatch.pl \
-	  -k remote $(REMOTE_PROTOCOL) > $@
+	  -k remote REMOTE $(REMOTE_PROTOCOL) > $@
 
 $(srcdir)/remote/qemu_client_bodies.h: $(srcdir)/rpc/gendispatch.pl \
 		$(QEMU_PROTOCOL)
 	$(AM_V_GEN)$(PERL) -w $(srcdir)/rpc/gendispatch.pl \
-	  -k qemu $(QEMU_PROTOCOL) > $@
+	  -k qemu QEMU $(QEMU_PROTOCOL) > $@
 
 REMOTE_DRIVER_SOURCES =						\
 		gnutls_1_0_compat.h				\

src/rpc/gendispatch.pl

@@ -20,25 +20,61 @@ use strict;
 use Getopt::Std;
 
 # Command line options.
+# -k - client bodies
+# -b - server bodies
 our ($opt_p, $opt_t, $opt_a, $opt_r, $opt_d, $opt_b, $opt_k);
 getopts ('ptardbk');
 
-my $structprefix = shift or die "missing prefix argument";
+my $structprefix = shift or die "missing struct prefix argument";
+my $procprefix = shift or die "missing procedure prefix argument";
 my $protocol = shift or die "missing protocol argument";
 my @autogen;
 
-my $procprefix = uc $structprefix;
+
+sub fixup_name {
+    my $name = shift;
+
+    $name =~ s/Nwfilter/NWFilter/;
+    $name =~ s/Xml$/XML/;
+    $name =~ s/Uri$/URI/;
+    $name =~ s/Uuid$/UUID/;
+    $name =~ s/Id$/ID/;
+    $name =~ s/Mac$/MAC/;
+    $name =~ s/Cpu$/CPU/;
+    $name =~ s/Os$/OS/;
+    $name =~ s/Nmi$/NMI/;
+    $name =~ s/Pm/PM/;
+
+    return $name;
+}
 
 # Convert name_of_call to NameOfCall.
 sub name_to_ProcName {
     my $name = shift;
+
+    my @elems;
+    if ($name =~ /_/ || (lc $name) eq "open" || (lc $name) eq "close") {
+	@elems = split /_/, $name;
+	@elems = map lc, @elems;
+	@elems = map ucfirst, @elems;
+    } else {
+	@elems = $name;
+    }
+    @elems = map { fixup_name($_) } @elems;
+    my $procname = join "", @elems;
+
+    return $procname;
+}
+
+sub name_to_TypeName {
+    my $name = shift;
+
     my @elems = split /_/, $name;
+    @elems = map lc, @elems;
     @elems = map ucfirst, @elems;
-    @elems = map { $_ =~ s/Nwfilter/NWFilter/; $_ =~ s/Xml$/XML/;
-                   $_ =~ s/Uri$/URI/; $_ =~ s/Uuid$/UUID/; $_ =~ s/Id$/ID/;
-                   $_ =~ s/Mac$/MAC/; $_ =~ s/Cpu$/CPU/; $_ =~ s/Os$/OS/;
-                   $_ =~ s/Nmi$/NMI/; $_ =~ s/Pm/PM/; $_ } @elems;
-    join "", @elems
+    @elems = map { fixup_name($_) } @elems;
+    my $typename = join "", @elems;
+    return $typename;
 }
 
 # Read the input file (usually remote_protocol.x) and form an
@@ -64,18 +100,20 @@ while (<PROTOCOL>) {
         } elsif ($_ =~ m/^\s*(.*\S)\s*$/) {
             push(@{$calls{$name}->{ret_members}}, $1);
         }
-    } elsif (/^struct ${structprefix}_(.*)_args/) {
-        $name = $1;
+    } elsif (/^struct (${structprefix}_(.*)_args)/ ||
+             /^struct (${structprefix}(.*)Args)/) {
+        my $structname = $1;
+        $name = $2;
         $ProcName = name_to_ProcName ($name);
-
-        die "duplicate definition of ${structprefix}_${name}_args"
+        $name = lc $name;
+        $name =~ s/_//g;
+        die "duplicate definition of $_"
             if exists $calls{$name};
 
         $calls{$name} = {
             name => $name,
             ProcName => $ProcName,
-            UC_NAME => uc $name,
-            args => "${structprefix}_${name}_args",
+            args => $structname,
             args_members => [],
             ret => "void"
         };
@@ -83,20 +121,23 @@ while (<PROTOCOL>) {
         $collect_args_members = 1;
         $collect_ret_members = 0;
         $last_name = $name;
-    } elsif (/^struct ${structprefix}_(.*)_ret\s+{(.*)$/) {
-        $name = $1;
-        $flags = $2;
+    } elsif (/^struct (${structprefix}_(.*)_ret)\s+{(.*)$/ ||
+             /^struct (${structprefix}(.*)Ret)\s+{(.*)$/) {
+        my $structname = $1;
+        $name = $2;
+        $flags = $3;
         $ProcName = name_to_ProcName ($name);
+        $name = lc $name;
+        $name =~ s/_//g;
 
         if (exists $calls{$name}) {
-            $calls{$name}->{ret} = "${structprefix}_${name}_ret";
+            $calls{$name}->{ret} = $structname;
         } else {
             $calls{$name} = {
                 name => $name,
                 ProcName => $ProcName,
-                UC_NAME => uc $name,
                 args => "void",
-                ret => "${structprefix}_${name}_ret",
+                ret => $structname,
                 ret_members => []
             }
         }
@@ -112,24 +153,29 @@ while (<PROTOCOL>) {
         $collect_args_members = 0;
         $collect_ret_members = 1;
         $last_name = $name;
-    } elsif (/^struct ${structprefix}_(.*)_msg/) {
-        $name = $1;
+    } elsif (/^struct (${structprefix}_(.*)_msg)/ ||
+             /^struct (${structprefix}(.*)Msg)/) {
+        my $structname = $1;
+        $name = $2;
         $ProcName = name_to_ProcName ($name);
-
+        $name = lc $name;
+        $name =~ s/_//g;
         $calls{$name} = {
             name => $name,
             ProcName => $ProcName,
-            UC_NAME => uc $name,
-            msg => "${structprefix}_${name}_msg"
+            msg => $structname,
         };
 
         $collect_args_members = 0;
         $collect_ret_members = 0;
-    } elsif (/^\s*${procprefix}_PROC_(.*?)\s*=\s*(\d+)\s*,?(.*)$/) {
-        $name = lc $1;
-        $id = $2;
-        $flags = $3;
+    } elsif (/^\s*(${procprefix}_PROC_(.*?))\s*=\s*(\d+)\s*,?(.*)$/) {
+        my $constname = $1;
+        $name = $2;
+        $id = $3;
+        $flags = $4;
         $ProcName = name_to_ProcName ($name);
+        $name = lc $name;
+        $name =~ s/_//g;
 
         if (!exists $calls{$name}) {
             # that the argument and return value cases have not yet added
@@ -139,15 +185,15 @@ while (<PROTOCOL>) {
             $calls{$name} = {
                 name => $name,
                 ProcName => $ProcName,
-                UC_NAME => uc $name,
                 args => "void",
                 ret => "void"
             }
         }
+        $calls{$name}->{constname} = $constname;
 
         if ($opt_b or $opt_k) {
             if (!($flags =~ m/^\s*\/\*\s*(\S+)\s+(\S+)\s*(\|.*)?\s+(priority:(\S+))?\s*\*\/\s*$/)) {
-                die "invalid generator flags for ${procprefix}_PROC_${name}"
+                die "invalid generator flags '$flags' for $constname"
             }
 
             my $genmode = $opt_b ? $1 : $2;
@@ -371,7 +417,7 @@ elsif ($opt_b) {
                     # ignore the name arg for node devices
                     next
                 } elsif ($args_member =~ m/^remote_nonnull_(domain|network|storage_pool|storage_vol|interface|secret|nwfilter) (\S+);/) {
-                    my $type_name = name_to_ProcName($1);
+                    my $type_name = name_to_TypeName($1);
 
                     push(@vars_list, "vir${type_name}Ptr $2 = NULL");
                     push(@getters_list,
@@ -580,7 +626,7 @@ elsif ($opt_b) {
                     $single_ret_by_ref = 0;
                     $single_ret_check = " == NULL";
                 } elsif ($ret_member =~ m/^remote_nonnull_(domain|network|storage_pool|storage_vol|interface|node_device|secret|nwfilter|domain_snapshot) (\S+);/) {
-                    my $type_name = name_to_ProcName($1);
+                    my $type_name = name_to_TypeName($1);
 
                     if ($call->{ProcName} eq "DomainCreateWithFlags") {
                         # SPECIAL: virDomainCreateWithFlags updates the given
@@ -1031,7 +1077,7 @@ elsif ($opt_k) {
                 } elsif ($args_member =~ m/^remote_nonnull_(domain|network|storage_pool|storage_vol|interface|secret|nwfilter|domain_snapshot) (\S+);/) {
                     my $name = $1;
                     my $arg_name = $2;
-                    my $type_name = name_to_ProcName($name);
+                    my $type_name = name_to_TypeName($name);
 
                     if ($is_first_arg) {
                         if ($name eq "domain_snapshot") {
@@ -1254,7 +1300,7 @@ elsif ($opt_k) {
                 } elsif ($ret_member =~ m/^remote_nonnull_(domain|network|storage_pool|storage_vol|node_device|interface|secret|nwfilter|domain_snapshot) (\S+);/) {
                     my $name = $1;
                     my $arg_name = $2;
-                    my $type_name = name_to_ProcName($name);
+                    my $type_name = name_to_TypeName($name);
 
                     if ($name eq "node_device") {
                         $priv_name = "devMonPrivateData";
@@ -1400,7 +1446,7 @@ elsif ($opt_k) {
 
         if ($call->{streamflag} ne "none") {
             print "\n";
-            print "    if (!(netst = virNetClientStreamNew(priv->remoteProgram, REMOTE_PROC_$call->{UC_NAME}, priv->counter)))\n";
+            print "    if (!(netst = virNetClientStreamNew(priv->remoteProgram, $call->{constname}, priv->counter)))\n";
             print "        goto done;\n";
             print "\n";
             print "    if (virNetClientAddStream(priv->client, netst) < 0) {\n";
@@ -1474,7 +1520,7 @@ elsif ($opt_k) {
         }
 
         print "\n";
-        print "    if (call($priv_src, priv, $callflags, ${procprefix}_PROC_$call->{UC_NAME},\n";
+        print "    if (call($priv_src, priv, $callflags, $call->{constname},\n";
         print "             (xdrproc_t)xdr_$argtype, (char *)$call_args,\n";
         print "             (xdrproc_t)xdr_$rettype, (char *)$call_ret) == -1) {\n";
 
@@ -1542,7 +1588,7 @@ elsif ($opt_k) {
         if ($single_ret_as_list or $single_ret_cleanup) {
             print "\n";
             print "cleanup:\n";
-            print "    xdr_free((xdrproc_t)xdr_remote_$call->{name}_ret, (char *)&ret);\n";
+            print "    xdr_free((xdrproc_t)xdr_$call->{ret}, (char *)&ret);\n";
         }
 
         print "\n";