Image::DeAnim - create static GIF file from animated GIF

   use Image::DeAnim;

   open(G,"animated.gif") or die;
   undef $/;
   $gif = <G>;
   $newgif = Image::DeAnim::gif(\$gif); 
   print $$newgif;

   # Using HTTP::Response

   if ($self -> content_type eq 'image/gif') {
      my $gif = $self -> content;
      $self -> content (${&Image::DeAnim::gif(\$gif)});
   }

package Image::DeAnim;

use strict;
use vars qw($VERSION @ISA @EXPORT_OK $gif_in $gif_out);

require Exporter;

@ISA = qw(Exporter);
@EXPORT_OK = qw(gif);

$VERSION = '0.02';

sub gif {
    my $nullstr     = "";
    my $nullstr_ref = \$nullstr;

    my $gif_in_ref = shift || return \$nullstr_ref;

    $gif_out = "";
    $gif_in = $$gif_in_ref;
 
    # header
    my $header = &safe_read(6);
    unless ($header =~ /^GIF\d\d[a-z]/) {
        warn "not a GIF header: $header";
        return $nullstr_ref;
    }
    $gif_out .= "GIF89a";
 
# logical screen description
    my $ls_desc = &safe_read(7);
    my ($ls_size, $ls_flag, $ls_misc) = unpack("A4 C A2", $ls_desc);
    $gif_out .= $ls_desc;
    
    if ($ls_flag & 0x80) { # check for global color table
        $gif_out .= &get_colormap($ls_flag & 0x07);
    }
    
    my $data_block;
    
    while (1) {
        my $ext_label;
        my $block_label = &safe_read(1);
 
        # if we detect end of file marker, $gif_out .= last block and return
        if ($block_label eq "\x3b") {
            $gif_out .= $data_block . "\x3b";
            return \$gif_out;
        }
 
        if ($block_label eq "\x2c") { # found image descriptor
            $data_block = "\x2c" . &get_image;
            next;
        }
 
        unless ($block_label eq "\x21") {
            warn "Illegal block label found: " . ord($block_label);
            return $nullstr_ref;
        }
 
        $ext_label = &safe_read(1);
        if ($ext_label eq "\xf9") { # graphic control; keep and then get image
            $data_block = "\x21\xf9" . &safe_read(6);
            unless (&safe_read(1) eq "\x2c") {
                warn "graphic control extension not followed by image";
                return $nullstr_ref;
            }
            $data_block .= "\x2c" . &get_image;
            next;
        }
 
        if ($ext_label eq "\xff") { # application extension; skip
            &safe_read(12);
            &get_data_block;
        } elsif ($ext_label eq "\xfe") { # comment extension; skip
            &get_data_block;
        } elsif ($ext_label eq "\x01") { # plain text extension; skip
            &safe_read(13);
            &get_data_block;
        } else {
            warn "Illegal extension label found: " . ord($ext_label);
            return $nullstr_ref;
        }
    }
    
    warn "exit abnormally";
    return $nullstr_ref;
}
##########################################################################
 
sub safe_read {
    # read from $fh_in with error checking.
    my $len = shift;
    my $buf;

    unless (length($gif_in) >= $len) {
        die "read error: unsafe read";
    }

    ($buf, $gif_in) = unpack("a$len a*", $gif_in);
     
    return $buf;
}
 
sub get_data_block {
    my ($byte, $size);
    my $block = "";
 
    do {
        $byte = &safe_read(1);
        $size = ord($byte);
 
        if ($size) {
            $block .= $byte . &safe_read($size);
        }
    } while ($size);
 
    return $block . "\x00";
}    
 
sub get_colormap {
    my $size = shift;
    
    my $bytes = 3 * 2**($size+1);
    return &safe_read($bytes);
}
 
sub get_image {
    my $id_bytes = &safe_read(9);
    my $block = $id_bytes;
 
    my ($id_info, $id_flag) = unpack("A8 C", $id_bytes);
    if ($id_flag & 0x80) {
        $block .= &get_colormap($id_flag & 0x07);
    }
 
    $block .= &safe_read(1); # LZW minimum code size
    $block .= &get_data_block;
 
    return $block;
}

1;
__END__