]> git.imager.perl.org - imager.git/commitdiff
allow Imager::IO->new_buffer() to accept a reference
authorTony Cook <tony@develop-help.com>
Sat, 29 Mar 2014 01:59:14 +0000 (12:59 +1100)
committerTony Cook <tony@develop-help.com>
Sat, 29 Mar 2014 01:59:14 +0000 (12:59 +1100)
and always make a copy of the buffer

Imager.xs
t/200-file/010-iolayer.t

index 216bfb4813bc3aa6bba969ff9d7096d6581fd8f1..ac8043449e3a9b6d219775ce9dbb594b45fbc2fa 100644 (file)
--- 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
 
index feca1a198f1feca19e1d67ef6d97744432b8bffd..bc77159dfdb93cc45e7d4865969dda6c66c40554 100644 (file)
@@ -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}) {