From eb566f7dc7974b42ac65729a2e5e5bcee329a0a9 Mon Sep 17 00:00:00 2001
From: Richard Jones <rjones@redhat.com>
Date: Thu, 10 Jun 2010 15:25:43 +0100
Subject: 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.
---
 perl/t/800-explicit-close.t | 51 +++++++++++++++++++++++++++++++++++++++++++++
 perl/typemap                | 17 +++++++++------
 2 files changed, 62 insertions(+), 6 deletions(-)
 create mode 100644 perl/t/800-explicit-close.t

(limited to 'perl')

diff --git a/perl/t/800-explicit-close.t b/perl/t/800-explicit-close.t
new file mode 100644
index 00000000..81851680
--- /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 752ca0d7..d978e601 100644
--- 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));
-- 
cgit