File Coverage

blib/lib/PDF/Builder/Basic/PDF/Filter/RunLengthDecode.pm
Criterion Covered Total %
statement 39 50 78.0
branch 14 20 70.0
condition 1 3 33.3
subroutine 5 5 100.0
pod 2 2 100.0
total 61 80 76.2


line stmt bran cond sub pod time code
1             package PDF::Builder::Basic::PDF::Filter::RunLengthDecode;
2              
3 44     44   70986 use base 'PDF::Builder::Basic::PDF::Filter';
  44         121  
  44         4999  
4              
5 44     44   1866 use strict;
  44         138  
  44         1150  
6 44     44   249 use warnings;
  44         87  
  44         22942  
7              
8             our $VERSION = '3.025'; # VERSION
9             our $LAST_UPDATE = '2.029'; # manually update whenever code is changed
10              
11             =head1 NAME
12              
13             PDF::Builder::Basic::PDF::Filter::RunLengthDecode - compress and uncompress stream filters for Run-Length
14              
15             =cut
16              
17             # Maintainer's Note: RunLengthDecode is described in the PDF 1.7 spec
18             # in section 7.4.5.
19              
20             sub outfilt {
21 2     2 1 110 my ($self, $input, $include_eod) = @_;
22              
23 2         5 my $output;
24              
25 2         8 while ($input ne '') {
26 6         8 my ($unrepeated, $repeated);
27              
28             # Look for a repeated character (which can be repeated up to
29             # 127 times)
30 6 50       42 if ($input =~ m/^(.*?)((.)\3{1,127})(.*)$/so) {
31 6         16 $unrepeated = $1;
32 6         13 $repeated = $2;
33 6         19 $input = $4;
34             } else {
35 0         0 $unrepeated = $input;
36 0         0 $input = '';
37             }
38              
39             # Print any non-repeating bytes at the beginning of the input
40             # in chunks of up to 128 bytes, prefixed with a run-length (0
41             # to 127, signifying 1 to 128 bytes)
42 6         18 while (length($unrepeated) > 127) {
43 0         0 $output .= pack('C', 127) . substr($unrepeated, 0, 128);
44 0         0 substr($unrepeated, 0, 128) = '';
45             }
46 6 100       18 $output .= pack('C', length($unrepeated) - 1) . $unrepeated if length($unrepeated) > 0;
47              
48             # Then print the number of times the repeated byte was
49             # repeated (using the formula "257 - length" to give a result
50             # in the 129-255 range) followed by the byte to be repeated
51 6 50       14 if (length($repeated)) {
52 6         29 $output .= pack('C', 257 - length($repeated)) . substr($repeated, 0, 1);
53             }
54             }
55              
56             # A byte value of 128 signifies that we're done.
57 2 100       17 $output .= "\x80" if $include_eod;
58              
59 2         10 return $output;
60             }
61              
62             sub infilt {
63 2     2 1 7 my ($self, $input, $is_terminated) = @_;
64              
65 2         5 my ($output, $length);
66              
67             # infilt may be called multiple times, and is expected to continue
68             # where it left off
69 2 50       12 if (exists $self->{'incache'}) {
70 0         0 $input = $self->{'incache'} . $input;
71 0         0 delete $self->{'incache'};
72             }
73              
74 2         12 while (length($input)) {
75             # Read a length byte
76 11         23 $length = unpack("C", $input);
77              
78             # A "length" of 128 represents the end of the document
79 11 100       26 if ($length == 128) {
80 1         11 return $output;
81             }
82              
83             # Any other length needs to be followed by at least one other byte
84 10 50 33     22 if (length($input) == 1 and not $is_terminated) {
85 0         0 die "Premature end to RunLengthEncoded data";
86             }
87              
88             # A length of 129-255 represents a repeated string
89             # (number of repeats = 257 - length)
90 10 100       19 if ($length > 128) {
91 6 50       13 if (length($input) == 1) {
92             # Out of data. Defer until the next call.
93 0         0 $self->{'incache'} = $input;
94 0         0 return $output;
95             }
96 6         15 $output .= substr($input, 1, 1) x (257 - $length);
97 6         19 substr($input, 0, 2) = '';
98             }
99              
100             # Any other length (under 128) represents a non-repeated
101             # stream of bytes (with a length of 0 to 127 representing 1 to
102             # 128 bytes)
103             else {
104 4 50       9 if (length($input) < $length + 2) {
105             # Insufficient data. Defer until the next call.
106 0         0 $self->{'incache'} = $input;
107 0         0 return $output;
108             }
109 4         11 $output .= substr($input, 1, $length + 1);
110 4         9 substr($input, 0, $length + 2) = '';
111             }
112             }
113              
114 1         8 return $output;
115             }
116              
117             1;