File Coverage

blib/lib/PDF/Image/JPEG.pm
Criterion Covered Total %
statement 161 203 79.3
branch 23 50 46.0
condition 34 90 37.7
subroutine 8 8 100.0
pod 0 4 0.0
total 226 355 63.6


line stmt bran cond sub pod time code
1             #
2             # PDF::Image::JPEG - JPEG image support for PDF::Create
3             #
4             # Author: Michael Gross
5             #
6             # Copyright 1999-2001 Fabien Tassin
7             # Copyright 2007 Markus Baertschi
8             #
9             # Please see the CHANGES and Changes file for the detailed change log
10             #
11             # Please do not use any of the methods here directly. You will be
12             # punished with your application no longer working after an upgrade !
13             #
14              
15             package PDF::Image::JPEG;
16              
17 18     18   263 use 5.006;
  18         39  
18 18     18   67 use strict;
  18         23  
  18         317  
19 18     18   61 use warnings;
  18         29  
  18         404  
20 18     18   68 use FileHandle;
  18         27  
  18         97  
21              
22             our $VERSION = '1.42';
23             our $DEBUG = 0;
24              
25             sub new
26             {
27 1     1 0 6 my $self = {};
28              
29 1         2 $self->{private} = {};
30 1         2 $self->{width} = 0;
31 1         3 $self->{height} = 0;
32 1         2 $self->{colorspacedata} = "";
33 1         2 $self->{colorspace} = "";
34 1         2 $self->{colorspacesize} = 0;
35 1         2 $self->{filename} = "";
36 1         2 $self->{error} = "";
37 1         1 $self->{imagesize} = 0;
38 1         1 $self->{transparent} = 0;
39 1         2 $self->{filter} = ["DCTDecode"];
40 1         2 $self->{decodeparms} = {};
41              
42 1         2 bless($self);
43 1         3 return $self;
44             }
45              
46             sub pdf_next_jpeg_marker
47             {
48 5     5 0 5 my $self = shift;
49 5         4 my $fh = shift;
50 5         3 my $c = 0;
51 5         3 my $s;
52 5         5 my $M_ERROR = 0x100; #dummy marker, internal use only
53             #my $dbg = "";
54              
55 5         6 while ( $c == 0 ) {
56 5         7 while ( $c != 0xFF ) {
57 5 50       8 if ( eof($fh) ) {
58              
59             #print "EOF in next_marker ($dbg)\n";
60 0         0 return $M_ERROR;
61             }
62 5         4 read $fh, $s, 1;
63 5         11 $c = unpack( "C", $s );
64              
65             #$dbg.=" " . sprintf("%x", $c);
66             }
67              
68 5         7 while ( $c == 0xFF ) {
69 5 50       6 if ( eof($fh) ) {
70              
71             #print "EOF in next_marker ($dbg)\n";
72 0         0 return $M_ERROR;
73             }
74 5         5 read $fh, $s, 1;
75 5         9 $c = unpack( "C", $s );
76              
77             #$dbg.=" " . sprintf("%x", $c);
78             }
79             }
80              
81             #print "next_marker: $dbg\n";
82 5         15 return $c;
83             }
84              
85             sub Open
86             {
87 1     1 0 1 my $self = shift;
88 1         1 my $filename = shift;
89 1         4 $self->{filename} = $filename;
90              
91 1         1 my $M_SOF0 = 0xc0; # baseline DCT
92 1         2 my $M_SOF1 = 0xc1; # extended sequential DCT
93 1         1 my $M_SOF2 = 0xc2; # progressive DCT
94 1         3 my $M_SOF3 = 0xc3; # lossless (sequential)
95              
96 1         1 my $M_SOF5 = 0xc5; # differential sequential DCT
97 1         1 my $M_SOF6 = 0xc6; # differential progressive DCT
98 1         1 my $M_SOF7 = 0xc7; # differential lossless
99              
100 1         1 my $M_JPG = 0xc8; # JPEG extensions
101 1         2 my $M_SOF9 = 0xc9; # extended sequential DCT
102 1         1 my $M_SOF10 = 0xca; # progressive DCT
103 1         1 my $M_SOF11 = 0xcb; # lossless (sequential)
104              
105 1         1 my $M_SOF13 = 0xcd; # differential sequential DCT
106 1         1 my $M_SOF14 = 0xce; # differential progressive DCT
107 1         1 my $M_SOF15 = 0xcf; # differential lossless
108              
109 1         1 my $M_DHT = 0xc4; # define Huffman tables
110              
111 1         1 my $M_DAC = 0xcc; # define arithmetic conditioning table
112              
113 1         1 my $M_RST0 = 0xd0; # restart
114 1         0 my $M_RST1 = 0xd1; # restart
115 1         1 my $M_RST2 = 0xd2; # restart
116 1         2 my $M_RST3 = 0xd3; # restart
117 1         1 my $M_RST4 = 0xd4; # restart
118 1         1 my $M_RST5 = 0xd5; # restart
119 1         1 my $M_RST6 = 0xd6; # restart
120 1         1 my $M_RST7 = 0xd7; # restart
121              
122 1         0 my $M_SOI = 0xd8; # start of image
123 1         1 my $M_EOI = 0xd9; # end of image
124 1         1 my $M_SOS = 0xda; # start of scan
125 1         1 my $M_DQT = 0xdb; # define quantization tables
126 1         1 my $M_DNL = 0xdc; # define number of lines
127 1         1 my $M_DRI = 0xdd; # define restart interval
128 1         43 my $M_DHP = 0xde; # define hierarchical progression
129 1         2 my $M_EXP = 0xdf; # expand reference image(s)
130              
131 1         2 my $M_APP0 = 0xe0; # application marker, used for JFIF
132 1         1 my $M_APP1 = 0xe1; # application marker
133 1         1 my $M_APP2 = 0xe2; # application marker
134 1         1 my $M_APP3 = 0xe3; # application marker
135 1         1 my $M_APP4 = 0xe4; # application marker
136 1         1 my $M_APP5 = 0xe5; # application marker
137 1         1 my $M_APP6 = 0xe6; # application marker
138 1         0 my $M_APP7 = 0xe7; # application marker
139 1         1 my $M_APP8 = 0xe8; # application marker
140 1         1 my $M_APP9 = 0xe9; # application marker
141 1         1 my $M_APP10 = 0xea; # application marker
142 1         1 my $M_APP11 = 0xeb; # application marker
143 1         1 my $M_APP12 = 0xec; # application marker
144 1         1 my $M_APP13 = 0xed; # application marker
145 1         2 my $M_APP14 = 0xee; # application marker, used by Adobe
146 1         1 my $M_APP15 = 0xef; # application marker
147              
148 1         1 my $M_JPG0 = 0xf0; # reserved for JPEG extensions
149 1         1 my $M_JPG13 = 0xfd; # reserved for JPEG extensions
150 1         2 my $M_COM = 0xfe; # comment
151              
152 1         0 my $M_TEM = 0x01; # temporary use
153              
154 1         1 my $M_ERROR = 0x100; #dummy marker, internal use only
155              
156 1         1 my $b;
157             my $c;
158 0         0 my $s;
159 0         0 my $i;
160 0         0 my $length;
161 1         1 my $APP_MAX = 255;
162 1         1 my $appstring;
163 1         1 my $SOF_done = 0;
164 1         0 my $mask = -1;
165 1         2 my $adobeflag = 0;
166 1         1 my $components = 0;
167              
168 1         4 my $fh = FileHandle->new($filename);
169 1 50       51 if ( !defined $fh ) { $self->{error} = "PDF::Image::JPEG.pm: $filename: $!"; return 0 }
  0         0  
  0         0  
170 1         3 binmode $fh;
171              
172             #Tommy's special trick for Macintosh JPEGs: simply skip some
173             # hundred bytes at the beginning of the file!
174 1         17 MACTrick: while ( !eof($fh) ) {
175 1         2 $c = 0;
176 1   66     5 while ( !eof($fh) && $c != 0xFF ) { # skip if not FF
177 1         3 read $fh, $s, 1;
178 1         9 $c = unpack( "C", $s );
179             }
180              
181 1 50       2 if ( eof($fh) ) {
182 0         0 close($fh);
183 0         0 $self->{error} = "PDF::Image::JPEG.pm: Not a JPEG file.";
184 0         0 return 0;
185             }
186              
187 1   66     5 while ( !eof($fh) && $c == 0xFF ) { # skip repeated FFs
188 1         1 read $fh, $s, 1;
189 1         4 $c = unpack( "C", $s );
190             }
191              
192 1         3 $self->{private}->{datapos} = tell($fh) - 2;
193              
194 1 50       3 if ( $c == $M_SOI ) {
195 1         2 seek( $fh, $self->{private}->{datapos}, 0 );
196 1         5 last MACTrick;
197             }
198             }
199              
200 1         2 my $BOGUS_LENGTH = 768;
201              
202             #Heuristics: if we are that far from the start chances are
203             # it is a TIFF file with embedded JPEG data which we cannot
204             # handle - regard as hopeless...
205 1 50 33     8 if ( eof($fh) || $self->{private}->{datapos} > $BOGUS_LENGTH ) {
206 0         0 close($fh);
207 0         0 $self->{error} = "PDF::Image::JPEG.pm: Not a JPEG file.";
208 0         0 return 0;
209             }
210              
211             #process JPEG markers */
212 1   33     7 JPEGMarkers: while ( !$SOF_done && ( $c = $self->pdf_next_jpeg_marker($fh) ) != $M_EOI ) {
213              
214             #print "Marker: " . sprintf("%x", $c) . "\n";
215 5 50 33     69 if ( $c == $M_ERROR
      33        
      33        
      33        
      33        
      33        
      33        
      33        
      33        
216             || $c == $M_SOF3
217             || $c == $M_SOF5
218             || $c == $M_SOF6
219             || $c == $M_SOF7
220             || $c == $M_SOF9
221             || $c == $M_SOF11
222             || $c == $M_SOF13
223             || $c == $M_SOF14
224             || $c == $M_SOF15 ) {
225 0         0 close($fh);
226 0         0 $self->{error} = "PDF::Image::JPEG.pm: JPEG compression type " . ord($c) . " not supported in PDF 1.3.", return 0;
227             }
228              
229 5 50 33     15 if ( $c == $M_SOF2 || $c == $M_SOF10 ) {
230 0         0 close($fh);
231 0         0 $self->{error} = "PDF::Image::JPEG.pm: JPEG compression type " . ord($c) . " not supported in PDF 1.2.", return 0;
232             }
233              
234 5 100 66     68 if ( $c == $M_SOF0 || $c == $M_SOF1 ) {
    100 66        
    50 66        
    100 33        
      33        
      33        
      33        
      33        
      33        
      33        
      33        
235 1         2 read $fh, $s, 12;
236 1         3 ( $c, $self->{bpc}, $self->{height}, $self->{width}, $components ) = unpack( "nCnnC", $s );
237              
238 1         4 $SOF_done = 1;
239 1         2 last JPEGMarkers;
240             } elsif ( $c == $M_APP0 ) {
241 1         2 read $fh, $s, 2;
242 1         5 $length = unpack( "n", $s ) - 2;
243 1         2 read $fh, $appstring, $length;
244              
245             #Check for JFIF application marker and read density values
246             # per JFIF spec version 1.02.
247              
248 1         1 my $ASPECT_RATIO = 0; #JFIF unit byte: aspect ratio only
249 1         1 my $DOTS_PER_INCH = 1; #JFIF unit byte: dots per inch
250 1         1 my $DOTS_PER_CM = 2; #JFIF unit byte: dots per cm
251              
252 1 50 33     8 if ( $length >= 12 && $appstring =~ /^JFIF/ ) {
253 1         6 ( $c, $c, $c, $c, $c, $c, $c, $self->{private}->{unit}, $self->{dpi_x}, $self->{dpi_y} ) =
254             unpack( "CCCCCCCCnn", $appstring );
255 1 50 33     11 if ( $self->{dpi_x} <= 0 || $self->{dpi_y} <= 0 ) {
    50          
    0          
    0          
256 0         0 $self->{dpi_x} = 0;
257 0         0 $self->{dpi_y} = 0;
258             } elsif ( $self->{private}->{unit} == $DOTS_PER_INCH ) {
259             } elsif ( $self->{private}->{unit} == $DOTS_PER_CM ) {
260 0         0 $self->{dpi_x} *= 2.54;
261 0         0 $self->{dpi_y} *= 2.54;
262             } elsif ( $self->{private}->{unit} == $ASPECT_RATIO ) {
263 0         0 $self->{dpi_x} *= -1;
264 0         0 $self->{dpi_y} *= -1;
265             }
266             }
267             } elsif ( $c == $M_APP14 ) { #check for Adobe marker
268 0         0 read $fh, $s, 2;
269 0         0 $length = unpack( "n", $s ) - 2;
270              
271 0         0 read $fh, $appstring, $length;
272              
273             #Check for Adobe application marker. It is known (per Adobe's TN5116)
274             #to contain the string "Adobe" at the start of the APP14 marker.
275              
276 0 0 0     0 if ( $length >= 10 && $appstring =~ /^Adobe/ ) {
277 0         0 $adobeflag = 1;
278             }
279             } elsif ( $c == $M_SOI
280             || $c == $M_EOI
281             || $c == $M_TEM
282             || $c == $M_RST0
283             || $c == $M_RST1
284             || $c == $M_RST2
285             || $c == $M_RST3
286             || $c == $M_RST4
287             || $c == $M_RST5
288             || $c == $M_RST6
289             || $c == $M_RST7 ) {
290              
291             #no parameters --> ignore
292             } else {
293              
294             #skip variable length markers
295 2         3 read $fh, $s, 2;
296 2         2 $length = unpack( "n", $s ) - 2;
297 2         5 read $fh, $s, $length;
298             }
299             }
300              
301 1 50 33     10 if ( $self->{height} <= 0 || $self->{width} <= 0 || $components <= 0 ) {
      33        
302 0         0 close($fh);
303 0         0 $self->{error} = "PDF::Image::JPEG.pm: Bad image parameters in JPEG file.";
304 0         0 return 0;
305             }
306              
307 1 50       3 if ( $self->{bpc} != 8 ) {
308 0         0 close($fh);
309 0         0 $self->{error} = "PDF::Image::JPEG.pm: Bad bpc in JPEG file.";
310 0         0 return 0;
311             }
312              
313 1 50       4 if ( $components == 1 ) {
    50          
    0          
314 0         0 $self->{colorspace} = "DeviceGray";
315             } elsif ( $components == 3 ) {
316 1         2 $self->{colorspace} = "DeviceRGB";
317             } elsif ( $components == 4 ) {
318 0         0 $self->{colorspace} = "DeviceCMYK";
319              
320             #special handling of Photoshop-generated CMYK JPEG files
321 0 0       0 if ($adobeflag) {
322 0         0 $self->{invert} = 1;
323             }
324             } else {
325 0         0 close($fh);
326 0         0 $self->{error} = "PDF::Image::JPEG.pm: Unknown number of color components in JPEG file.", return 0;
327             }
328              
329 1         7 close($fh);
330              
331 1         8 1;
332             }
333              
334             sub ReadData
335             {
336 1     1 0 1 my $self = shift;
337 1         1 my $s = "";
338 1         1 my $result;
339 1         1 my $JPEG_BUFSIZE = 1024;
340 1         5 my $fh = FileHandle->new($self->{filename});
341 1 50       46 if ( !defined $fh ) { $self->{error} = "PDF::Image::JPEG.pm: $self->{filename}: $!"; return 0 }
  0         0  
  0         0  
342 1         2 binmode $fh;
343 1         3 seek( $fh, $self->{private}->{datapos}, 0 );
344              
345 1         12 while ( read( $fh, $s, $JPEG_BUFSIZE ) > 0 ) {
346 13         32 $result .= $s;
347             }
348              
349 1         3 $self->{imagesize} = length($result);
350              
351 1         4 close $fh;
352              
353 1         11 $result;
354             }
355              
356             1;