diff options
| -rw-r--r-- | generator/generator_perl.ml | 92 | ||||
| -rw-r--r-- | perl/t/900-introspection.t | 42 |
2 files changed, 132 insertions, 2 deletions
diff --git a/generator/generator_perl.ml b/generator/generator_perl.ml index d24e775f..c9ec4fb3 100644 --- a/generator/generator_perl.ml +++ b/generator/generator_perl.ml @@ -810,10 +810,71 @@ handlers and threads. ) ) 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 @@ -835,6 +896,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. diff --git a/perl/t/900-introspection.t b/perl/t/900-introspection.t new file mode 100644 index 00000000..6defc9be --- /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"); |