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