File Coverage

blib/lib/PDF/API3/Compat/API2/Resource/XObject/Image/JPEG.pm
Criterion Covered Total %
statement 20 75 26.6
branch 0 28 0.0
condition 0 21 0.0
subroutine 7 10 70.0
pod 2 3 66.6
total 29 137 21.1


line stmt bran cond sub pod time code
1             #=======================================================================
2             # ____ ____ _____ _ ____ ___ ____
3             # | _ \| _ \| ___| _ _ / \ | _ \_ _| |___ \
4             # | |_) | | | | |_ (_) (_) / _ \ | |_) | | __) |
5             # | __/| |_| | _| _ _ / ___ \| __/| | / __/
6             # |_| |____/|_| (_) (_) /_/ \_\_| |___| |_____|
7             #
8             # A Perl Module Chain to faciliate the Creation and Modification
9             # of High-Quality "Portable Document Format (PDF)" Files.
10             #
11             # Copyright 1999-2005 Alfred Reibenschuh .
12             #
13             #=======================================================================
14             #
15             # This library is free software; you can redistribute it and/or
16             # modify it under the terms of the GNU Lesser General Public
17             # License as published by the Free Software Foundation; either
18             # version 2 of the License, or (at your option) any later version.
19             #
20             # This library is distributed in the hope that it will be useful,
21             # but WITHOUT ANY WARRANTY; without even the implied warranty of
22             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23             # Lesser General Public License for more details.
24             #
25             # You should have received a copy of the GNU Lesser General Public
26             # License along with this library; if not, write to the
27             # Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28             # Boston, MA 02111-1307, USA.
29             #
30             # $Id: JPEG.pm,v 2.1 2007/03/17 20:38:51 areibens Exp $
31             #
32             #=======================================================================
33             package PDF::API3::Compat::API2::Resource::XObject::Image::JPEG;
34            
35             BEGIN {
36            
37 1     1   6 use PDF::API3::Compat::API2::Util;
  1         2  
  1         223  
38 1     1   8 use PDF::API3::Compat::API2::Basic::PDF::Utils;
  1         2  
  1         138  
39 1     1   693 use PDF::API3::Compat::API2::Resource::XObject::Image;
  1         3  
  1         47  
40            
41 1     1   7 use POSIX;
  1         3  
  1         7  
42            
43 1     1   3147 use vars qw(@ISA $VERSION);
  1         3  
  1         141  
44            
45 1     1   29 @ISA = qw( PDF::API3::Compat::API2::Resource::XObject::Image );
46            
47 1         204 ( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.1 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2007/03/17 20:38:51 $
48            
49             }
50 1     1   7 no warnings qw[ deprecated recursion uninitialized ];
  1         3  
  1         694  
51            
52             =item $res = PDF::API3::Compat::API2::Resource::XObject::Image::JPEG->new $pdf, $file [, $name]
53            
54             Returns a jpeg-image object.
55            
56             =cut
57            
58             sub new
59             {
60 0     0 1   my ($class,$pdf,$file,$name) = @_;
61 0           my $self;
62 0           my $fh = IO::File->new;
63            
64 0 0         $class = ref $class if ref $class;
65            
66 0   0       $self=$class->SUPER::new($pdf,$name|| 'Jx'.pdfkey());
67 0 0         $pdf->new_obj($self) unless($self->is_obj($pdf));
68            
69 0           $self->{' apipdf'}=$pdf;
70            
71 0 0         if(ref $file)
72             {
73 0           $fh=$file;
74             }
75             else
76             {
77 0           open($fh,$file);
78             }
79 0           binmode($fh,':raw');
80            
81 0           $self->read_jpeg($fh);
82            
83 0 0         if(ref $file)
84             {
85 0           seek($fh,0,0);
86 0           $self->{' stream'}='';
87 0           my $buf='';
88 0           while(!eof($fh)) {
89 0           read($fh,$buf,512);
90 0           $self->{' stream'}.=$buf;
91             }
92 0           $self->{Length}=PDFNum(length $self->{' stream'});
93             }
94             else
95             {
96 0           $self->{Length}=PDFNum(-s $file);
97 0           $self->{' streamfile'}=$file;
98             }
99            
100 0           $self->filters('DCTDecode');
101 0           $self->{' nofilt'}=1;
102            
103 0           return($self);
104             }
105            
106             =item $res = PDF::API3::Compat::API2::Resource::XObject::Image::JPEG->new_api $api, $file [, $name]
107            
108             Returns a jpeg-image object. This method is different from 'new' that
109             it needs an PDF::API3::Compat::API2-object rather than a Text::PDF::File-object.
110            
111             =cut
112            
113             sub new_api {
114 0     0 1   my ($class,$api,@opts)=@_;
115            
116 0           my $obj=$class->new($api->{pdf},@opts);
117 0           $obj->{' api'}=$api;
118            
119 0           return($obj);
120             }
121            
122             sub read_jpeg {
123 0     0 0   my $self = shift @_;
124 0           my $fh = shift @_;
125            
126 0           my ($buf, $p, $h, $w, $c, $ff, $mark, $len);
127            
128 0           $fh->seek(0,0);
129 0           $fh->read($buf,2);
130 0           while (1) {
131 0           $fh->read($buf,4);
132 0           my($ff, $mark, $len) = unpack("CCn", $buf);
133 0 0         last if( $ff != 0xFF);
134 0 0 0       last if( $mark == 0xDA || $mark == 0xD9); # SOS/EOI
135 0 0         last if( $len < 2);
136 0 0         last if( $fh->eof);
137 0           $fh->read($buf,$len-2);
138 0 0         next if ($mark == 0xFE);
139 0 0 0       next if ($mark >= 0xE0 && $mark <= 0xEF);
140 0 0 0       if (($mark >= 0xC0) && ($mark <= 0xCF) &&
      0        
      0        
      0        
141             ($mark != 0xC4) && ($mark != 0xC8) && ($mark != 0xCC)) {
142 0           ($p, $h, $w, $c) = unpack("CnnC", substr($buf, 0, 6));
143 0           last;
144             }
145             }
146            
147 0           $self->width($w);
148 0           $self->height($h);
149            
150 0           $self->bpc($p);
151            
152 0 0         if($c==3) {
    0          
    0          
153 0           $self->colorspace('DeviceRGB');
154             } elsif($c==4) {
155 0           $self->colorspace('DeviceCMYK');
156             } elsif($c==1) {
157 0           $self->colorspace('DeviceGray');
158             }
159            
160 0           return($self);
161             }
162            
163            
164            
165             1;
166            
167             __END__