move the GIF file handling code into a sub-module

Changes

@@ -8,6 +8,10 @@ Imager 0.78 - unreleased
    Thanks to Justin Davis.
    https://rt.cpan.org/Ticket/Display.html?id=60491
 
+ - moved the GIF file handling code into a sub-module in preparation
+   for separate distribution.
+   https://rt.cpan.org/Ticket/Display.html?id=49616 (partial)
+
 Bug fixes:
 
  - Imager::Probe was calling ExtUtils::Liblist to initialize

GIF/GIF.pm

@@ -0,0 +1,130 @@
+package Imager::File::GIF;
+use strict;
+use Imager;
+use vars qw($VERSION @ISA);
+
+BEGIN {
+  $VERSION = "0.77";
+
+  eval {
+    require XSLoader;
+    XSLoader::load('Imager::File::GIF', $VERSION);
+    1;
+  } or do {
+print STDERR "Falling back to DynaLoader ($@)\n";
+    require DynaLoader;
+    push @ISA, 'DynaLoader';
+    bootstrap Imager::File::GIF $VERSION;
+  };
+}
+
+Imager->register_reader
+  (
+   type=>'gif',
+   single => 
+   sub { 
+     my ($im, $io, %hsh) = @_;
+
+     if ($hsh{gif_consolidate}) {
+       if ($hsh{colors}) {
+	 my $colors;
+	 ($im->{IMG}, $colors) =i_readgif_wiol( $io );
+	 if ($colors) {
+	   ${ $hsh{colors} } = [ map { NC(@$_) } @$colors ];
+	 }
+       }
+       else {
+	 $im->{IMG} =i_readgif_wiol( $io );
+       }
+     }
+     else {
+       my $page = $hsh{page};
+       defined $page or $page = 0;
+       $im->{IMG} = i_readgif_single_wiol($io, $page);
+
+       unless ($im->{IMG}) {
+	 $im->_set_error(Imager->_error_as_msg);
+	 return;
+       }
+       if ($hsh{colors}) {
+	 ${ $hsh{colors} } = [ $im->getcolors ];
+       }
+       return $im;
+     }
+   },
+   multiple =>
+   sub {
+     my ($io, %hsh) = @_;
+
+     my @imgs = i_readgif_multi_wiol($io);
+     unless (@imgs) {
+       Imager->_set_error(Imager->_error_as_msg);
+       return;
+     }
+
+     return map bless({ IMG => $_, ERRSTR => undef }, "Imager"), @imgs;
+   },
+  );
+
+Imager->register_writer
+  (
+   type=>'gif',
+   single => 
+   sub { 
+     my ($im, $io, %hsh) = @_;
+
+     $im->_set_opts(\%hsh, "i_", $im);
+     $im->_set_opts(\%hsh, "gif_", $im);
+
+     unless (i_writegif_wiol($io, \%hsh, $im->{IMG})) {
+       $im->_set_error(Imager->_error_as_msg);
+       return;
+     }
+     return $im;
+   },
+   multiple =>
+   sub {
+     my ($class, $io, $opts, @ims) = @_;
+
+     Imager->_set_opts($opts, "gif_", @ims);
+
+     my @work = map $_->{IMG}, @ims;
+     unless (i_writegif_wiol($io, $opts, @work)) {
+       Imager->_set_error(Imager->_error_as_msg);
+       return;
+     }
+
+     return 1;
+   },
+  );
+
+__END__
+
+=head1 NAME
+
+Imager::File::GIF - read and write GIF files
+
+=head1 SYNOPSIS
+
+  use Imager;
+
+  my $img = Imager->new;
+  $img->read(file=>"foo.gif")
+    or die $img->errstr;
+
+  $img->write(file => "foo.gif")
+    or die $img->errstr;
+
+=head1 DESCRIPTION
+
+Imager's GIF support is documented in L<Imager::Files>.
+
+=head1 AUTHOR
+
+Tony Cook <tony@imager.perl.org>
+
+=head1 SEE ALSO
+
+Imager, Imager::Files.
+
+=cut

GIF/GIF.xs

@@ -0,0 +1,149 @@
+#define PERL_NO_GET_CONTEXT
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "imext.h"
+#include "imperl.h"
+#include "imgif.h"
+#include "imextpl.h"
+
+DEFINE_IMAGER_CALLBACKS;
+DEFINE_IMAGER_PERL_CALLBACKS;
+
+MODULE = Imager::File::GIF  PACKAGE = Imager::File::GIF
+
+long
+i_giflib_version()
+
+undef_int
+i_writegif_wiol(ig, opts,...)
+	Imager::IO ig
+      PREINIT:
+	i_quantize quant;
+	i_img **imgs = NULL;
+	int img_count;
+	int i;
+	HV *hv;
+      CODE:
+	if (items < 3)
+	    croak("Usage: i_writegif_wiol(IO,hashref, images...)");
+	if (!SvROK(ST(1)) || ! SvTYPE(SvRV(ST(1))))
+	    croak("i_writegif_callback: Second argument must be a hash ref");
+	hv = (HV *)SvRV(ST(1));
+	memset(&quant, 0, sizeof(quant));
+	quant.version = 1;
+	quant.mc_size = 256;
+	quant.transp = tr_threshold;
+	quant.tr_threshold = 127;
+	ip_handle_quant_opts(aTHX_ &quant, hv);
+	img_count = items - 2;
+	RETVAL = 1;
+	if (img_count < 1) {
+	  RETVAL = 0;
+	}
+	else {
+          imgs = mymalloc(sizeof(i_img *) * img_count);
+          for (i = 0; i < img_count; ++i) {
+	    SV *sv = ST(2+i);
+	    imgs[i] = NULL;
+	    if (SvROK(sv) && sv_derived_from(sv, "Imager::ImgRaw")) {
+	      imgs[i] = INT2PTR(i_img *, SvIV((SV*)SvRV(sv)));
+	    }
+	    else {
+	      RETVAL = 0;
+	      break;
+            }
+	  }
+          if (RETVAL) {
+	    RETVAL = i_writegif_wiol(ig, &quant, imgs, img_count);
+          }
+	  myfree(imgs);
+          if (RETVAL) {
+	    ip_copy_colors_back(aTHX_ hv, &quant);
+          }
+	}
+	ST(0) = sv_newmortal();
+	if (RETVAL == 0) ST(0)=&PL_sv_undef;
+	else sv_setiv(ST(0), (IV)RETVAL);
+	ip_cleanup_quant_opts(aTHX_ &quant);
+
+
+void
+i_readgif_wiol(ig)
+     Imager::IO         ig
+	      PREINIT:
+	        int*    colour_table;
+	        int     colours, q, w;
+	      i_img*    rimg;
+                 SV*    temp[3];
+                 AV*    ct; 
+                 SV*    r;
+	       PPCODE:
+ 	       colour_table = NULL;
+               colours = 0;
+
+	if(GIMME_V == G_ARRAY) {
+            rimg = i_readgif_wiol(ig,&colour_table,&colours);
+        } else {
+            /* don't waste time with colours if they aren't wanted */
+            rimg = i_readgif_wiol(ig,NULL,NULL);
+        }
+
+	if (colour_table == NULL) {
+            EXTEND(SP,1);
+            r=sv_newmortal();
+            sv_setref_pv(r, "Imager::ImgRaw", (void*)rimg);
+            PUSHs(r);
+	} else {
+            /* the following creates an [[r,g,b], [r, g, b], [r, g, b]...] */
+            /* I don't know if I have the reference counts right or not :( */
+            /* Neither do I :-) */
+            /* No Idea here either */
+
+            ct=newAV();
+            av_extend(ct, colours);
+            for(q=0; q<colours; q++) {
+                for(w=0; w<3; w++)
+                    temp[w]=sv_2mortal(newSViv(colour_table[q*3 + w]));
+                av_store(ct, q, (SV*)newRV_noinc((SV*)av_make(3, temp)));
+            }
+            myfree(colour_table);
+
+            EXTEND(SP,2);
+            r = sv_newmortal();
+            sv_setref_pv(r, "Imager::ImgRaw", (void*)rimg);
+            PUSHs(r);
+            PUSHs(newRV_noinc((SV*)ct));
+        }
+
+Imager::ImgRaw
+i_readgif_single_wiol(ig, page=0)
+	Imager::IO	ig
+        int		page
+
+void
+i_readgif_multi_wiol(ig)
+        Imager::IO ig
+      PREINIT:
+        i_img **imgs;
+        int count;
+        int i;
+      PPCODE:
+        imgs = i_readgif_multi_wiol(ig, &count);
+        if (imgs) {
+          EXTEND(SP, count);
+          for (i = 0; i < count; ++i) {
+            SV *sv = sv_newmortal();
+            sv_setref_pv(sv, "Imager::ImgRaw", (void *)imgs[i]);
+            PUSHs(sv);
+          }
+          myfree(imgs);
+        }
+
+
+BOOT:
+	PERL_INITIALIZE_IMAGER_CALLBACKS;
+	PERL_INITIALIZE_IMAGER_PERL_CALLBACKS;