File Coverage

blib/lib/PDF/Builder/Resource/XObject/Image/GD.pm
Criterion Covered Total %
statement 18 56 32.1
branch 0 16 0.0
condition 0 18 0.0
subroutine 6 8 75.0
pod 1 2 50.0
total 25 100 25.0


line stmt bran cond sub pod time code
1             package PDF::Builder::Resource::XObject::Image::GD;
2              
3 1     1   1115 use base 'PDF::Builder::Resource::XObject::Image';
  1         2  
  1         87  
4              
5 1     1   6 use strict;
  1         2  
  1         17  
6 1     1   4 use warnings;
  1         2  
  1         56  
7              
8             our $VERSION = '3.024'; # VERSION
9             our $LAST_UPDATE = '3.024'; # manually update whenever code is changed
10              
11 1     1   7 use PDF::Builder::Util;
  1         2  
  1         124  
12 1     1   7 use PDF::Builder::Basic::PDF::Utils;
  1         2  
  1         83  
13 1     1   6 use Scalar::Util qw(weaken);
  1         2  
  1         441  
14              
15             =head1 NAME
16              
17             PDF::Builder::Resource::XObject::Image::GD - support routines for Graphics Development image library. Inherits from L
18              
19             =head1 METHODS
20              
21             =over
22              
23             =item $res = PDF::Builder::Resource::XObject::Image::GD->new($pdf, $file, %opts)
24              
25             Options:
26              
27             =over
28              
29             =item 'name' => 'string'
30              
31             This is the name you can give for the GD image object. The default is Dxnnnn.
32              
33             =item 'lossless' => 1
34              
35             Use lossless compression.
36              
37             =back
38              
39             =back
40              
41             =cut
42              
43             sub new {
44 0     0 1   my ($class, $pdf, $obj, %opts) = @_;
45             # copy dashed option names to preferred undashed names
46 0 0 0       if (defined $opts{'-name'} && !defined $opts{'name'}) { $opts{'name'} = delete($opts{'-name'}); }
  0            
47 0 0 0       if (defined $opts{'-compress'} && !defined $opts{'compress'}) { $opts{'compress'} = delete($opts{'-compress'}); }
  0            
48 0 0 0       if (defined $opts{'-lossless'} && !defined $opts{'lossless'}) { $opts{'lossless'} = delete($opts{'-lossless'}); }
  0            
49              
50 0           my ($name, $compress);
51 0 0         if (exists $opts{'name'}) { $name = $opts{'name'}; }
  0            
52             #if (exists $opts{'compress'}) { $compress = $opts{'compress'}; }
53              
54 0           my $self;
55              
56 0 0         $class = ref($class) if ref($class);
57              
58 0   0       $self = $class->SUPER::new($pdf, $name || 'Dx'.pdfkey());
59 0 0         $pdf->new_obj($self) unless $self->is_obj($pdf);
60              
61 0           $self->{' apipdf'} = $pdf;
62 0           weaken $self->{' apipdf'};
63              
64 0           $self->read_gd($obj, %opts);
65              
66 0           return $self;
67             }
68              
69             sub read_gd {
70 0     0 0   my ($self, $gd, %opts) = @_;
71              
72 0           my ($w,$h) = $gd->getBounds();
73 0           my $c = $gd->colorsTotal();
74              
75 0           $self->width($w);
76 0           $self->height($h);
77              
78 0           $self->bits_per_component(8);
79 0           $self->colorspace('DeviceRGB');
80              
81 0 0 0       if ($gd->can('jpeg') && ($c > 256) && !$opts{'lossless'}) {
    0 0        
82              
83 0           $self->filters('DCTDecode');
84 0           $self->{' nofilt'} = 1;
85 0           $self->{' stream'} = $gd->jpeg(75);
86              
87             } elsif ($gd->can('raw')) {
88              
89 0           $self->filters('FlateDecode');
90 0           $self->{' stream'} = $gd->raw();
91              
92             } else {
93              
94 0           $self->filters('FlateDecode');
95 0           for(my $y=0; $y<$h; $y++) {
96 0           for(my $x=0; $x<$w; $x++) {
97 0           my $index = $gd->getPixel($x,$y);
98 0           my @rgb = $gd->rgb($index);
99 0           $self->{' stream'} .= pack('CCC', @rgb);
100             }
101             }
102              
103             }
104              
105 0           return $self;
106             }
107              
108             1;