From: Kartik Thakore <thakore.kartik@gmail.com>
Date: Fri, 4 Sep 2009 20:57:02 +0000 (-0400)
Subject: No memleaks and faster blessing as a perl obj. For rect
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7c86a28af42b8341d2406d9c342c5f287ed225c5;p=sdlgit%2FSDL_perl.git

No memleaks and faster blessing as a perl obj. For rect
---

diff --git a/exp/SDL/Rect/Build.PL b/exp/SDL/Rect/Build.PL
deleted file mode 100644
index 11f0176..0000000
--- a/exp/SDL/Rect/Build.PL
+++ /dev/null
@@ -1,24 +0,0 @@
-use Module::Build;
-# See perldoc Module::Build for details of how this works
-
-Module::Build->new
-    ( module_name     => 'SDL::Rect',
-      license         => 'perl',
-     	build_requires       =>
-	{
-		'Test::Simple' => '0.47',
-		'Module::Build' => '0.22',
-		'YAML'	=> '0.68',
-		'Alien::SDL'    => '0.02',
-		'ExtUtils::CBuilder' => '0.260301'
-	},
-	build_recommends     =>
-	{
-		'Pod::ToDemo'  => '0.20'		
-	},
-	xs_files             => {'src/Rect.xs' => 'lib/SDL/Rect.xs'},
-	extra_compiler_flags => scalar `sdl-config --cflags`,
-	extra_linker_flags  =>  scalar `sdl-config --libs`,
-	dist_author	     => 'Kartik Thakore <KTHAKORE@cpan.org>',
-
-    )->create_build_script;
diff --git a/exp/SDL/Rect/Makefile.PL b/exp/SDL/Rect/Makefile.PL
index ad12cdb..9b4c76f 100644
--- a/exp/SDL/Rect/Makefile.PL
+++ b/exp/SDL/Rect/Makefile.PL
@@ -1,27 +1,13 @@
-unless (eval "use Module::Build::Compat 0.02; 1" ) {
-  print "This module requires Module::Build to install itself.\n";
-
-  require ExtUtils::MakeMaker;
-  my $yn = ExtUtils::MakeMaker::prompt
-    ('  Install Module::Build from CPAN?', 'y');
-
-  if ($yn =~ /^y/i) {
-    require Cwd;
-    require File::Spec;
-    require CPAN;
-
-    # Save this 'cause CPAN will chdir all over the place.
-    my $cwd = Cwd::cwd();
-    my $makefile = File::Spec->rel2abs($0);
-
-    CPAN::Shell->install('Module::Build::Compat');
-
-    chdir $cwd or die "Cannot chdir() back to $cwd: $!";
-    exec $^X, $makefile, @ARGV;  # Redo now that we have Module::Build
-  } else {
-    warn " *** Cannot install without Module::Build.  Exiting ...\n";
-    exit 1;
-  }
-}
-Module::Build::Compat->run_build_pl(args => \@ARGV);
-Module::Build::Compat->write_makefile();
+use ExtUtils::MakeMaker;
+$Verbose = 1;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'	=> 'SDL::Rect',
+    'VERSION_FROM' => 'Rect.pm', # finds $VERSION
+    'LIBS'	=> scalar `sdl-config --libs`,   # e.g., '-lm' 
+    'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' 
+    'INC'	=> scalar `sdl-config --cflags`,     # e.g., '-I/usr/include/other' 
+    'XSPROTOARG'	=> '-noprototypes',
+    'TYPEMAPS'	=> ['perlobject.map' ],
+);
diff --git a/exp/SDL/Rect/lib/SDL/Rect.pm b/exp/SDL/Rect/lib/SDL/Rect.pm
deleted file mode 100644
index 77cd108..0000000
--- a/exp/SDL/Rect/lib/SDL/Rect.pm
+++ /dev/null
@@ -1,105 +0,0 @@
-package SDL::Rect;
-use strict;
-
-
-    use vars qw($VERSION @ISA);
-    $VERSION     = '0.01';
-    require DynaLoader;
-    @ISA = qw(DynaLoader);
-    
-    
-   
-
-
-#################### subroutine header begin ####################
-
-=head2 sample_function
-
- Usage     : How to use this function/method
- Purpose   : What it does
- Returns   : What it returns
- Argument  : What it wants to know
- Throws    : Exceptions and other anomolies
- Comment   : This is a sample subroutine header.
-           : It is polite to include more pod and fewer comments.
-
-See Also   : 
-
-=cut
-
-#################### subroutine header end ####################
-
-sub new
-{
-	my $self = shift;
-	my ($x, $y, $w, $h) = @_;
-	$self = \SDL::Rect::NewRect($x, $y, $w, $h);
-
-	return $self;
-}
-
-#################### main pod documentation begin ###################
-## Below is the stub of documentation for your module. 
-## You better edit it!
-
-
-=head1 NAME
-
-SDL::Rect - Bindings to rect obj and its functions in the C SDL libs
-
-=head1 SYNOPSIS
-
-  use SDL::Rect;
-  blah blah blah
-
-
-=head1 DESCRIPTION
-
-Stub documentation for this module was created by ExtUtils::ModuleMaker.
-It looks like the author of the extension was negligent enough
-to leave the stub unedited.
-
-Blah blah blah.
-
-
-=head1 USAGE
-
-
-
-=head1 BUGS
-
-
-
-=head1 SUPPORT
-
-
-
-=head1 AUTHOR
-
-    Kartik Thakore
-    CPAN ID: KTHAKORE
-    none
-    KTHAKORE@CPAN.ORG
-    http://yapgh.blogspot.com/
-
-=head1 COPYRIGHT
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-
-=head1 SEE ALSO
-
-perl(1).
-
-=cut
-
-#################### main pod documentation end ###################
-
-bootstrap SDL::Rect; 
-1;
-# The preceding line will help the module return a true value
-
diff --git a/exp/SDL/Rect/perlobject.map b/exp/SDL/Rect/perlobject.map
new file mode 100644
index 0000000..4795c47
--- /dev/null
+++ b/exp/SDL/Rect/perlobject.map
@@ -0,0 +1,106 @@
+# "perlobject.map"  Dean Roehrich, version 19960302
+#
+# TYPEMAPs
+#
+# HV *		-> unblessed Perl HV object.
+# AV *		-> unblessed Perl AV object.
+#
+# INPUT/OUTPUT maps
+#
+# O_*		-> opaque blessed objects
+# T_*		-> opaque blessed or unblessed objects
+#
+# O_OBJECT	-> link an opaque C or C++ object to a blessed Perl object.
+# T_OBJECT	-> link an opaque C or C++ object to an unblessed Perl object.
+# O_HvRV	-> a blessed Perl HV object.
+# T_HvRV	-> an unblessed Perl HV object.
+# O_AvRV	-> a blessed Perl AV object.
+# T_AvRV	-> an unblessed Perl AV object.
+
+TYPEMAP
+
+HV *		T_HvRV
+AV *		T_AvRV
+
+
+######################################################################
+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 );
+
+T_OBJECT
+	sv_setref_pv( $arg, Nullch, (void*)$var );
+
+# Cannot use sv_setref_pv() because that will destroy
+# the HV-ness of the object.  Remember that newRV() will increment
+# the refcount.
+O_HvRV
+	$arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );
+
+T_HvRV
+	$arg = newRV((SV*)$var);
+
+# Cannot use sv_setref_pv() because that will destroy
+# the AV-ness of the object.  Remember that newRV() will increment
+# the refcount.
+O_AvRV
+	$arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );
+
+T_AvRV
+	$arg = newRV((SV*)$var);
+
+
+######################################################################
+INPUT
+
+O_OBJECT
+	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;
+	}
+
+T_OBJECT
+	if( SvROK($arg) )
+		$var = ($type)SvIV((SV*)SvRV( $arg ));
+	else{
+		warn( \"${Package}::$func_name() -- $var is not an SV reference\" );
+		XSRETURN_UNDEF;
+	}
+
+O_HvRV
+	if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )
+		$var = (HV*)SvRV( $arg );
+	else {
+		warn( \"${Package}::$func_name() -- $var is not a blessed HV reference\" );
+		XSRETURN_UNDEF;
+	}
+
+T_HvRV
+	if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )
+		$var = (HV*)SvRV( $arg );
+	else {
+		warn( \"${Package}::$func_name() -- $var is not an HV reference\" );
+		XSRETURN_UNDEF;
+	}
+
+O_AvRV
+	if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )
+		$var = (AV*)SvRV( $arg );
+	else {
+		warn( \"${Package}::$func_name() -- $var is not a blessed AV reference\" );
+		XSRETURN_UNDEF;
+	}
+
+T_AvRV
+	if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )
+		$var = (AV*)SvRV( $arg );
+	else {
+		warn( \"${Package}::$func_name() -- $var is not an AV reference\" );
+		XSRETURN_UNDEF;
+	}
+
diff --git a/exp/SDL/Rect/src/Rect.xs b/exp/SDL/Rect/src/Rect.xs
deleted file mode 100644
index ef2b278..0000000
--- a/exp/SDL/Rect/src/Rect.xs
+++ /dev/null
@@ -1,77 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#ifndef aTHX_
-#define aTHX_
-#endif
-
-#include <SDL.h>
-
-
-
-MODULE = SDL::Rect 	PACKAGE = Rect
-PROTOTYPES: DISABLE
-
-
-SDL_Rect *
-NewRect ( x, y, w, h )
-	Sint16 x
-	Sint16 y
-	Uint16 w
-	Uint16 h
-	CODE:
-		RETVAL = (SDL_Rect *) safemalloc (sizeof(SDL_Rect));
-		RETVAL->x = x;
-		RETVAL->y = y;
-		RETVAL->w = w;
-		RETVAL->h = h;
-	OUTPUT:
-		RETVAL
-
-Sint16
-RectX ( rect, ... )
-	SDL_Rect *rect
-	CODE:
-		if (items > 1 ) rect->x = SvIV(ST(1)); 
-		RETVAL = rect->x;
-	OUTPUT:
-		RETVAL
-
-Sint16
-RectY ( rect, ... )
-	SDL_Rect *rect
-	CODE:
-		if (items > 1 ) rect->y = SvIV(ST(1)); 
-		RETVAL = rect->y;
-	OUTPUT:
-		RETVAL
-
-Uint16
-RectW ( rect, ... )
-	SDL_Rect *rect
-	CODE:
-		if (items > 1 ) rect->w = SvIV(ST(1)); 
-		RETVAL = rect->w;
-	OUTPUT:
-		RETVAL
-
-Uint16
-RectH ( rect, ... )
-	SDL_Rect *rect
-	CODE:
-		if (items > 1 ) rect->h = SvIV(ST(1)); 
-		RETVAL = rect->h;
-	OUTPUT:
-		RETVAL
-
-MODULE = SDL::Rect  PACKAGE = SDL_RectPtr  PREFIX = Rect_
-
-void
-Rect_DESTROY(rect)
-	SDL_Rect *rect
-	CODE:
-	 	printf("RectPtr::DESTROY\n");
-		safefree( rect );
-
-
diff --git a/exp/SDL/Rect/t/001_load.t b/exp/SDL/Rect/t/001_load.t
index f662373..1caed0b 100644
--- a/exp/SDL/Rect/t/001_load.t
+++ b/exp/SDL/Rect/t/001_load.t
@@ -7,7 +7,7 @@ use Test::More tests => 2;
 
 BEGIN { use_ok( 'SDL::Rect' ); }
 
-my $object = SDL::Rect->new(0,0,0,0);
+my $object = SDL::Rect->new();
 isa_ok ($object, 'SDL::Rect');
 
 
diff --git a/exp/SDL/Rect/typemap b/exp/SDL/Rect/typemap
index bbb383f..c01120b 100644
--- a/exp/SDL/Rect/typemap
+++ b/exp/SDL/Rect/typemap
@@ -7,4 +7,4 @@ Sint16                  T_IV
 Sint16 *                T_PTR                                                                       
 Sint32                  T_IV                                                                        
 Sint32 *                T_PTR 
-SDL_Rect *		T_PTROBJ
+SDL_Rect *		O_OBJECT