[perl-Gtk2] Gtk2::Gdk::Pixbuf->new_from_data(): accept overloaded strings

[Torsten SchÃnfeld <tsch src gnome org>]

commit a0f31d57b7ebc24c8ae5502c8156bba101ac2e71
Author: Kevin Ryde <user42 zip com au>
Date:   Thu Aug 18 00:09:55 2011 +0200

    Gtk2::Gdk::Pixbuf->new_from_data(): accept overloaded strings
    
    Simply stringize the data with SvPV to allow overload or magic inputs the same
    as in other contexts.
    
    Also, copy the data to a plain malloced block rather than having the pixbuf
    point into an SV.
    
    https://bugzilla.gnome.org/show_bug.cgi?id=639558

 t/GdkPixbuf.t   |   26 +++++++++++++++++++++++++-
 xs/GdkPixbuf.xs |   21 ++++++++++-----------
 2 files changed, 35 insertions(+), 12 deletions(-)
---
diff --git a/t/GdkPixbuf.t b/t/GdkPixbuf.t
index 5cdc459..f00f938 100644
--- a/t/GdkPixbuf.t
+++ b/t/GdkPixbuf.t
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Gtk2::TestHelper tests => 111, noinit => 1;
+use Gtk2::TestHelper tests => 112, noinit => 1;
 
 my $show = 0;
 
@@ -144,6 +144,30 @@ is ($pixbuf->get_height, 5);
 is ($pixbuf->get_rowstride, 16);
 $vbox->add (Gtk2::Image->new_from_pixbuf ($pixbuf)) if $show;
 
+{
+  {
+    package MyOverloaded;
+    use overload '""' => \&stringize;
+    sub new {
+      my ($class) = @_;
+      my $str = "not this value";
+      return bless \$str, $class;
+    }
+    sub stringize {
+      my ($self) = @_;
+      return "\x01\x02\x03";
+    }
+  }
+  my $overloaded = MyOverloaded->new;
+  $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($overloaded, 'rgb',
+					      0,   # alpha
+					      8,   # bits
+					      1,1, # width,height
+					      3);  # rowstride
+  is ($pixbuf->get_pixels, "\x01\x02\x03");
+  $vbox->add (Gtk2::Image->new_from_pixbuf ($pixbuf)) if $show;
+}
+
 # inlined data from gdk-pixbuf-csource, run on the xpm from above
 my $inlinedata =
   "GdkP" # Pixbuf magic (0x47646b50)
diff --git a/xs/GdkPixbuf.xs b/xs/GdkPixbuf.xs
index abfea7c..d39ef93 100644
--- a/xs/GdkPixbuf.xs
+++ b/xs/GdkPixbuf.xs
@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2003-2008, 2010 by the gtk2-perl team (see the file AUTHORS)
+ * Copyright (c) 2003-2008, 2010, 2011 by the gtk2-perl team (see the file AUTHORS)
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Library General Public
@@ -26,9 +26,8 @@ static void
 gtk2perl_pixbuf_destroy_notify (guchar * pixels,
                                 gpointer data)
 {
-	PERL_UNUSED_VAR (pixels);
-
-	gperl_sv_free ((SV*)data);
+	PERL_UNUSED_VAR (data);
+	Safefree (pixels);
 }
 
 #if GTK_CHECK_VERSION (2, 2, 0)
@@ -487,18 +486,18 @@ gdk_pixbuf_new_from_data (class, data, colorspace, has_alpha, bits_per_sample, w
 	int height
 	int rowstride
     PREINIT:
-	SV * real_data;
+	char *data_ptr, *pix_ptr;
+	STRLEN len;
     CODE:
-	if (!gperl_sv_is_defined (data) || !SvPOK (data))
-		croak ("expecting a packed string for pixel data");
-	real_data = gperl_sv_copy (data);
-	RETVAL = gdk_pixbuf_new_from_data ((const guchar *)
-	                                     SvPV_nolen (real_data),
+	data_ptr = SvPV (data, len);
+	pix_ptr = Newx (pix_ptr, len, char);
+	Copy (data_ptr, pix_ptr, len, char);
+	RETVAL = gdk_pixbuf_new_from_data ((const guchar *) pix_ptr,
 	                                   colorspace, has_alpha,
 					   bits_per_sample,
 					   width, height, rowstride,
 					   gtk2perl_pixbuf_destroy_notify,
-					   real_data);
+					   NULL);
     OUTPUT:
 	RETVAL