perl: Add explicit close() method (RHBZ#602592).

This add an optional explicit $g->close method which may be
used to force the handle to be closed immediately.  Note the
provisos about this method in the manual page entry.  Callers
should *not* normally use this method.

The implementation of the handle also changes.  Before, the
handle was a blessed reference to an integer (the integer
being the pointer to the C guestfs_h handle).  Now we change
this to a hashref containing currently the following field:

  _g => pointer to C guestfs_h handle (as an integer)

If this field is not present, it means that the handle has been
explicitly closed.  This avoids double-freeing the handle.

The user may add their own fields to this hash in order to store
per-handle data.  However any fields whose names begin with
an underscore are reserved for use by the Perl bindings.

This commit also adds a regression test.

This commit also changes the existing warning when you call
a method without a Sys::Guestfs handle as the first parameter,
into an error.  This is because such cases are always errors.

diff --git a/perl/t/800-explicit-close.t b/perl/t/800-explicit-close.t
new file mode 100644 (file)
index 0000000..8185168
--- /dev/null
+++ b/perl/t/800-explicit-close.t
@@ -0,0 +1,51 @@
+# libguestfs Perl bindings -*- perl -*-
+# Copyright (C) 2010 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 implicit vs explicit closes of the handle (RHBZ#602592).
+
+use strict;
+use warnings;
+use Test::More tests => 10;
+
+use Sys::Guestfs;
+
+my $g;
+
+$g = Sys::Guestfs->new ();
+ok($g);
+$g->close ();                   # explicit close
+ok($g);
+undef $g;                       # implicit close - should be no error/warning
+ok(1);
+
+# Expect an error if we call a method on a closed handle.
+$g = Sys::Guestfs->new ();
+ok($g);
+$g->close ();
+ok($g);
+eval { $g->set_memsize (512); };
+ok($g);
+ok($@ && $@ =~ /closed handle/);
+undef $g;
+ok(1);
+
+# Try calling a method without a blessed reference.  This should
+# give a different error.
+eval { Sys::Guestfs::set_memsize (undef, 512); };
+ok ($@ && $@ =~ /not.*blessed/);
+eval { Sys::Guestfs::set_memsize (42, 512); };
+ok ($@ && $@ =~ /not.*blessed/);

diff --git a/perl/typemap b/perl/typemap
index 752ca0d..d978e60 100644 (file)
--- a/perl/typemap
+++ b/perl/typemap
@@ -6,13 +6,18 @@ int64_t               T_IV
 
 INPUT
 O_OBJECT_guestfs_h
-    if (sv_isobject ($arg) && SvTYPE (SvRV ($arg)) == SVt_PVMG)
-        $var = ($type) SvIV ((SV *) SvRV ($arg));
-    else {
-        warn (\"${Package}::$func_name(): $var is not a blessed SV reference\");
-        XSRETURN_UNDEF;
+    if (sv_isobject ($arg) && sv_derived_from ($arg, \"Sys::Guestfs\") &&
+        SvTYPE ($arg) == SVt_RV &&
+        SvTYPE (SvRV ($arg)) == SVt_PVHV) {
+        HV *hv = (HV *) SvRV ($arg);
+        SV **svp = hv_fetch (hv, \"_g\", 2, 0);
+        if (svp == NULL)
+            croak (\"${Package}::$func_name(): called on a closed handle\");
+        $var = ($type) SvIV (*svp);
+    } else {
+        croak (\"${Package}::$func_name(): $var is not a blessed HV reference\");
     }
 
 OUTPUT
 O_OBJECT_guestfs_h
-    sv_setref_pv ($arg, "Sys::Guestfs", (void *) $var);
+    sv_setiv ($arg, PTR2IV ($var));

diff --git a/src/generator.ml b/src/generator.ml
index cf28978..571870d 100755 (executable)
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -8821,10 +8821,30 @@ _create ()
       RETVAL
 
 void
-DESTROY (g)
+DESTROY (sv)
+      SV *sv;
+ PPCODE:
+      /* For the 'g' argument above we do the conversion explicitly and
+       * don't rely on the typemap, because if the handle has been
+       * explicitly closed we don't want the typemap conversion to
+       * display an error.
+       */
+      HV *hv = (HV *) SvRV (sv);
+      SV **svp = hv_fetch (hv, \"_g\", 2, 0);
+      if (svp != NULL) {
+        guestfs_h *g = (guestfs_h *) SvIV (*svp);
+        assert (g != NULL);
+        guestfs_close (g);
+      }
+
+void
+close (g)
       guestfs_h *g;
  PPCODE:
       guestfs_close (g);
+      /* Avoid double-free in DESTROY method. */
+      HV *hv = (HV *) SvRV (ST(0));
+      (void) hv_delete (hv, \"_g\", 2, G_DISCARD);
 
 ";
 
@@ -9179,11 +9199,28 @@ sub new {
   my $proto = shift;
   my $class = ref ($proto) || $proto;
 
-  my $self = Sys::Guestfs::_create ();
+  my $g = Sys::Guestfs::_create ();
+  my $self = { _g => $g };
   bless $self, $class;
   return $self;
 }
 
+=item $h->close ();
+
+Explicitly close the guestfs handle.
+
+B<Note:> You should not usually call this function.  The handle will
+be closed implicitly when its reference count goes to zero (eg.
+when it goes out of scope or the program ends).  This call is
+only required in some exceptional cases, such as where the program
+may contain cached references to the handle 'somewhere' and you
+really have to have the close happen right away.  After calling
+C<close> the program must not call any method (including C<close>)
+on the handle (but the implicit call to C<DESTROY> that happens
+when the final reference is cleaned up is OK).
+
+=cut
+
 " max_proc_nr;
 
   (* Actions.  We only need to print documentation for these as