X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=generator%2Fgenerator_perl.ml;h=04ce155d32ed8c733ee3add90de1254cd868da82;hb=1dc833b8851674f1619d018bb4badcc9f3e938d5;hp=020f1b2e8c79f6f59e31d77745e600161647227c;hpb=ea6209198026080a9d9e588283e83aa9c4e2f177;p=libguestfs.git

diff --git a/generator/generator_perl.ml b/generator/generator_perl.ml
index 020f1b2..04ce155 100644
--- a/generator/generator_perl.ml
+++ b/generator/generator_perl.ml
@@ -199,8 +199,8 @@ clear_progress_callback (g)
 ";
 
   List.iter (
-    fun (name, style, _, _, _, _, _) ->
-      (match fst style with
+    fun (name, (ret, args, optargs as style), _, _, _, _, _) ->
+      (match ret with
        | RErr -> pr "void\n"
        | RInt _ -> pr "SV *\n"
        | RInt64 _ -> pr "SV *\n"
@@ -218,7 +218,9 @@ clear_progress_callback (g)
       pr "%s (g" name;
       List.iter (
         fun arg -> pr ", %s" (name_of_argt arg)
-      ) (snd style);
+      ) args;
+      if optargs <> [] then
+        pr ", ...";
       pr ")\n";
       pr "      guestfs_h *g;\n";
       iteri (
@@ -240,11 +242,12 @@ clear_progress_callback (g)
           | Bool n -> pr "      int %s;\n" n
           | Int n -> pr "      int %s;\n" n
           | Int64 n -> pr "      int64_t %s;\n" n
-      ) (snd style);
+          | Pointer (t, n) -> pr "      %s %s;\n" t n
+      ) args;
 
       (* PREINIT section (local variable declarations). *)
       pr "PREINIT:\n";
-      (match fst style with
+      (match ret with
        | RErr ->
            pr "      int r;\n";
        | RInt _
@@ -272,11 +275,17 @@ clear_progress_callback (g)
            pr "      size_t size;\n";
       );
 
+      if optargs <> [] then (
+        pr "      struct guestfs_%s_argv optargs_s = { .bitmask = 0 };\n" name;
+        pr "      struct guestfs_%s_argv *optargs = &optargs_s;\n" name;
+        pr "      size_t items_i;\n";
+      );
+
       (* CODE or PPCODE section.  PPCODE is used where we are
        * returning void, or where we push the return value on the stack
        * ourselves.  Using CODE means we will manipulate RETVAL.
        *)
-      (match fst style with
+      (match ret with
        | RErr ->
            pr " PPCODE:\n";
        | RInt n
@@ -299,8 +308,52 @@ clear_progress_callback (g)
            pr " PPCODE:\n";
       );
 
+      (* For optional arguments, convert these from the XSUB "items"
+       * variable by hand.
+       *)
+      if optargs <> [] then (
+        let uc_name = String.uppercase name in
+        let skip = List.length args + 1 in
+        pr "      if (((items - %d) & 1) != 0)\n" skip;
+        pr "        croak (\"expecting an even number of extra parameters\");\n";
+        pr "      for (items_i = %d; items_i < items; items_i += 2) {\n" skip;
+        pr "        uint64_t this_mask;\n";
+        pr "        const char *this_arg;\n";
+        pr "\n";
+        pr "        this_arg = SvPV_nolen (ST (items_i));\n";
+        pr "        ";
+        List.iter (
+          fun argt ->
+            let n = name_of_argt argt in
+            let uc_n = String.uppercase n in
+            pr "if (strcmp (this_arg, \"%s\") == 0) {\n" n;
+            pr "          optargs_s.%s = " n;
+            (match argt with
+             | Bool _
+             | Int _
+             | Int64 _ -> pr "SvIV (ST (items_i+1))"
+             | String _ -> pr "SvPV_nolen (ST (items_i+1))"
+             | _ -> assert false
+            );
+            pr ";\n";
+            pr "          this_mask = GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
+            pr "        }\n";
+            pr "        else ";
+        ) optargs;
+        pr "croak (\"unknown optional argument '%%s'\", this_arg);\n";
+        pr "        if (optargs_s.bitmask & this_mask)\n";
+        pr "          croak (\"optional argument '%%s' given twice\",\n";
+        pr "                 this_arg);\n";
+        pr "        optargs_s.bitmask |= this_mask;\n";
+        pr "      }\n";
+        pr "\n";
+      );
+
       (* The call to the C function. *)
-      pr "      r = guestfs_%s " name;
+      if optargs = [] then
+        pr "      r = guestfs_%s " name
+      else
+        pr "      r = guestfs_%s_argv " name;
       generate_c_call_args ~handle:"g" style;
       pr ";\n";
 
@@ -310,12 +363,12 @@ clear_progress_callback (g)
         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
         | Bool _ | Int _ | Int64 _
         | FileIn _ | FileOut _
-        | BufferIn _ | Key _ -> ()
+        | BufferIn _ | Key _ | Pointer _ -> ()
         | StringList n | DeviceList n -> pr "      free (%s);\n" n
-      ) (snd style);
+      ) args;
 
       (* Check return value for errors and return it if necessary. *)
-      (match fst style with
+      (match ret with
        | RErr ->
            pr "      if (r == -1)\n";
            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
@@ -469,9 +522,9 @@ Sys::Guestfs - Perl bindings for libguestfs
  use Sys::Guestfs;
 
  my $h = Sys::Guestfs->new ();
- $h->add_drive ('guest.img');
+ $h->add_drive_opts ('guest.img', format => 'raw');
  $h->launch ();
- $h->mount ('/dev/sda1', '/');
+ $h->mount_options ('', '/dev/sda1', '/');
  $h->touch ('/hello');
  $h->sync ();
 
@@ -600,10 +653,71 @@ the handle.
       )
   ) all_functions_sorted;
 
+  pr "=cut\n\n";
+
+  (* Introspection hash. *)
+  pr "use vars qw(%%guestfs_introspection);\n";
+  pr "%%guestfs_introspection = (\n";
+  List.iter (
+    fun (name, (ret, args, optargs), _, _, _, shortdesc, _) ->
+      pr "  \"%s\" => {\n" name;
+      pr "    ret => ";
+      (match ret with
+       | RErr -> pr "'void'"
+       | RInt _ -> pr "'int'"
+       | RBool _ -> pr "'bool'"
+       | RInt64 _ -> pr "'int64'"
+       | RConstString _ -> pr "'const string'"
+       | RConstOptString _ -> pr "'const nullable string'"
+       | RString _ -> pr "'string'"
+       | RStringList _ -> pr "'string list'"
+       | RHashtable _ -> pr "'hash'"
+       | RStruct (_, typ) -> pr "'struct %s'" typ
+       | RStructList (_, typ) -> pr "'struct %s list'" typ
+       | RBufferOut _ -> pr "'buffer'"
+      );
+      pr ",\n";
+      let pr_type i = function
+        | Pathname n -> pr "[ '%s', 'string(path)', %d ]" n i
+        | Device n -> pr "[ '%s', 'string(device)', %d ]" n i
+        | Dev_or_Path n -> pr "[ '%s', 'string(dev_or_path)', %d ]" n i
+        | String n -> pr "[ '%s', 'string', %d ]" n i
+        | FileIn n -> pr "[ '%s', 'string(filename)', %d ]" n i
+        | FileOut n -> pr "[ '%s', 'string(filename)', %d ]" n i
+        | Key n -> pr "[ '%s', 'string(key)', %d ]" n i
+        | BufferIn n -> pr "[ '%s', 'buffer', %d ]" n i
+        | OptString n -> pr "[ '%s', 'nullable string', %d ]" n i
+        | StringList n -> pr "[ '%s', 'string list', %d ]" n i
+        | DeviceList n -> pr "[ '%s', 'string(device) list', %d ]" n i
+        | Bool n -> pr "[ '%s', 'bool', %d ]" n i
+        | Int n -> pr "[ '%s', 'int', %d ]" n i
+        | Int64 n -> pr "[ '%s', 'int64', %d ]" n i
+        | Pointer (t, n) -> pr "[ '%s', 'pointer(%s)', %d ]" n t i
+      in
+      pr "    args => [\n";
+      iteri (fun i arg ->
+        pr "      ";
+        pr_type i arg;
+        pr ",\n"
+      ) args;
+      pr "    ],\n";
+      if optargs <> [] then (
+        pr "    optargs => {\n";
+        iteri (fun i arg ->
+          pr "      %s => " (name_of_argt arg);
+          pr_type i arg;
+          pr ",\n"
+        ) optargs;
+        pr "    },\n";
+      );
+      pr "    name => \"%s\",\n" name;
+      pr "    description => %S,\n" shortdesc;
+      pr "  },\n";
+  ) all_functions_sorted;
+  pr ");\n\n";
+
   (* End of file. *)
   pr "\
-=cut
-
 1;
 
 =back
@@ -625,6 +739,33 @@ class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
    print \"\\$h->set_verbose is available\\n\";
  }
 
+Perl does not offer a way to list the arguments of a method, and
+from time to time we may add extra arguments to calls that take
+optional arguments.  For this reason, we provide a global hash
+variable C<%%guestfs_introspection> which contains the arguments
+and their types for each libguestfs method.  The keys of this
+hash are the method names, and the values are an hashref
+containing useful introspection information about the method
+(further fields may be added to this in future).
+
+ use Sys::Guestfs;
+ $Sys::Guestfs::guestfs_introspection{mkfs_opts}
+ => {
+    ret => 'void',                    # return type
+    args => [                         # required arguments
+      [ 'fstype', 'string', 0 ],
+      [ 'device', 'string(device)', 1 ],
+    ],
+    optargs => {                      # optional arguments
+      blocksize => [ 'blocksize', 'int', 0 ],
+      features => [ 'features', 'string', 1 ],
+      inode => [ 'inode', 'int', 2 ],
+      sectorsize => [ 'sectorsize', 'int', 3 ],
+    },
+    name => \"mkfs_opts\",
+    description => \"make a filesystem\",
+  }
+
 To test if particular features are supported by the current
 build, use the L</available> method like the example below.  Note
 that the appliance must be launched first.
@@ -675,8 +816,8 @@ L<Sys::Guestfs::Lib(3)>.
 =cut
 " copyright_years
 
-and generate_perl_prototype name style =
-  (match fst style with
+and generate_perl_prototype name (ret, args, optargs) =
+  (match ret with
    | RErr -> ()
    | RBool n
    | RInt n
@@ -699,9 +840,16 @@ and generate_perl_prototype name style =
       match arg with
       | Pathname n | Device n | Dev_or_Path n | String n
       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
-      | BufferIn n | Key n ->
+      | BufferIn n | Key n | Pointer (_, n) ->
           pr "$%s" n
       | StringList n | DeviceList n ->
           pr "\\@%s" n
-  ) (snd style);
+  ) args;
+  List.iter (
+    fun arg ->
+      if !comma then pr " [, " else pr "[";
+      comma := true;
+      let n = name_of_argt arg in
+      pr "%s => $%s]" n n
+  ) optargs;
   pr ");"