File Coverage

blib/lib/PDF/Builder/Basic/PDF/Filter/ASCII85Decode.pm
Criterion Covered Total %
statement 49 60 81.6
branch 13 22 59.0
condition 9 18 50.0
subroutine 5 5 100.0
pod 2 2 100.0
total 78 107 72.9


line stmt bran cond sub pod time code
1             package PDF::Builder::Basic::PDF::Filter::ASCII85Decode;
2              
3 40     40   80917 use base 'PDF::Builder::Basic::PDF::Filter';
  40         99  
  40         6070  
4              
5 40     40   298 use strict;
  40         120  
  40         1059  
6 40     40   218 use warnings;
  40         101  
  40         31697  
7              
8             our $VERSION = '3.023'; # VERSION
9             our $LAST_UPDATE = '3.010'; # manually update whenever code is changed
10              
11             =head1 NAME
12              
13             PDF::Builder::Basic::PDF::Filter::ASCII85Decode - compress and uncompress stream filters for ASCII-85
14              
15             =cut
16              
17             sub outfilt {
18 3     3 1 20 my ($self, $str, $isend) = @_;
19              
20 3         6 my ($res, $i, $j, $bb, @c);
21              
22 3 50 33     16 if (exists $self->{'outcache'} and $self->{'outcache'} ne "") {
23 0         0 $str = $self->{'outcache'} . $str;
24 0         0 $self->{'outcache'} = "";
25             }
26 3         14 for ($i = 0; $i + 4 <= length($str); $i += 4) {
27 32         63 $bb = unpack("N", substr($str, $i, 4));
28 32 50       67 if ($bb == 0) {
29 0         0 $res .= "z";
30 0         0 next;
31             }
32 32         63 for ($j = 0; $j < 4; $j++) {
33 128         222 $c[$j] = $bb - int($bb / 85) * 85 + 33; $bb /= 85;
  128         232  
34             }
35 32         80 $res .= pack("C5", $bb + 33, reverse @c);
36 32 50       85 $res .= "\n" if $i % 60 == 56;
37             }
38 3 100 66     19 if ($isend && $i < length($str)) {
    50          
    0          
39 1         4 $str = substr($str, $i);
40 1         6 $bb = unpack("N", $str . ("\000" x (4 - length($str))));
41 1         5 for ($j = 0; $j < 4; $j++) {
42 4         10 $c[$j] = $bb - int($bb / 85) * 85 + 33; $bb /= 85;
  4         8  
43             }
44 1         4 push @c, $bb + 33;
45 1         6 $res .= substr(pack("C5", reverse @c), 0, length($str) + 1) . '~>';
46             } elsif ($isend) {
47 2         6 $res .= '~>';
48             } elsif ($i + 4 > length($str)) {
49 0         0 $self->{'outcache'} = substr($str, $i);
50             }
51              
52 3         17 return $res;
53             }
54              
55             sub infilt {
56 2     2 1 7 my ($self, $str, $isend) = @_;
57              
58 2         5 my ($res, $i, $j, @c, $bb, $num);
59 2         5 $num = 0;
60 2 50 33     9 if (exists($self->{'incache'}) && $self->{'incache'} ne "") {
61 0         0 $str = $self->{'incache'} . $str;
62 0         0 $self->{'incache'} = "";
63             }
64 2         11 $str =~ s/(\r|\n)\n?//og;
65 2         8 for ($i = 0; $i < length($str); $i += 5) {
66 23 100 66     74 last if $isend and substr($str, $i, 6) eq '~>';
67 22         35 $bb = 0;
68 22 50 66     79 if (substr($str, $i, 1) eq "z") {
    100          
69 0         0 $i -= 4;
70 0         0 $res .= pack("N", 0);
71 0         0 next;
72             } elsif ($isend && substr($str, $i, 6) =~ m/^(.{2,4})\~\>$/o) {
73 1         5 $num = 5 - length($1);
74 1         6 @c = unpack("C5", $1 . ("u" x (4 - $num))); # pad with 84 to sort out rounding
75 1         2 $i = length($str);
76             } else {
77 21         53 @c = unpack("C5", substr($str, $i, 5));
78             }
79              
80 22         47 for ($j = 0; $j < 5; $j++) {
81 110         148 $bb *= 85;
82 110         214 $bb += $c[$j] - 33;
83             }
84 22         61 $res .= substr(pack("N", $bb), 0, 4 - $num);
85             }
86 2 50 33     8 if (!$isend && $i > length($str)) {
87 0         0 $self->{'incache'} = substr($str, $i - 5);
88             }
89              
90 2         11 return $res;
91             }
92              
93             1;