File Coverage

blib/lib/Imager/GIF.pm

Criterion	Covered	Total	%
statement	15	53	28.3
branch	0	12	0.0
condition	0	2	0.0
subroutine	5	11	45.4
pod	4	4	100.0
total	24	82	29.2

use strict;
use warnings;
use 5.010;
use Imager;
package Imager::GIF;
use Carp 'croak';

# ABSTRACT: a handy module for animated GIF processing

sub new {
    my ($class, @args) = @_;
    bless { images => \@args }, $class;
}

sub read {
    my ($class, %args) = @_;
    croak "No filename specified" unless $args{file};
    my @images = Imager->read_multi(file => $args{file});
    return Imager::GIF->new(@images);
}

sub write {
    my ($self, $file) = @_;
    my $img = Imager->new;
    $img->write_multi({ file => $file, type => 'gif' }, @{$self->{images}})
        or die $img->errstr;
}

sub scale {
    my ($self, %args) = @_;
    my $ratio = $args{scalefactor} // 1;
    $self->_mangle(sub {
        my $img = shift;
        my $ret = $img->scale(%args, qtype => 'mixing');
        my $h = $img->tags(name => 'gif_screen_height');
        my $w = $img->tags(name => 'gif_screen_width');
        unless ($ratio) {
            if (defined $args{xpixels}) {
                $ratio = $args{xpixels} / $w;
            }
            if (defined $args{ypixels}) {
                $ratio = $args{ypixels} / $h;
            }
        }
        $ret->settag(name => 'gif_left',
                     value => int($ratio * $img->tags(name => 'gif_left')));
        $ret->settag(name => 'gif_top',
                     value => int($ratio * $img->tags(name => 'gif_top')));
        $ret->settag(name => 'gif_screen_width',  value => int($ratio * $w));
        $ret->settag(name => 'gif_screen_height', value => int($ratio * $h));
        return $ret;
    });
}

sub _mangle {
    my ($self, $action) = @_;
    my @out;
    for my $in (@{$self->{images}}) {
        my $mangled = $action->($in);
        for my $tag (qw/gif_delay gif_user_input gif_loop gif_disposal/) {
            $mangled->settag(name => $tag, value => $in->tags(name => $tag));
        }
        if ($in->tags(name => 'gif_local_map')) {
            $mangled->settag(name => 'gif_local_map', value => 1);
        }
        push @out, $mangled;
    }
    return Imager::GIF->new(@out);
}

1;

__END__