File Coverage

blib/lib/PDF/API2/Resource/XObject/Image/GIF.pm

Criterion	Covered	Total	%
statement	104	158	65.8
branch	18	42	42.8
condition	4	24	16.6
subroutine	10	11	90.9
pod	1	3	33.3
total	137	238	57.5

package PDF::API2::Resource::XObject::Image::GIF;

use base 'PDF::API2::Resource::XObject::Image';

use strict;
use warnings;

our $VERSION = '2.043'; # VERSION

use Carp;
use IO::File;
use PDF::API2::Util;
use PDF::API2::Basic::PDF::Utils;
use Scalar::Util qw(weaken);

# GIF89a Specification:
# https://www.w3.org/Graphics/GIF/spec-gif89a.txt

# Originally from PDF::Create
# PDF::Image::GIFImage - GIF image support
# Author: Michael Gross
sub unInterlace {
    my $self = shift;
    my $data = $self->{' stream'};
    my $row;
    my @result;
    my $width = $self->width();
    my $height = $self->height();
    my $idx = 0;

    # Pass 1 - every 8th row, starting with row 0
    $row = 0;
    while ($row < $height) {
        $result[$row] = substr($data, $idx * $width, $width);
        $row += 8;
        $idx++;
    }

    # Pass 2 - every 8th row, starting with row 4
    $row = 4;
    while ($row < $height) {
        $result[$row] = substr($data, $idx * $width, $width);
        $row += 8;
        $idx++;
    }

    # Pass 3 - every 4th row, starting with row 2
    $row = 2;
    while ($row < $height) {
        $result[$row] = substr($data, $idx * $width, $width);
        $row += 4;
        $idx++;
    }

    # Pass 4 - every 2th row, starting with row 1
    $row = 1;
    while ($row < $height) {
        $result[$row] = substr($data, $idx * $width, $width);
        $row += 2;
        $idx++;
    }

    $self->{' stream'} = join('', @result);
}

sub deGIF {
    my ($ibits, $stream) = @_;
    my $bits = $ibits;
    my $resetcode = 1 << ($ibits - 1);
    my $endcode = $resetcode + 1;
    my $nextcode = $endcode + 1;
    my $ptr = 0;
    my $maxptr = 8 * length($stream);
    my $tag;
    my $out = '';
    my $outptr = 0;

    my @d = map { chr($_) } (0 .. ($resetcode - 1));

    while (($ptr + $bits) <= $maxptr) {
        $tag = 0;
        foreach my $off (reverse 0 .. ($bits - 1)) {
            $tag <<= 1;
            $tag |= vec($stream, $ptr + $off, 1);
        }
        # foreach my $off (0..$bits-1) {
        #     $tag<<=1;
        #     $tag|=vec($stream,$ptr+$off,1);
        # }
        # print STDERR "ptr=$ptr,tag=$tag,bits=$bits,next=$nextcode\n";
        # print STDERR "tag to large\n" if($tag>$nextcode);
        $ptr += $bits;
        $bits++ if $nextcode == 1 << $bits and $bits < 12;
        if ($tag==$resetcode) {
            $bits = $ibits;
            $nextcode = $endcode + 1;
            next;
        }
        elsif ($tag == $endcode) {
            last;
        }
        elsif ($tag < $resetcode) {
            $d[$nextcode] = $d[$tag];
            $out .= $d[$nextcode];
            $nextcode++;
        }
        elsif ($tag > $endcode) {
            $d[$nextcode] = $d[$tag];
            $d[$nextcode] .= substr($d[$tag + 1], 0, 1);
            $out .= $d[$nextcode];
            $nextcode++;
        }
    }
    return $out;
}

sub new {
    my ($class, $pdf, $file, $name, %opts) = @_;
    my $self;
    my $interlaced = 0;

    $class = ref($class) if ref($class);

    $self = $class->SUPER::new($pdf, $name || 'Gx' . pdfkey());
    $pdf->new_obj($self) unless $self->is_obj($pdf);

    $self->{' apipdf'} = $pdf;
    weaken $self->{' apipdf'};

    my $fh = IO::File->new();
    if (ref($file)) {
        $fh = $file;
    }
    else {
        open $fh, '<', $file or die "$!: $file";
    }
    binmode $fh, ':raw';
    my $buf;
    $fh->seek(0, 0);
    $fh->read($buf, 6); # signature
    unless ($buf =~ /^GIF[0-9][0-9][a-z]/) {
        die "Unknown image signature '$buf' -- not a GIF";
    }

    $fh->read($buf, 7); # logical screen descriptor
    my ($wg, $hg, $flags, $bgColorIndex, $aspect) = unpack('vvCCC', $buf);

    if ($flags & 0x80) {
        my $colSize = 2 ** (($flags & 0x7) + 1);
        my $dict = PDFDict();
        $pdf->new_obj($dict);
        $self->colorspace(PDFArray(PDFName('Indexed'),
                                   PDFName('DeviceRGB'),
                                   PDFNum($colSize-1),
                                   $dict));
        $fh->read($dict->{' stream'}, 3 * $colSize); # color table
    }

    until ($fh->eof()) {
        $fh->read($buf, 1); # tag.
        my $sep = unpack('C', $buf);
        if ($sep == 0x2C) {
            $fh->read($buf, 9); # image descriptor
            my ($left, $top, $w, $h, $flags) = unpack('vvvvC', $buf);

            $self->width($w || $wg);
            $self->height($h || $hg);
            $self->bpc(8);

            if ($flags & 0x80) { # local color table
                my $colSize = 2 ** (($flags & 0x7) + 1);
                my $dict = PDFDict();
                $pdf->new_obj($dict);
                $self->colorspace(PDFArray(PDFName('Indexed'),
                                           PDFName('DeviceRGB'),
                                           PDFNum($colSize-1),
                                           $dict));
                $fh->read($dict->{' stream'}, 3 * $colSize); # color table
            }
            if ($flags & 0x40) { # whether image is interlaced
                $interlaced = 1;
            }

            $fh->read($buf, 1); # image-lzw-start (should be 9).
            my ($sep) = unpack('C', $buf);

            $fh->read($buf, 1); # first chunk.
            my ($len) = unpack('C', $buf);
            my $stream = '';
            while ($len > 0) {
                $fh->read($buf, $len);
                $stream .= $buf;
                $fh->read($buf, 1);
                $len = unpack('C', $buf);
            }
            $self->{' stream'} = deGIF($sep + 1, $stream);
            $self->unInterlace() if $interlaced;
            last;
        }
        elsif ($sep == 0x3b) { # trailer
            last;
        }
        else { # extension
            $fh->read($buf, 1); # tag
            my $tag = unpack('C', $buf);
            $fh->read($buf, 1); # length
            my $len = unpack('C', $buf);
            my $stream = '';
            while ($len > 0) {
                $fh->read($buf, $len);
                $stream .= $buf;
                $fh->read($buf, 1);
                $len = unpack('C', $buf);
            }

            # Graphic Control Extension
            if ($sep == 0x21 and $tag == 0xF9) {
                my ($cFlags, $delay, $transIndex) = unpack('CvC', $stream);
                if (($cFlags & 0x01) and not $opts{'-notrans'}) {
                    $self->{'Mask'} = PDFArray(PDFNum($transIndex),
                                               PDFNum($transIndex));
                }
            }

            # Comment Extension
            elsif ($sep == 0x21 and $tag == 0xFE) {
                # NOOP: ignore
            }

            # Plain Text Extension
            elsif ($sep == 0x21 and $tag == 0x01) {
                # NOOP: ignore
            }

            elsif ($sep == 0x21) {
                carp "Ignoring unsupported GIF extension $tag";
            }
        }
    }
    $fh->close();

    $self->filters('FlateDecode');

    return $self;
}

1;