Files
scripts/Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Image/PNM.pm
2024-10-14 00:08:40 +02:00

186 lines
4.3 KiB
Perl

package PDF::API2::Resource::XObject::Image::PNM;
# For spec details, see man pages pam(5), pbm(5), pgm(5), pnm(5),
# ppm(5), which were pasted into the __END__ of this file in an
# earlier revision.
use base 'PDF::API2::Resource::XObject::Image';
use strict;
no warnings qw[ deprecated recursion uninitialized ];
our $VERSION = '2.033'; # VERSION
use IO::File;
use PDF::API2::Util;
use PDF::API2::Basic::PDF::Utils;
use Scalar::Util qw(weaken);
sub new {
my ($class,$pdf,$file,$name) = @_;
my $self;
$class = ref $class if ref $class;
$self=$class->SUPER::new($pdf,$name || 'Nx'.pdfkey());
$pdf->new_obj($self) unless($self->is_obj($pdf));
$self->{' apipdf'}=$pdf;
weaken $self->{' apipdf'};
$self->read_pnm($pdf,$file);
return($self);
}
# READPPMHEADER
# taken from Image::PBMLib
# Copyright by Benjamin Elijah Griffin (28 Feb 2003)
#
sub readppmheader {
my $gr = shift; # input file glob ref
my $in = '';
my $no_comments;
my %info;
my $rc;
$info{error} = undef;
$rc = read($gr, $in, 3);
if (!defined($rc) or $rc != 3) {
$info{error} = 'Read error or EOF';
return \%info;
}
if ($in =~ /^P([123456])\s/) {
$info{type} = $1;
if ($info{type} > 3) {
$info{raw} = 1;
} else {
$info{raw} = 0;
}
if ($info{type} == 1 or $info{type} == 4) {
$info{max} = 1;
$info{bgp} = 'b';
} elsif ($info{type} == 2 or $info{type} == 5) {
$info{bgp} = 'g';
} else {
$info{bgp} = 'p';
}
while(1) {
$rc = read($gr, $in, 1, length($in));
if (!defined($rc) or $rc != 1) {
$info{error} = 'Read error or EOF';
return \%info;
}
$no_comments = $in;
$info{comments} = '';
while ($no_comments =~ /#.*\n/) {
$no_comments =~ s/#(.*\n)/ /;
$info{comments} .= $1;
}
if ($info{bgp} eq 'b') {
if ($no_comments =~ /^P\d\s+(\d+)\s+(\d+)\s/) {
$info{width} = $1;
$info{height} = $2;
last;
}
} else {
if ($no_comments =~ /^P\d\s+(\d+)\s+(\d+)\s+(\d+)\s/) {
$info{width} = $1;
$info{height} = $2;
$info{max} = $3;
last;
}
}
} # while reading header
$info{fullheader} = $in;
} else {
$info{error} = 'Wrong magic number';
}
return \%info;
}
sub read_pnm {
my $self = shift @_;
my $pdf = shift @_;
my $file = shift @_;
my ($buf,$t,$s,$line);
my ($w,$h,$bpc,$cs,$img,@img)=(0,0,'','','');
my $inf;
if (ref($file)) {
$inf = $file;
}
else {
open $inf, "<", $file or die "$!: $file";
}
binmode($inf,':raw');
$inf->seek(0,0);
my $info=readppmheader($inf);
if($info->{type} == 4) {
$bpc=1;
read($inf,$self->{' stream'},($info->{width}*$info->{height}/8));
$cs='DeviceGray';
$self->{Decode}=PDFArray(PDFNum(1),PDFNum(0));
} elsif($info->{type} == 5) {
$buf.=<$inf>;
if($info->{max}==255){
$s=0;
} else {
$s=255/$info->{max};
}
$bpc=8;
if($s>0) {
for($line=($info->{width}*$info->{height});$line>0;$line--) {
read($inf,$buf,1);
$self->{' stream'}.=pack('C',(unpack('C',$buf)*$s));
}
} else {
read($inf,$self->{' stream'},$info->{width}*$info->{height});
}
$cs='DeviceGray';
} elsif($info->{type} == 6) {
if($info->{max}==255){
$s=0;
} else {
$s=255/$info->{max};
}
$bpc=8;
if($s>0) {
for($line=($info->{width}*$info->{height});$line>0;$line--) {
read($inf,$buf,1);
$self->{' stream'}.=pack('C',(unpack('C',$buf)*$s));
read($inf,$buf,1);
$self->{' stream'}.=pack('C',(unpack('C',$buf)*$s));
read($inf,$buf,1);
$self->{' stream'}.=pack('C',(unpack('C',$buf)*$s));
}
} else {
read($inf,$self->{' stream'},$info->{width}*$info->{height}*3);
}
$cs='DeviceRGB';
}
close($inf);
$self->width($info->{width});
$self->height($info->{height});
$self->bpc($bpc);
$self->filters('FlateDecode');
$self->colorspace($cs);
return($self);
}
1;