File Coverage

blib/lib/PDF/API3/Compat/API2/Resource/XObject/Image/PNM.pm

Criterion	Covered	Total	%
statement	20	120	16.6
branch	0	36	0.0
condition	0	15	0.0
subroutine	7	11	63.6
pod	2	4	50.0
total	29	186	15.5

#=======================================================================
#    ____  ____  _____              _    ____ ___   ____
#   |  _ \|  _ \|  ___|  _   _     / \  |  _ \_ _| |___ \
#   | |_) | | | | |_    (_) (_)   / _ \ | |_) | |    __) |
#   |  __/| |_| |  _|    _   _   / ___ \|  __/| |   / __/
#   |_|   |____/|_|     (_) (_) /_/   \_\_|  |___| |_____|
#
#   A Perl Module Chain to faciliate the Creation and Modification
#   of High-Quality "Portable Document Format (PDF)" Files.
#
#   Copyright 1999-2005 Alfred Reibenschuh .
#
#=======================================================================
#
#   This library is free software; you can redistribute it and/or
#   modify it under the terms of the GNU Lesser General Public
#   License as published by the Free Software Foundation; either
#   version 2 of the License, or (at your option) any later version.
#
#   This library is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#   Lesser General Public License for more details.
#
#   You should have received a copy of the GNU Lesser General Public
#   License along with this library; if not, write to the
#   Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#   Boston, MA 02111-1307, USA.
#
#   $Id: PNM.pm,v 2.1 2007/05/24 19:29:46 areibens Exp $
#
#=======================================================================
package PDF::API3::Compat::API2::Resource::XObject::Image::PNM;

BEGIN {

    use PDF::API3::Compat::API2::Util;
    use PDF::API3::Compat::API2::Basic::PDF::Utils;
    use PDF::API3::Compat::API2::Resource::XObject::Image;

    use POSIX;

    use vars qw(@ISA $VERSION);
    @ISA = qw( PDF::API3::Compat::API2::Resource::XObject::Image );
    ( $VERSION ) = sprintf '%i.%03i', split(/\./,('$Revision: 2.1 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2007/05/24 19:29:46 $
}
no warnings qw[ deprecated recursion uninitialized ];

=item $res = PDF::API3::Compat::API2::Resource::XObject::Image::PNM->new $pdf, $file [, $name]

Returns a pnm-image object.

=cut

sub new {
    my ($class,$pdf,$file,$name) = @_;
    my $self;
    my $fh = IO::File->new;

    $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;

    $self->read_pnm($pdf,$file);

    return($self);
}

=item $res = PDF::API3::Compat::API2::Resource::XObject::Image::PNM->new_api $api, $file [, $name]

Returns a pnm-image object. This method is different from 'new' that
it needs an PDF::API3::Compat::API2-object rather than a Text::PDF::File-object.

=cut

sub new_api {
    my ($class,$api,@opts)=@_;

    my $obj=$class->new($api->{pdf},@opts);
    $obj->{' api'}=$api;

    return($obj);
}

# 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,'','','');
    open(INF,$file);
    binmode(INF,':raw');
    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.=;
        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;

__END__