X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=generator%2Fgenerator_perl.ml;h=c9ec4fb31368916cd317775ed145197b88103f0a;hb=d1ee71782ace98a11c5aabaf1f9fd5f601e08367;hp=09bf20ff74a723adff8d9ba1a457d5e195fd9825;hpb=bc468c87d04b34faacd208c49cca4a5096e5103c;p=libguestfs.git

diff --git a/generator/generator_perl.ml b/generator/generator_perl.ml
index 09bf20f..c9ec4fb 100644
--- a/generator/generator_perl.ml
+++ b/generator/generator_perl.ml
@@ -256,11 +256,32 @@ 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);
+      cb = guestfs_get_private (g, key);
+      if (cb) {
+        SvREFCNT_dec (cb);
+        guestfs_set_private (g, key, NULL);
+        guestfs_delete_event_callback (g, event_handle);
+      }
 
-      guestfs_delete_event_callback (g, event_handle);
+SV *
+last_errno (g)
+      guestfs_h *g;
+PREINIT:
+      int errnum;
+   CODE:
+      errnum = guestfs_last_errno (g);
+      RETVAL = newSViv (errnum);
+ OUTPUT:
+      RETVAL
+
+void
+user_cancel (g)
+      guestfs_h *g;
+ PPCODE:
+      guestfs_user_cancel (g);
 
 ";
 
@@ -625,6 +646,9 @@ with libvirt.
 
 All errors turn into calls to C<croak> (see L<Carp(3)>).
 
+The error string from libguestfs is directly available from
+C<$@>.  Use the C<last_errno> method if you want to get the errno.
+
 =head1 METHODS
 
 =over 4
@@ -738,6 +762,31 @@ this function.
 This removes the callback which was previously registered using
 C<set_event_callback>.
 
+=item $errnum = $h->last_errno ();
+
+This returns the last error number (errno) that happened on the
+handle C<$h>.
+
+If successful, an errno integer not equal to zero is returned.
+
+If no error number is available, this returns 0.
+See L<guestfs(3)/guestfs_last_errno> for more details of why
+this can happen.
+
+You can use the standard Perl module L<Errno(3)> to compare
+the numeric error returned from this call with symbolic
+errnos:
+
+ $h->mkdir (\"/foo\");
+ if ($h->last_errno() == Errno::EEXIST()) {
+   # 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
 
 ";
@@ -755,18 +804,77 @@ C<set_event_callback>.
         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"
+        ) 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
@@ -788,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.