From 360e556e55d13aaf603f92eb82e68e3d39b67a5e Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 27 Oct 2011 17:40:31 +0100 Subject: [PATCH] perl: Add %guestfs_introspection hash with introspection information. --- generator/generator_perl.ml | 98 ++++++++++++++++++++++++++++++++++++++++++- perl/t/900-introspection.t | 34 +++++++++++++++ 2 files changed, 130 insertions(+), 2 deletions(-) create mode 100644 perl/t/900-introspection.t diff --git a/generator/generator_perl.ml b/generator/generator_perl.ml index d24e775..e34fd3c 100644 --- a/generator/generator_perl.ml +++ b/generator/generator_perl.ml @@ -669,6 +669,11 @@ $VERSION = '0.%d'; require XSLoader; XSLoader::load ('Sys::Guestfs'); +require Exporter; + +use vars qw(@EXPORT_OK); +@EXPORT_OK = qw(%%guestfs_introspection); + " max_proc_nr; (* Methods. *) @@ -810,10 +815,74 @@ 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 p optional = function + | Pathname n -> + pr " [ '%s', 'string(path)', %d ],\n" n optional + | Device n -> + pr " [ '%s', 'string(device)', %d ],\n" n optional + | Dev_or_Path n -> + pr " [ '%s', 'string(dev_or_path)', %d ],\n" n optional + | String n -> + pr " [ '%s', 'string', %d ],\n" n optional + | FileIn n -> + pr " [ '%s', 'string(filename)', %d ],\n" n optional + | FileOut n -> + pr " [ '%s', 'string(filename)', %d ],\n" n optional + | Key n -> + pr " [ '%s', 'string(key)', %d ],\n" n optional + | BufferIn n -> + pr " [ '%s', 'buffer', %d ],\n" n optional + | OptString n -> + pr " [ '%s', 'nullable string', %d ],\n" n optional + | StringList n -> + pr " [ '%s', 'string list', %d ],\n" n optional + | DeviceList n -> + pr " [ '%s', 'string(device) list', %d ],\n" n optional + | Bool n -> + pr " [ '%s', 'bool', %d ],\n" n optional + | Int n -> + pr " [ '%s', 'int', %d ],\n" n optional + | Int64 n -> + pr " [ '%s', 'int64', %d ],\n" n optional + | Pointer (t, n) -> + pr " [ '%s', 'pointer(%s)', %d ],\n" n t optional + in + pr " args => [\n"; + List.iter (p 0) args; + List.iter (p 1) 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 +904,31 @@ class, use the ordinary Perl UNIVERSAL method C 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 qw(%%guestfs_introspection); + $Sys::Guestfs::guestfs_introspection{mkfs_opts} + => { + ret => 'void', # return type + args => [ + [ 'fstype', 'string', 0 ], # required arguments + [ 'device', 'string(device)', 0 ], + [ 'blocksize', 'int', 1 ], # optional arguments + [ 'features', 'string', 1 ], + [ 'inode', 'int', 1 ], + [ 'sectorsize', 'int', 1 ], + ], + name => \"mkfs_opts\", + description => \"make a filesystem\", + } + To test if particular features are supported by the current build, use the L 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 0000000..8c17023 --- /dev/null +++ b/perl/t/900-introspection.t @@ -0,0 +1,34 @@ +# 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 => 5; + +use Errno; + +use Sys::Guestfs qw(%guestfs_introspection); + +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); -- 1.7.6