From: Tony Cook <tony@develop-help.com>
Date: Sat, 29 Mar 2014 01:59:14 +0000 (+1100)
Subject: allow Imager::IO->new_buffer() to accept a reference
X-Git-Tag: v0.99~17
X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/a87997b2f901c06ea67e73d89558aa376f64019b

allow Imager::IO->new_buffer() to accept a reference

and always make a copy of the buffer
---

diff --git a/Imager.xs b/Imager.xs
index 216bfb48..ac804344 100644
--- a/Imager.xs
+++ b/Imager.xs
@@ -234,9 +234,9 @@ static int getobj(void *hv_t,char *key,char *type,void **store) {
 
 UTIL_table_t i_UTIL_table={getstr,getint,getdouble,getvoid,getobj};
 
-void my_SvREFCNT_dec(void *p) {
-  dTHX;
-  SvREFCNT_dec((SV*)p);
+static void
+free_buffer(void *p) {
+  myfree(p);
 }
 
 
@@ -447,14 +447,41 @@ static void io_destroyer(void *p) {
   myfree(cbd);
 }
 
+static bool
+im_SvREFSCALAR(SV *sv) {
+  svtype type = SvTYPE(sv);
+  return type == SVt_PV || type == SVt_PVIV || type == SVt_PVNV
+      || type == SVt_PVMG || type == SVt_IV || type == SVt_NV
+      || type == SVt_PVLV || type == SVt_REGEXP;
+}
+
 static i_io_glue_t *
 do_io_new_buffer(pTHX_ SV *data_sv) {
   const char *data;
+  char *data_copy;
   STRLEN length;
+  SV *sv;
 
-  data = SvPVbyte(data_sv, length);
-  SvREFCNT_inc(data_sv);
-  return io_new_buffer(data, length, my_SvREFCNT_dec, data_sv);
+  SvGETMAGIC(data_sv);
+  if (SvROK(data_sv)) {
+    if (im_SvREFSCALAR(data_sv)) {
+      sv = SvRV(data_sv);
+    }
+    else {
+      i_push_error(0, "data is not a scalar or a reference to scalar");
+      return NULL;
+    }
+  }
+  else {
+    sv = data_sv;
+  }
+
+  /* previously this would keep the SV around, but this is unsafe in
+     many ways, so always copy the bytes */
+  data = SvPVbyte(sv, length);
+  data_copy = mymalloc(length);
+  memcpy(data_copy, data, length);
+  return io_new_buffer(data_copy, length, free_buffer, data_copy);
 }
 
 static const char *
@@ -1106,7 +1133,10 @@ Imager::IO
 io_new_buffer(data_sv)
 	  SV   *data_sv
 	CODE:
+	  i_clear_error();
 	  RETVAL = do_io_new_buffer(aTHX_ data_sv);
+	  if (!RETVAL)
+	    XSRETURN(0);
         OUTPUT:
           RETVAL
 
@@ -1177,7 +1207,10 @@ Imager::IO
 io_new_buffer(class, data_sv)
 	SV *data_sv
     CODE:
+        i_clear_error();
         RETVAL = do_io_new_buffer(aTHX_ data_sv);
+	if (!RETVAL)
+	  XSRETURN(0);
     OUTPUT:
         RETVAL
 
diff --git a/t/200-file/010-iolayer.t b/t/200-file/010-iolayer.t
index feca1a19..bc77159d 100644
--- a/t/200-file/010-iolayer.t
+++ b/t/200-file/010-iolayer.t
@@ -1,6 +1,6 @@
 #!perl -w
 use strict;
-use Test::More tests => 274;
+use Test::More tests => 275;
 use Imager::Test qw(is_image);
 # for SEEK_SET etc, Fcntl doesn't provide these in 5.005_03
 use IO::Seekable;
@@ -890,6 +890,15 @@ SKIP:
   is(tied(*FOO)->[0], "temore", "tied: check it got to the output properly");
 }
 
+{ # pass buffer by reference
+  my $data = "This is a test";
+  my $data2 = $data;
+  my $io = Imager::IO->new_buffer(\$data2);
+  undef $data2;
+  my $tmp = $io->read2(1000);
+  is($tmp, $data, "buffer io created by reference");
+}
+
 Imager->close_log;
 
 unless ($ENV{IMAGER_KEEP_FILES}) {