perl: Add %guestfs_introspection hash with introspection information.

Because this is a useful introspection API, it is a candidate for
being backported into older stable branches.

diff --git a/generator/generator_perl.ml b/generator/generator_perl.ml
index d24e775..c9ec4fb 100644 (file)
--- a/generator/generator_perl.ml
+++ b/generator/generator_perl.ml
@@ -810,10 +810,71 @@ handlers and threads.
       )
   ) all_functions_sorted;
 
       )
   ) 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 "\
   (* End of file. *)
   pr "\

-=cut
-

 1;
 
 =back
 1;
 
 =back


@@ -835,6 +896,33 @@ class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
    print \"\\$h->set_verbose is available\\n\";
  }
 
    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.
 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.

diff --git a/perl/t/900-introspection.t b/perl/t/900-introspection.t
new file mode 100644 (file)
index 0000000..6defc9b
--- /dev/null
+++ b/perl/t/900-introspection.t
@@ -0,0 +1,42 @@
+# libguestfs Perl bindings -*- perl -*-
+# Copyright (C) 2011 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Test %guestfs_introspection.
+
+use strict;
+use warnings;
+use Test::More tests => 10;
+
+use Errno;
+
+use Sys::Guestfs;
+
+my %add_drive = %{$Sys::Guestfs::guestfs_introspection{add_drive}};
+ok(1);
+
+is ($add_drive{ret}, "void");
+is ($add_drive{args}[0][0], "filename");
+is ($add_drive{args}[0][1], "string");
+is ($add_drive{args}[0][2], 0);
+
+my %add_drive_opts = %{$Sys::Guestfs::guestfs_introspection{add_drive_opts}};
+ok(1);
+
+ok (exists $add_drive_opts{optargs});
+ok (exists $add_drive_opts{optargs}->{readonly});
+is ($add_drive_opts{optargs}->{readonly}[0], "readonly");
+is ($add_drive_opts{optargs}->{readonly}[1], "bool");