mirror of
https://github.com/libguestfs/libguestfs.git
synced 2026-03-21 22:53:37 +00:00
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.
This commit is contained in:
@@ -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.
|
||||
|
||||
42
perl/t/900-introspection.t
Normal file
42
perl/t/900-introspection.t
Normal file
@@ -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");
|
||||
Reference in New Issue
Block a user