File Coverage

blib/lib/PDF/API3/Compat/API2/Resource/XObject/Image/GD.pm
Criterion Covered Total %
statement 20 54 37.0
branch 0 8 0.0
condition 0 9 0.0
subroutine 7 10 70.0
pod 2 3 66.6
total 29 84 34.5


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: GD.pm,v 2.0 2005/11/16 02:18:23 areibens Exp $
31             #
32             #=======================================================================
33             package PDF::API3::Compat::API2::Resource::XObject::Image::GD;
34            
35             BEGIN {
36            
37 1     1   7 use PDF::API3::Compat::API2::Util;
  1         3  
  1         247  
38 1     1   8 use PDF::API3::Compat::API2::Basic::PDF::Utils;
  1         3  
  1         138  
39 1     1   6 use PDF::API3::Compat::API2::Resource::XObject::Image;
  1         3  
  1         30  
40            
41 1     1   7 use POSIX;
  1         2  
  1         9  
42            
43 1     1   3604 use vars qw(@ISA $VERSION);
  1         3  
  1         194  
44            
45 1     1   44 @ISA = qw( PDF::API3::Compat::API2::Resource::XObject::Image );
46            
47 1         55 ( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.0 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2005/11/16 02:18:23 $
48            
49             }
50 1     1   8 no warnings qw[ deprecated recursion uninitialized ];
  1         4  
  1         604  
51            
52             =item $res = PDF::API3::Compat::API2::Resource::XObject::Image::GD->new $pdf, $obj [, $name]
53            
54             Returns a image object from a GD::Image.
55            
56             =cut
57            
58             sub new {
59 0     0 1   my ($class,$pdf,$obj,$name,@opts) = @_;
60 0           my $self;
61            
62 0 0         $class = ref $class if ref $class;
63            
64 0   0       $self=$class->SUPER::new($pdf,$name|| 'Jx'.pdfkey());
65 0 0         $pdf->new_obj($self) unless($self->is_obj($pdf));
66            
67 0           $self->{' apipdf'}=$pdf;
68            
69 0           $self->read_gd($obj,@opts);
70            
71 0           return($self);
72             }
73            
74             =item $res = PDF::API3::Compat::API2::Resource::XObject::Image::GD->new_api $api, $obj [, $name]
75            
76             Returns a image object. This method is different from 'new' that
77             it needs an PDF::API3::Compat::API2-object rather than a Text::PDF::File-object.
78            
79             =cut
80            
81             sub new_api {
82 0     0 1   my ($class,$api,@opts)=@_;
83            
84 0           my $obj=$class->new($api->{pdf},@opts);
85 0           $obj->{' api'}=$api;
86            
87 0           return($obj);
88             }
89            
90             sub read_gd {
91 0     0 0   my $self = shift @_;
92 0           my $gd = shift @_;
93 0           my %opts = @_;
94            
95 0           my ($w,$h) = $gd->getBounds();
96 0           my $c = $gd->colorsTotal();
97            
98 0           $self->width($w);
99 0           $self->height($h);
100            
101 0           $self->bpc(8);
102 0           $self->colorspace('DeviceRGB');
103            
104 0 0 0       if(UNIVERSAL::can($gd,'jpeg') && ($c > 256) && !$opts{-lossless}) {
    0 0        
105            
106 0           $self->filters('DCTDecode');
107 0           $self->{' nofilt'}=1;
108 0           $self->{' stream'}=$gd->jpeg(75);
109            
110             } elsif(UNIVERSAL::can($gd,'raw')) {
111            
112 0           $self->filters('FlateDecode');
113 0           $self->{' stream'}=$gd->raw;
114            
115             } else {
116            
117 0           $self->filters('FlateDecode');
118 0           for(my $y=0;$y<$h;$y++) {
119 0           for(my $x=0;$x<$w;$x++) {
120 0           my $index=$gd->getPixel($x,$y);
121 0           my @rgb=$gd->rgb($index);
122 0           $self->{' stream'}.=pack('CCC',@rgb);
123             }
124             }
125            
126             }
127            
128 0           return($self);
129             }
130            
131            
132            
133             1;
134            
135             __END__