X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=generator%2Fgenerator_perl.ml;h=8418f865a7b132d988a844e2d1970ff433cfeec1;hp=c8324693d3d2d9ce01401f63619a84b55f0ae737;hb=0a7b734d2f54d4e98882532da9887feb66c9824a;hpb=883390fb2e8cdaf81223eb41c87f245571e3d63d diff --git a/generator/generator_perl.ml b/generator/generator_perl.ml index c832469..8418f86 100644 --- a/generator/generator_perl.ml +++ b/generator/generator_perl.ml @@ -181,6 +181,7 @@ _close_handle (guestfs_h *g) for (i = 0; i < len; ++i) SvREFCNT_dec (cbs[i]); + free (cbs); } MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs @@ -256,11 +257,15 @@ delete_event_callback (g, event_handle) int event_handle; PREINIT: char key[64]; + SV *cb; CODE: snprintf (key, sizeof key, \"_perl_event_%%d\", event_handle); - guestfs_set_private (g, key, NULL); - - guestfs_delete_event_callback (g, event_handle); + cb = guestfs_get_private (g, key); + if (cb) { + SvREFCNT_dec (cb); + guestfs_set_private (g, key, NULL); + guestfs_delete_event_callback (g, event_handle); + } SV * last_errno (g) @@ -273,6 +278,12 @@ PREINIT: OUTPUT: RETVAL +void +user_cancel (g) + guestfs_h *g; + PPCODE: + guestfs_user_cancel (g); + "; List.iter ( @@ -401,16 +412,15 @@ PREINIT: pr " "; List.iter ( fun argt -> - let n = name_of_argt argt in + let n = name_of_optargt 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 + | OBool _ + | OInt _ + | OInt64 _ -> pr "SvIV (ST (items_i+1))" + | OString _ -> pr "SvPV_nolen (ST (items_i+1))" ); pr ";\n"; pr " this_mask = GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n; @@ -772,6 +782,11 @@ errnos: # mkdir failed because the directory exists already. } +=item $h->user_cancel (); + +Cancel current transfer. This is safe to call from Perl signal +handlers and threads. + =cut "; @@ -789,18 +804,77 @@ errnos: pr "%s\n\n" longdesc; if List.mem ProtocolLimitWarning flags then pr "%s\n\n" protocol_limit_warning; - if List.mem DangerWillRobinson flags then - pr "%s\n\n" danger_will_robinson; match deprecation_notice flags with | None -> () | Some txt -> pr "%s\n\n" txt ) ) 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" + ) (args_of_optargs 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 @@ -822,6 +896,33 @@ 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; + $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 method like the example below. Note that the appliance must be launched first. @@ -905,7 +1006,7 @@ and generate_perl_prototype name (ret, args, optargs) = fun arg -> if !comma then pr " [, " else pr "["; comma := true; - let n = name_of_argt arg in + let n = name_of_optargt arg in pr "%s => $%s]" n n ) optargs; pr ");"