From 2be22bab99983d4330b300725d197f08f87a4997 Mon Sep 17 00:00:00 2001
From: Daniel Ruoso <daniel@ruoso.com>
Date: Tue, 12 Jan 2010 12:05:06 -0300
Subject: [PATCH] remove CLONE_SKIP frmo Event and Surface, but associates the
 object with the interpreter which owns it so it only gets destroyed once...
 seems to work, but needs more testing...

---
 lib/SDL/Event.pm            |  2 +-
 lib/SDL/Surface.pm          |  2 +-
 src/Core/objects/Event.xs   | 33 +++++++++++++++++++++------------
 src/Core/objects/Surface.xs | 19 +++++++++++++++----
 typemap                     | 20 ++++++++++++--------
 5 files changed, 50 insertions(+), 26 deletions(-)

diff --git a/lib/SDL/Event.pm b/lib/SDL/Event.pm
index ad9085b7..05b52cb9 100644
--- a/lib/SDL/Event.pm
+++ b/lib/SDL/Event.pm
@@ -5,5 +5,5 @@ require Exporter;
 require DynaLoader;
 our @ISA = qw(Exporter DynaLoader);
 bootstrap SDL::Event;
-sub CLONE_SKIP { 1 };
+#sub CLONE_SKIP { 1 };
 1;
diff --git a/lib/SDL/Surface.pm b/lib/SDL/Surface.pm
index cbb1445a..e87ae0d6 100644
--- a/lib/SDL/Surface.pm
+++ b/lib/SDL/Surface.pm
@@ -5,5 +5,5 @@ require Exporter;
 require DynaLoader;
 our @ISA = qw(Exporter DynaLoader);
 bootstrap SDL::Surface;
-sub CLONE_SKIP { 1 };
+#sub CLONE_SKIP { 1 };
 1;
diff --git a/src/Core/objects/Event.xs b/src/Core/objects/Event.xs
index 819287f5..26922092 100644
--- a/src/Core/objects/Event.xs
+++ b/src/Core/objects/Event.xs
@@ -963,17 +963,26 @@ event_syswm_msg ( event, ... )
 		RETVAL
 
 void
-event_DESTROY(self)
-	SDL_Event *self
+event_DESTROY(bag)
+	SV* bag
 	CODE:
-		if(self->type == SDL_USEREVENT)
-		{
-		if( (self->user).data1 != NULL )
-		  SvREFCNT_dec( (self->user).data1);
-		if( (self->user).data2 != NULL )
-		  SvREFCNT_dec( (self->user).data2);
-		}
-		safefree(self);
-
-
+               if( sv_isobject(bag) && (SvTYPE(SvRV(bag)) == SVt_PVMG) ) {
+                   void** pointers = (void**)(SvIV((SV*)SvRV( bag ))); 
+                   SDL_Event* self = (SDL_Event*)(pointers[0]);
+                   if (my_perl == pointers[1]) {
+                       //warn("Freed surface %p and pixels %p \n", surface, surface->pixels);
+                       if(self->type == SDL_USEREVENT) {
+                           if( (self->user).data1 != NULL )
+                              SvREFCNT_dec( (self->user).data1);
+                           if( (self->user).data2 != NULL )
+                              SvREFCNT_dec( (self->user).data2);
+                       }
+                       safefree(self);
+                       free(pointers);
+                   }
+               } else if (bag == 0) {
+                   XSRETURN(0);
+               } else {
+                   XSRETURN_UNDEF;
+               }
 		
diff --git a/src/Core/objects/Surface.xs b/src/Core/objects/Surface.xs
index ac21ed87..c8424dca 100644
--- a/src/Core/objects/Surface.xs
+++ b/src/Core/objects/Surface.xs
@@ -144,9 +144,20 @@ surface_set_pixels(surface, index, value)
 	((unsigned int*)surface->pixels)[index] = value;
 
 void
-surface_DESTROY(surface)
-	SDL_Surface *surface
+surface_DESTROY(bag)
+	SV* bag
 	CODE:
-		//warn("Freed surface %p and pixels %p \n", surface, surface->pixels);
-		SDL_FreeSurface(surface);
+               if( sv_isobject(bag) && (SvTYPE(SvRV(bag)) == SVt_PVMG) ) {
+                   void** pointers = (void**)(SvIV((SV*)SvRV( bag ))); 
+                   SDL_Surface* surface = (SDL_Surface*)(pointers[0]);
+                   if (my_perl == pointers[1]) {
+                       //warn("Freed surface %p and pixels %p \n", surface, surface->pixels);
+                       SDL_FreeSurface(surface);
+                       free(pointers);
+                   }
+               } else if (bag == 0) {
+                   XSRETURN(0);
+               } else {
+                   XSRETURN_UNDEF;
+               }
 		
diff --git a/typemap b/typemap
index 9309bd43..c2f93f2f 100644
--- a/typemap
+++ b/typemap
@@ -102,18 +102,22 @@ OUTPUT
 # The Perl object is blessed into 'CLASS', which should be a
 # char* having the name of the package for the blessing.
 O_OBJECT
-	sv_setref_pv( $arg, CLASS, (void*)$var );
+        void** pointers = malloc(2 * sizeof(void*));
+        pointers[0] = (void*)$var;
+        pointers[1] = (void*)my_perl;
+	sv_setref_pv( $arg, CLASS, (void*)pointers );
 
 
 INPUT
 
 O_OBJECT
-	if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
-		{ $var = ($type)SvIV((SV*)SvRV( $arg )); }
-	else if ($arg == 0)
-	{ XSRETURN(0); }
-	else{
-		XSRETURN_UNDEF;
-	}
+	if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) ) {
+           void** pointers = (void**)(SvIV((SV*)SvRV( $arg ))); 
+           $var = ($type)(pointers[0]);
+        } else if ($arg == 0) {
+           XSRETURN(0);
+        } else {
+           XSRETURN_UNDEF;
+        }