JezK
Edit File: FlateDecode.pm
package PDF::API2::Basic::PDF::Filter::FlateDecode; our $VERSION = '2.027'; # VERSION use base 'PDF::API2::Basic::PDF::Filter'; use strict; no warnings qw[ deprecated recursion uninitialized ]; use POSIX qw(ceil floor); our $havezlib; BEGIN { eval {require "Compress/Zlib.pm";}; $havezlib = !$@; } sub new { return undef unless $havezlib; my ($class, $decode_parms) = @_; my ($self) = { DecodeParms => $decode_parms, }; $self->{'outfilt'} = Compress::Zlib::deflateInit( -Level=>9, -Bufsize=>32768, ); $self->{'infilt'} = Compress::Zlib::inflateInit(); bless $self, $class; } sub outfilt { my ($self, $str, $isend) = @_; my ($res); $res = $self->{'outfilt'}->deflate($str); $res .= $self->{'outfilt'}->flush() if ($isend); $res; } sub infilt { my ($self, $dat, $last) = @_; my ($res, $status) = $self->{'infilt'}->inflate("$dat"); if ($self->{'DecodeParms'} and $self->{'DecodeParms'}->{'Predictor'}) { my $predictor = $self->{'DecodeParms'}->{'Predictor'}->val(); if ($predictor == 2) { die "The TIFF predictor logic has not been implemented"; } elsif ($predictor >= 10 and $predictor <= 15) { $res = $self->_depredict_png($res); } else { die "Invalid predictor: $predictor"; } } return $res; } sub _depredict_png { my ($self, $stream) = @_; my $param = $self->{'DecodeParms'}; my $prev = ''; $stream = $self->{'_depredict_next'} . $stream if defined $self->{'_depredict_next'}; $prev = $self->{'_depredict_prev'} if defined $self->{'_depredict_prev'}; my $alpha = $param->{Alpha} ? $param->{Alpha}->val() : 0; my $bpc = $param->{BitsPerComponent} ? $param->{BitsPerComponent}->val() : 8; my $colors = $param->{Colors} ? $param->{Colors}->val() : 1; my $columns = $param->{Columns} ? $param->{Columns}->val() : 1; my $height = $param->{Height} ? $param->{Height}->val() : 0; my $comp = $colors + $alpha; my $bpp = ceil($bpc * $comp / 8); my $scanline = 1 + ceil($bpp * $columns); my $clearstream = ''; my $lastrow = ($height || int(length($stream) / $scanline)) - 1; foreach my $n (0 .. $lastrow) { # print STDERR "line $n:"; my $line = substr($stream, $n * $scanline, $scanline); my $filter = vec($line, 0, 8); my $clear = ''; $line = substr($line, 1); # print STDERR " filter=$filter "; if ($filter == 0) { $clear = $line; } elsif ($filter == 1) { foreach my $x (0 .. length($line) - 1) { vec($clear, $x, 8) = (vec($line, $x, 8) + vec($clear, $x - $bpp, 8)) % 256; } } elsif ($filter == 2) { foreach my $x (0 .. length($line) - 1) { vec($clear, $x, 8) = (vec($line, $x, 8) + vec($prev, $x, 8)) % 256; } } elsif ($filter == 3) { foreach my $x (0 .. length($line) - 1) { vec($clear, $x, 8) = (vec($line, $x, 8) + floor((vec($clear, $x - $bpp, 8) + vec($prev, $x, 8)) / 2)) % 256; } } elsif ($filter == 4) { foreach my $x (0 .. length($line) - 1) { vec($clear, $x, 8) = (vec($line, $x, 8) + _paeth_predictor(vec($clear, $x - $bpp, 8), vec($prev, $x, 8), vec($prev, $x - $bpp, 8))) % 256; } } else { die "Unexpected depredictor algorithm $filter requested on line $n (valid options are 0-4)"; } $prev = $clear; foreach my $x (0 .. ($columns * $comp) - 1) { vec($clearstream, ($n * $columns * $comp) + $x, $bpc) = vec($clear, $x, $bpc); # print STDERR "" . vec($clear, $x, $bpc) . ","; } # print STDERR "\n"; } $self->{'_depredict_next'} = substr($stream, ($lastrow + 1) * $scanline); $self->{'_depredict_prev'} = $prev; return $clearstream; } sub _paeth_predictor { my ($a, $b, $c) = @_; my $p = $a + $b - $c; my $pa = abs($p - $a); my $pb = abs($p - $b); my $pc = abs($p - $c); if ($pa <= $pb && $pa <= $pc) { return $a; } elsif ($pb <= $pc) { return $b; } else { return $c; } } 1;