File Coverage

blib/lib/PDF/Builder/Resource/XObject/Image/JPEG.pm
Criterion Covered Total %
statement 74 80 92.5
branch 22 38 57.8
condition 13 27 48.1
subroutine 9 9 100.0
pod 1 2 50.0
total 119 156 76.2


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::XObject::Image::JPEG;
2              
3 2     2   975 use base 'PDF::Builder::Resource::XObject::Image';
  2         5  
  2         633  
4              
5 2     2   14 use strict;
  2         5  
  2         46  
6 2     2   11 use warnings;
  2         5  
  2         107  
7              
8             our $VERSION = '3.025'; # VERSION
9             our $LAST_UPDATE = '3.024'; # manually update whenever code is changed
10              
11 2     2   27 use IO::File;
  2         4  
  2         390  
12 2     2   14 use PDF::Builder::Util;
  2         6  
  2         340  
13 2     2   14 use PDF::Builder::Basic::PDF::Utils;
  2         5  
  2         178  
14 2     2   15 use Scalar::Util qw(weaken);
  2         4  
  2         1500  
15              
16             =head1 NAME
17              
18             PDF::Builder::Resource::XObject::Image::JPEG - support routines for JPEG image library. Inherits from L
19              
20             =head1 METHODS
21              
22             =over
23              
24             =item $res = PDF::Builder::Resource::XObject::Image::JPEG->new($pdf, $file, %opts)
25              
26             Options:
27              
28             =over
29              
30             =item 'name' => 'string'
31              
32             This is the name you can give for the JPEG image object. The default is Jxnnnn.
33              
34             =back
35              
36             =back
37              
38             =cut
39              
40             sub new {
41 3     3 1 8 my ($class, $pdf, $file, %opts) = @_;
42             # copy dashed option names to preferred undashed names
43 3 50 33     11 if (defined $opts{'-name'} && !defined $opts{'name'}) { $opts{'name'} = delete($opts{'-name'}); }
  0         0  
44 3 50 33     8 if (defined $opts{'-compress'} && !defined $opts{'compress'}) { $opts{'compress'} = delete($opts{'-compress'}); }
  0         0  
45              
46 3         4 my ($name, $compress);
47 3 50       8 if (exists $opts{'name'}) { $name = $opts{'name'}; }
  0         0  
48             #if (exists $opts{'compress'}) { $compress = $opts{'compress'}; }
49              
50 3         18 my $fh = IO::File->new();
51              
52 3 50       118 $class = ref($class) if ref($class);
53              
54 3   33     15 my $self = $class->SUPER::new($pdf, $name || 'Jx' . pdfkey());
55 3 50       9 $pdf->new_obj($self) unless $self->is_obj($pdf);
56              
57 3         12 $self->{' apipdf'} = $pdf;
58 3         8 weaken $self->{' apipdf'};
59              
60 3 100       7 if (ref($file)) {
61 1         2 $fh = $file;
62             } else {
63 2 100       111 open $fh, "<", $file or die "$!: $file";
64             }
65 2         34 binmode($fh, ':raw');
66              
67 2         7 $self->read_jpeg($fh);
68              
69 2 100       8 if (ref($file)) {
70 1         14 seek($fh, 0, 0);
71 1         5 $self->{' stream'} = '';
72 1         2 my $buf = '';
73 1         11 while (!eof($fh)) {
74 2         17 read($fh, $buf, 512);
75 2         17 $self->{' stream'} .= $buf;
76             }
77 1         5 $self->{'Length'} = PDFNum(length $self->{' stream'});
78             } else {
79 1         25 $self->{'Length'} = PDFNum(-s $file);
80 1         9 $self->{' streamfile'} = $file;
81             }
82              
83 2         34 $self->filters('DCTDecode');
84 2         4 $self->{' nofilt'} = 1;
85              
86 2         24 return $self;
87             }
88              
89             sub read_jpeg {
90 2     2 0 6 my ($self, $fh) = @_;
91              
92 2         3 my ($buf, $p, $h, $w, $c, $ff, $mark, $len);
93              
94 2         19 $fh->seek(0,0);
95 2         48 $fh->read($buf,2);
96 2         72 while (1) {
97 10         28 $fh->read($buf, 4);
98 10         61 my ($ff, $mark, $len) = unpack('CCn', $buf);
99 10 50       31 last if $ff != 0xFF;
100 10 50 33     33 last if $mark == 0xDA || $mark == 0xD9; # SOS/EOI
101 10 50       20 last if $len < 2;
102 10 50       26 last if $fh->eof();
103 10         70 $fh->read($buf, $len - 2);
104 10 100       55 next if $mark == 0xFE;
105 8 100 66     44 next if $mark >= 0xE0 && $mark <= 0xEF;
106 6 50 66     45 if ($mark >= 0xC0 && $mark <= 0xCF && $mark != 0xC4 && $mark != 0xC8 && $mark != 0xCC) {
      66        
      66        
      33        
107 2         13 ($p, $h, $w, $c) = unpack('CnnC', substr($buf, 0, 6));
108 2         7 last;
109             }
110             }
111              
112 2         14 $self->width($w);
113 2         9 $self->height($h);
114 2         8 $self->bits_per_component($p);
115              
116 2 50       8 if (!defined $c) { return $self; }
  0         0  
117 2 50       8 if ($c == 3) {
    0          
    0          
118 2         6 $self->colorspace('DeviceRGB');
119             } elsif ($c == 4) {
120 0         0 $self->colorspace('DeviceCMYK');
121             } elsif ($c == 1) {
122 0         0 $self->colorspace('DeviceGray');
123             }
124              
125 2         3 return $self;
126             }
127              
128             1;