Gif.pm

package Gif;
use 5.12.1;
use strict;
use warnings;
use Carp;

sub new {
    my ($class, $file) = @_;
    my $self = bless {}, $class;
    $self->{file} = $file;
    return $self;
}

sub parse {
    my ($self) = @_;
    open $self->{fh}, '<', $self->{file} or die "can't read $self->{file}: $@";
    binmode($self->{fh});
    $self->{position} = 0;
    $self->parse_header or die "$self->{file} is not GIF89a";
    while (my $block = $self->parse_block) {
        push @{$self->{blocks}}, $block;
        given ($block->{type}) {
            when ('graphic control extension') {
                push @{$self->{images}}, {
                    start => $block->{start},
                    length => $block->{length},
                };
            }
            when ('image') {
                my $img = $self->{images}->[-1];
                $img->{length} += $block->{length};
            }
            when ('trailer') {
                last;
            }
        }
    }
    delete $self->{fh};
}

sub extract_image {
    my ($self, $index) = @_;
    my $image = $self->{images}->[$index] or return;
    open my $fh, '<', $self->{file} or return;
    binmode($fh);
    seek $fh, $image->{start}, 0;
    read $fh, my $data, $image->{length};
    return $self->{header} . 
        $self->{global_color_table} .
        $data . 
        chr(0x3B);
}

sub parse_header {
    my ($self) = @_;
    $self->{header} = $self->read(13);
    $self->{header} =~ m{^GIF89a} or return;
    my ($h, $w, $packed) = unpack('vvC', substr($self->{header},6));
    $self->{height} = $h;
    $self->{width} = $w;
    my $global_color_table_flag = $packed & 0b10000000;
    $self->{resolution} = ($packed & 0b01110000 >> 4) + 1;
    my $sort_flag = 0b00001000;
    my $size = (2 ** (($packed & 0b00000111) + 1)) * 3;
    $self->{global_color_table} = $self->read($size);
    return 1;
}

sub parse_block {
    my ($self) = shift;
    my $pos = $self->{position};
    my $intro = $self->readint;
    my $type = 'unknown';
    given ($intro) {
        when (0x21) {
            my $label = $self->readint;
            given ($label) {
                when (0x01) {
                    $type = 'plain text extension';
                }
                when (0xfe) {
                    $type = 'comment extension';
                }
                when (0xf9) {
                    $type = 'graphic control extension';
                }
                when (0xff) {
                    $type = 'application extension';
                }
                default {
                    confess "unknown extension label: $label";
                }
            }
            $self->readdataseq;
        }
        when (0x2C) {
            $type = 'image';
            $self->read(8);
            my $b = $self->readint;
            if ($b & 0b10000000) {
                my $size = $b & 0b00000111;
                $self->read((2 ** ($size + 1)) * 3); # local color table
            }
            $self->read(1); # lzw minimum code size
            $self->readdataseq;
        }
        when (0x3B) {
            $type = 'trailer';
        }
        default {
            die "unknown intro: $intro";
        }
    }
    my $length = $self->{position} - $pos;
    return {
        type => $type,
        start => $pos,
        length => $length,
    };
}

sub read {
    my ($self, $length) = @_;
    my $size = CORE::read($self->{fh}, my $data, $length);
    if (! defined $size) {
        confess "reading error: $@";
    } elsif ($size != $length) {
        confess "reached EOF: $self->{position}";
    }
    $self->{position} += $size;
    return $data;
}

sub readint {
    my ($self) = @_;
    return ord($self->read(1));
}

sub readdataseq {
    my ($self) = @_;
    my $i;
    while (1) {
        $self->readdata or last;
    }
}

sub readdata {
    my ($self) = @_;
    my $size = $self->readint or return;
    return $self->read($size);
}

1;