r20675 - in /branches/upstream/libpdf-create-perl/current: ./ lib/PDF/ lib/PDF/Create/ lib/PDF/Image/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Wed Jun 4 16:44:54 UTC 2008
Author: gregoa
Date: Wed Jun 4 16:44:53 2008
New Revision: 20675
URL: http://svn.debian.org/wsvn/?sc=1&rev=20675
Log:
[svn-upgrade] Integrating new upstream version, libpdf-create-perl (1.01)
Added:
branches/upstream/libpdf-create-perl/current/Changes
branches/upstream/libpdf-create-perl/current/Changes.PL
branches/upstream/libpdf-create-perl/current/lib/PDF/Image/GIF.pm
branches/upstream/libpdf-create-perl/current/lib/PDF/Image/JPEG.pm
Removed:
branches/upstream/libpdf-create-perl/current/lib/PDF/Image/GIFImage.pm
branches/upstream/libpdf-create-perl/current/lib/PDF/Image/JPEGImage.pm
Modified:
branches/upstream/libpdf-create-perl/current/CHANGES
branches/upstream/libpdf-create-perl/current/MANIFEST
branches/upstream/libpdf-create-perl/current/META.yml
branches/upstream/libpdf-create-perl/current/Makefile.PL
branches/upstream/libpdf-create-perl/current/README
branches/upstream/libpdf-create-perl/current/lib/PDF/Create.pm
branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Outline.pm
branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Page.pm
Modified: branches/upstream/libpdf-create-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/CHANGES?rev=20675&op=diff
==============================================================================
--- branches/upstream/libpdf-create-perl/current/CHANGES (original)
+++ branches/upstream/libpdf-create-perl/current/CHANGES Wed Jun 4 16:44:53 2008
@@ -1,3 +1,5 @@
+
+Further changes are documented in the 'Changes' file
Version 0.09 30.9.2007
- Markus Baertschi, markus at markus.org
Added: branches/upstream/libpdf-create-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/Changes?rev=20675&op=file
==============================================================================
--- branches/upstream/libpdf-create-perl/current/Changes (added)
+++ branches/upstream/libpdf-create-perl/current/Changes Wed Jun 4 16:44:53 2008
@@ -1,0 +1,127 @@
+commit 0e9a7ef...
+Author: Markus Baertschi <markus at markus.org>
+Date: Tue Jun 3 12:28:59 2008 +0200
+
+ Renamed Image modules to fix bug 28636 (rt.cpan.org).
+
+commit 7acfe62...
+Author: Markus Baertschi <markus at markus.org>
+Date: Tue Jun 3 10:53:56 2008 +0200
+
+ Updates Michael's email, added reference to git repository at github
+
+commit e52ef1f...
+Merge: 88fad3e... 875425d...
+Author: Markus Baertschi <markus at markus.org>
+Date: Sat May 31 19:26:23 2008 +0200
+
+ Merge branch 'master' of git://github.com/markusb/pdf-create
+
+commit 88fad3e...
+Author: Markus Baertschi <markus at markus.org>
+Date: Sat May 31 19:20:33 2008 +0200
+
+ Updated version to 1.0 to fit better with PDF::Create and show maturity
+
+commit ccf26de...
+Author: Markus Baertschi <markus at markus.org>
+Date: Sat May 31 19:18:35 2008 +0200
+
+ Updated build system to generate Changes file directly from git log
+
+commit 28b0922...
+Author: Markus Baertschi <markus at markus.org>
+Date: Sat May 31 12:49:32 2008 +0200
+
+ Version 1.0
+
+commit 875425d...
+Author: Markus Baertschi <markus at markus.org>
+Date: Sat May 31 12:49:32 2008 +0200
+
+ Version 1.0
+
+commit 9adbcbf...
+Author: Markus Baertschi <markus at markus.org>
+Date: Sat May 31 12:05:17 2008 +0200
+
+ More POD fixing
+
+commit 6f7ba3f...
+Author: Markus Baertschi <markus at markus.org>
+Date: Sat May 31 11:23:50 2008 +0200
+
+ Version 0.10
+
+commit f9e1656...
+Author: Markus Baertschi <markus at markus.org>
+Date: Fri May 30 09:00:53 2008 +0200
+
+ Clarified documentation
+
+commit da76efc...
+Author: Markus Baertschi <markus at markus.org>
+Date: Thu May 29 22:04:07 2008 +0200
+
+ Fixed 'Rotate', added debugging
+
+commit e240621...
+Author: Markus Baertschi <markus at markus.org>
+Date: Tue May 20 19:44:21 2008 +0200
+
+ Fixed documentation formatting
+
+commit fe3823d...
+Author: Markus Baertschi <markus at markus.org>
+Date: Tue May 20 18:00:13 2008 +0200
+
+ Added small cgi sample
+
+commit 87fc07f...
+Author: Markus Baertschi <markus at markus.org>
+Date: Tue May 20 17:21:57 2008 +0200
+
+ Changed version to 0.9
+
+commit 90f37ce...
+Author: Markus Baertschi <markus at markus.org>
+Date: Tue May 20 17:18:40 2008 +0200
+
+ Cleaned up samples and comments
+
+commit 2b50205...
+Author: Markus Baertschi <markus at markus.org>
+Date: Tue May 20 17:07:10 2008 +0200
+
+ Added better testing
+
+commit 48262cc...
+Author: Markus Baertschi <markus at markus.org>
+Date: Tue May 20 17:03:48 2008 +0200
+
+ Improved documentation
+
+commit 3ed3ded...
+Author: Markus Baertschi <markus at markus.org>
+Date: Tue May 20 17:02:30 2008 +0200
+
+ Add error-checking
+
+commit a726f88...
+Author: Markus Baertschi <markus at markus.org>
+Date: Sun Sep 30 19:00:42 2007 +0200
+
+ Re-added pdf-logo files
+
+commit 1490f88...
+Author: Markus Baertschi <markus at markus.org>
+Date: Sun Sep 30 18:59:04 2007 +0200
+
+ New function: printnl (print multiple lines)
+ Modified: get_page_size (arguments case-independent)
+
+commit e4d7378...
+Author: Markus Baertschi <markus at markus.org>
+Date: Mon Sep 3 18:05:29 2007 +0200
+
+ Initial import.
Added: branches/upstream/libpdf-create-perl/current/Changes.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/Changes.PL?rev=20675&op=file
==============================================================================
--- branches/upstream/libpdf-create-perl/current/Changes.PL (added)
+++ branches/upstream/libpdf-create-perl/current/Changes.PL Wed Jun 4 16:44:53 2008
@@ -1,0 +1,11 @@
+#!/usr/bin/perl -w
+#
+# Changes.PL
+#
+# Create the 'Changes' file automatically from git commit messages'
+#
+
+use strict;
+
+`git log --abbrev-commit --pretty > Changes`;
+
Modified: branches/upstream/libpdf-create-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/MANIFEST?rev=20675&op=diff
==============================================================================
Binary files - no diff available.
Modified: branches/upstream/libpdf-create-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/META.yml?rev=20675&op=diff
==============================================================================
--- branches/upstream/libpdf-create-perl/current/META.yml (original)
+++ branches/upstream/libpdf-create-perl/current/META.yml Wed Jun 4 16:44:53 2008
@@ -1,7 +1,7 @@
--- #YAML:1.0
name: PDF-Create
-version: 1.00
-abstract: ~
+version: 1.01
+abstract: create PDF files
license: ~
generated_by: ExtUtils::MakeMaker version 6.36
distribution_type: module
Modified: branches/upstream/libpdf-create-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/Makefile.PL?rev=20675&op=diff
==============================================================================
--- branches/upstream/libpdf-create-perl/current/Makefile.PL (original)
+++ branches/upstream/libpdf-create-perl/current/Makefile.PL Wed Jun 4 16:44:53 2008
@@ -2,10 +2,10 @@
use ExtUtils::MakeMaker;
-WriteMakefile(NAME => "PDF::Create",
- VERSION_FROM => "lib/PDF/Create.pm",
- dist => { COMPRESS => "gzip", SUFFIX => "gz" },
- clean => { FILES => '*.bak *.old mibs/*.dump *.pdf' .
- 'lib/*/*~ lib/*/*/*~' },
- # EXE_FILES => [ qw() ],
+WriteMakefile(NAME => "PDF::Create",
+ VERSION_FROM => "lib/PDF/Create.pm",
+ ABSTRACT_FROM => "lib/PDF/Create.pm",
+ dist => { COMPRESS => "gzip", SUFFIX => "gz" },
+ clean => { FILES => '*.bak *.old mibs/*.dump *.pdf' .
+ 'lib/*/*~ lib/*/*/*~' },
);
Modified: branches/upstream/libpdf-create-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/README?rev=20675&op=diff
==============================================================================
--- branches/upstream/libpdf-create-perl/current/README (original)
+++ branches/upstream/libpdf-create-perl/current/README Wed Jun 4 16:44:53 2008
@@ -113,4 +113,7 @@
The last version of PDF::Create from Fabien is 0.06. All never versions
have been modified by me.
+ I maintain PDF::Create in git. You can access the repository directly
+ at http://github.com/markusb/pdf-create.
+
Modified: branches/upstream/libpdf-create-perl/current/lib/PDF/Create.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/lib/PDF/Create.pm?rev=20675&op=diff
==============================================================================
--- branches/upstream/libpdf-create-perl/current/lib/PDF/Create.pm (original)
+++ branches/upstream/libpdf-create-perl/current/lib/PDF/Create.pm Wed Jun 4 16:44:53 2008
@@ -3,8 +3,6 @@
# PDF::Create - create PDF files
#
# Author: Fabien Tassin <fta at sofaraway.org>
-#
-# Version: 0.08
#
# Copyright 1999-2001 Fabien Tassin <fta at sofaraway.org>
# Copyright 2007 Markus Baertschi <markus at markus.org>
@@ -27,7 +25,7 @@
package PDF::Create;
-our $VERSION = "1.00";
+our $VERSION = "1.01";
our $DEBUG = 0;
use strict;
@@ -35,8 +33,8 @@
use FileHandle;
use PDF::Create::Page;
use PDF::Create::Outline;
-use PDF::Image::GIFImage;
-use PDF::Image::JPEGImage;
+use PDF::Image::GIF;
+use PDF::Image::JPEG;
use vars qw($DEBUG);
our (@ISA, @EXPORT, @EXPORT_OK, @EXPORT_FAIL);
@@ -847,9 +845,9 @@
my $s;
if ($filename=~/\.gif$/i) {
- $self->{'images'}{$num} = GIFImage->new();
+ $self->{'images'}{$num} = PDF::Image::GIF->new();
} elsif ($filename=~/\.jpg$/i || $filename=~/\.jpeg$/i) {
- $self->{'images'}{$num} = JPEGImage->new();
+ $self->{'images'}{$num} = PDF::Image::JPEG->new();
}
$image = $self->{'images'}{$num};
@@ -1370,13 +1368,14 @@
=head1 SEE ALSO
-L<PDF::Create::Page>, L<perl>, L<http://www.adobe.com/devnet/pdf/pdf_reference.html>
+L<PDF::Create::Page>, L<http://www.adobe.com/devnet/pdf/pdf_reference.html>
+L<http://github.com/markusb/pdf-create>
=head1 AUTHORS
Fabien Tassin (fta at sofaraway.org)
-GIF and JPEG-support: Michael Gross (mdgrosse at sbox.tugraz.at)
+GIF and JPEG-support: Michael Gross (info at mdgrosse.net)
Maintenance since 2007: Markus Baertschi (markus at markus.org)
Modified: branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Outline.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Outline.pm?rev=20675&op=diff
==============================================================================
--- branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Outline.pm (original)
+++ branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Outline.pm Wed Jun 4 16:44:53 2008
@@ -2,11 +2,12 @@
# PDF::Create::Outline - PDF outlines tree
# Author: Fabien Tassin <fta at sofaraway.org>
-# Version: 0.01
+# Version: 1.00
# Copyright 1999 Fabien Tassin <fta at sofaraway.org>
# bugs :
-# - ...
+# 31.05.2008 1.00 Markus Baertschi
+# - Changed vesion to go with PDF::Create
package PDF::Create::Outline;
@@ -19,7 +20,7 @@
@ISA = qw(Exporter);
@EXPORT = qw();
-$VERSION = 0.01;
+$VERSION = 1.00;
$DEBUG = 0;
sub new {
Modified: branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Page.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Page.pm?rev=20675&op=diff
==============================================================================
--- branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Page.pm (original)
+++ branches/upstream/libpdf-create-perl/current/lib/PDF/Create/Page.pm Wed Jun 4 16:44:53 2008
@@ -7,6 +7,8 @@
# bugs :
# - ...
+# 31.05.2008 1.00 Markus Baertschi
+# - Changed version to 1.00 to go with PDF::Create
package PDF::Create::Page;
@@ -19,7 +21,7 @@
@ISA = qw(Exporter);
@EXPORT = qw();
-$VERSION = 0.06;
+$VERSION = 1.00;
$DEBUG = 0;
my $font_widths = &init_widths;
Added: branches/upstream/libpdf-create-perl/current/lib/PDF/Image/GIF.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/lib/PDF/Image/GIF.pm?rev=20675&op=file
==============================================================================
--- branches/upstream/libpdf-create-perl/current/lib/PDF/Image/GIF.pm (added)
+++ branches/upstream/libpdf-create-perl/current/lib/PDF/Image/GIF.pm Wed Jun 4 16:44:53 2008
@@ -1,0 +1,583 @@
+# -*- mode: Perl -*-
+
+# PDF::Image::GIF - GIF image support
+# Author: Michael Gross <info at mdgrosse.net>
+# Version: 0.07
+# Copyright 2001 Michael Gross <info at mdgrosse.net>
+# Copyright 2007 Markus Baertschi <markus at markus.org>
+#
+# 10.9.2001 - Bugfix for Perl 5.6
+# 27.11.2001 - Bugfix, now also works on Windows (binmode)
+# 03.09.2007 0.07 Markus
+# - Added error checking after file open
+# 31.05.2008 1.00 Markus Baertschi
+# - Chnaged version to 1.00 for correlation with PDF::Create
+
+package PDF::Image::GIF;
+use strict;
+use vars qw(@ISA @EXPORT $VERSION $DEBUG);
+use Exporter;
+use FileHandle;
+
+ at ISA = qw(Exporter);
+ at EXPORT = qw();
+$VERSION = 1.00;
+$DEBUG = 0;
+
+sub new {
+ my $self = {};
+
+ $self->{private} = {};
+ $self->{colorspace} = 0;
+ $self->{width} = 0;
+ $self->{height} = 0;
+ $self->{colorspace} = "DeviceRGB";
+ $self->{colorspacedata} = "";
+ $self->{colorspacesize} = 0;
+ $self->{filename} = "";
+ $self->{error} = "";
+ $self->{imagesize} = 0;
+ $self->{transparent} = 0;
+ $self->{filter} = ["LZWDecode"];
+ $self->{decodeparms} = {'EarlyChange' => 0};
+ $self->{private}->{interlaced} = 0;
+
+ bless($self);
+ return $self;
+}
+
+sub LZW {
+ my $self = shift;
+ my $data = shift;
+ my $result = "";
+ my $prefix = "";
+ my $c;
+ my %hash;
+ my $num;
+ my $codesize = 9;
+
+ #init hash-table
+ for ($num=0; $num<256; $num++) {
+ $hash{chr($num)} = $num;
+ }
+
+ #start with a clear
+ $num = 258;
+ my $currentvalue = 256;
+ my $bits = 9;
+
+ my $pos = 0;
+ while ($pos < length($data)) {
+ $c = substr($data, $pos, 1);
+
+ if (exists($hash{$prefix . $c})) {
+ $prefix.=$c;
+ } else {
+ #save $hash{$prefix}
+ $currentvalue<<=$codesize;
+ $currentvalue|=$hash{$prefix};
+ $bits+=$codesize;
+ while ($bits >= 8) {
+ $result.=chr(($currentvalue >> ($bits-8)) & 255);
+ $bits-=8;
+ $currentvalue&=(1 << $bits) - 1;
+ }
+
+ $hash{$prefix . $c} = $num;
+ $prefix = $c;
+ $num++;
+
+ #increase code size?
+ if ($num==513 || $num==1025 || $num==2049) {
+ $codesize++;
+ }
+
+ #hash table overflow?
+ if ($num==4097) {
+ #save clear
+ $currentvalue<<=$codesize;
+ $currentvalue|=256;
+ $bits+=$codesize;
+ while ($bits >= 8) {
+ $result.=chr(($currentvalue >> ($bits-8)) & 255);
+ $bits-=8;
+ $currentvalue&=(1 << $bits) - 1;
+ }
+
+ #reset hash table
+ $codesize = 9;
+ %hash = ();
+ for ($num=0; $num<256; $num++) {
+ $hash{chr($num)} = $num;
+ }
+ $num=258;
+ }
+ }
+ $pos++;
+ }
+
+ #save value for prefix
+ $currentvalue<<=$codesize;
+ $currentvalue|=$hash{$prefix};
+ $bits+=$codesize;
+ while ($bits >= 8) {
+ $result.=chr(($currentvalue >> ($bits-8)) & 255);
+ $bits-=8;
+ $currentvalue&=(1 << $bits) - 1;
+ }
+
+ #save eoi
+ $currentvalue<<=$codesize;
+ $currentvalue|=257;
+ $bits+=$codesize;
+ while ($bits >= 8) {
+ $result.=chr(($currentvalue >> ($bits-8)) & 255);
+ $bits-=8;
+ $currentvalue&=(1 << $bits) - 1;
+ }
+
+ #save remainder in $currentvalue
+ if ($bits > 0) {
+ $currentvalue = $currentvalue << (8-$bits);
+ $result.=chr($currentvalue & 255);
+ }
+
+ $result;
+}
+
+
+sub UnLZW {
+ my $self = shift;
+ my $data = shift;
+ my $result = "";
+
+ my $bits = 0;
+ my $currentvalue = 0;
+ my $codesize = 9;
+ my $pos = 0;
+
+ my $prefix = "";
+ my $suffix;
+ my @table;
+
+ #initialize lookup-table
+ my $num;
+ for ($num=0; $num<256; $num++) {
+ $table[$num] = chr($num);
+ }
+ $table[256] = "";
+
+ $num = 257;
+
+ my $c1;
+ #get first word
+ while ($bits < $codesize) {
+ my $d = ord(substr($data, $pos, 1));
+ $currentvalue = ($currentvalue<<8) + $d;
+ $bits+=8;
+ $pos++;
+ }
+ my $c2 = $currentvalue >> ($bits - $codesize);
+ $bits-=$codesize;
+ my $mask = (1 << $bits) - 1;
+ $currentvalue = $currentvalue & $mask;
+
+
+ DECOMPRESS: while ($pos < length($data)) {
+ $c1 = $c2;
+
+ #get next word
+ while ($bits < $codesize) {
+ my $d = ord(substr($data, $pos, 1));
+ $currentvalue = ($currentvalue<<8) + $d;
+ $bits+=8;
+ $pos++;
+ }
+ $c2 = $currentvalue >> ($bits - $codesize);
+ $bits-=$codesize;
+ $mask = (1 << $bits) - 1;
+ $currentvalue = $currentvalue & $mask;
+
+ #clear code?
+ if ($c2 == 256) {
+ $result.=$table[$c1];
+ $#table = 256;
+ $codesize = 9;
+ $num = 257;
+ next DECOMPRESS;
+ }
+
+ #End Of Image?
+ if ($c2 == 257) {
+ last DECOMPRESS;
+ }
+
+ #get prefix
+ if ($c1 < $num) {
+ $prefix = $table[$c1];
+ } else {
+ print "Compression Error ($c1>=$num)\n";
+ }
+
+ #write prefix
+ $result.=$prefix;
+
+ #get suffix
+ if ($c2 < $num) {
+ $suffix = substr($table[$c2], 0, 1);
+ } elsif ($c2 == $num) {
+ $suffix = substr($prefix, 0, 1);
+ } else {
+ print "Compression Error ($c2>$num)\n";
+ }
+
+ #new table entry is prefix.suffix
+ $table[$num] = $prefix . $suffix;
+
+ #next table entry
+ $num++;
+
+ #increase code size?
+ if ($num==512 || $num==1024 || $num==2048) {
+ $codesize++;
+ }
+ }
+ $result.=$table[$c1];
+
+ $result;
+}
+
+sub UnInterlace {
+ my $self = shift;
+ my $data = shift;
+ my $row;
+ my @result;
+ my $width = $self->{width};
+ my $height = $self->{height};
+ my $idx = 0;
+
+ #Pass 1 - every 8th row, starting with row 0
+ $row = 0;
+ while ($row < $height) {
+ $result[$row] = substr($data, $idx*$width, $width);
+ $row+=8;
+ $idx++;
+ }
+
+ #Pass 2 - every 8th row, starting with row 4
+ $row = 4;
+ while ($row < $height) {
+ $result[$row] = substr($data, $idx*$width, $width);
+ $row+=8;
+ $idx++;
+ }
+
+ #Pass 3 - every 4th row, starting with row 2
+ $row = 2;
+ while ($row < $height) {
+ $result[$row] = substr($data, $idx*$width, $width);
+ $row+=4;
+ $idx++;
+ }
+
+ #Pass 4 - every 2th row, starting with row 1
+ $row = 1;
+ while ($row < $height) {
+ $result[$row] = substr($data, $idx*$width, $width);
+ $row+=2;
+ $idx++;
+ }
+
+ join('', @result);
+}
+
+sub GetDataBlock {
+ my $self = shift;
+ my $fh = shift;
+ my $s;
+ my $count;
+ my $buf;
+ read $fh, $s, 1;
+ $count = unpack("C", $s);
+
+ if ($count) {
+ read $fh, $buf, $count;
+ }
+
+ ($count, $buf);
+}
+
+sub ReadColorMap {
+ my $self = shift;
+ my $fh = shift;
+ read $fh, $self->{'colorspacedata'}, 3 * $self->{'colormapsize'};
+ 1;
+}
+
+sub DoExtension {
+ my $self = shift;
+ my $label = shift;
+ my $fh = shift;
+ my $res;
+ my $buf;
+ my $c;
+ my $c2;
+ my $c3;
+
+ if ($label eq "\001") { #Plain Text Extension
+ } elsif (ord($label)==0xFF) { #Application Extension
+ } elsif (ord($label)==0xFE) { #Comment Extension
+ } elsif (ord($label)==0xF9) { #Grapgic Control Extension
+ ($res, $buf) = $self->GetDataBlock($fh); #(p, image, (unsigned char*) buf);
+ ($c, $c2, $c2, $c3) = unpack("CCCC", $buf);
+ if ($c && 0x1 != 0) {
+ $self->{transparent}=1;
+ $self->{mask}=$c3;
+ }
+ }
+
+ BLOCK: while (1) {
+ ($res, $buf) = $self->GetDataBlock($fh);
+ if ($res == 0) {
+ last BLOCK;
+ }
+ }
+
+ 1;
+}
+
+sub Open {
+ my $self = shift;
+ my $filename = shift;
+
+ my $PDF_STRING_GIF = "\107\111\106";
+ my $PDF_STRING_87a = "\070\067\141";
+ my $PDF_STRING_89a = "\070\071\141";
+ my $LOCALCOLORMAP = 0x80;
+ my $INTERLACE = 0x40;
+
+ my $s;
+ my $c;
+ my $ar;
+ my $flags;
+
+ $self->{filename} = $filename;
+ my $fh = new FileHandle "$filename";
+ if (!defined $fh) { $self->{error} = "PDF::Image::GIF.pm: $filename: $!"; return 0 }
+ binmode $fh;
+ read $fh, $s, 3;
+ if ($s ne $PDF_STRING_GIF) {
+ close $fh;
+ $self->{error} = "PDF::Image::GIF.pm: Not a gif file.";
+ return 0;
+ }
+
+ read $fh, $s, 3;
+ if ($s ne $PDF_STRING_87a && $s ne $PDF_STRING_89a) {
+ close $fh;
+ $self->{error} = "PDF::Image::GIF.pm: GIF version $s not supported.";
+ return 0;
+ }
+
+ read $fh, $s, 7;
+ ($self->{width}, $self->{height}, $flags, $self->{private}->{background}, $ar) = unpack("SSCCC", $s);
+
+ $self->{colormapsize} = 2 << ($flags & 0x07);
+ $self->{colorspacesize} = 3 * $self->{colormapsize};
+ if ($flags & $LOCALCOLORMAP) {
+ if (!$self->ReadColorMap($fh)) {
+ close $fh;
+ $self->{error} = "PDF::Image::GIF.pm: Cant read color map.";
+ return 0;
+ }
+ }
+
+
+ if ($ar != 0) {
+ $self->{private}->{dpi_x} = -($ar + 15.0) / 64.0;
+ $self->{private}->{dpi_y} = -1.0;
+ }
+
+
+ my $imageCount = 0;
+ IMAGES: while (1) {
+ read $fh, $c, 1;
+ if ($c eq ";") { #GIF file terminator
+ close $fh;
+ $self->{error} = "PDF::Image::GIF.pm: Cant find image in gif file.";
+ return 0;
+ }
+
+ if ($c eq "!") { #Extension
+ read $fh, $c, 1;
+ $self->DoExtension($c, $fh);
+ next;
+ }
+
+ if ($c ne ",") { #must be comma
+ next; #ignore
+ }
+
+ $imageCount++;
+
+ read $fh, $s, 9;
+ my $x;
+ ($x, $c, $self->{width}, $self->{height}, $flags) = unpack("SSSSC", $s);
+
+ if ($flags && $INTERLACE) {
+ $self->{private}->{interlaced} = 1;
+ }
+
+ if ($flags & $LOCALCOLORMAP) {
+ if (!$self->ReadColorMap($fh)) {
+ close $fh;
+ $self->{error} = "PDF::Image::GIF.pm: Cant read color map.";
+ return 0;
+ }
+ }
+
+ read $fh, $s, 1; #read "LZW initial code size"
+ $self->{bpc} = unpack("C", $s);
+ if ($self->{bpc} != 8) {
+ close $fh;
+ $self->{error} = "PDF::Image::GIF.pm: LZW minimum code size other than 8 not supported.";
+ return 0;
+ }
+
+
+ if ($imageCount == 1) {
+ last IMAGES;
+ }
+
+ }
+
+ $self->{private}->{datapos} = tell($fh);
+ close $fh;
+
+ 1;
+}
+
+sub ReadData {
+ my $self = shift;
+
+
+ # init the LZW transformation vars
+ my $c_size = 9; # initial code size
+ my $t_size = 257; # initial "table" size
+ my $i_buff = 0; # input buffer
+ my $i_bits = 0; # input buffer empty
+ my $o_bits = 0; # output buffer empty
+ my $o_buff = 0;
+ my $c_mask;
+ my $bytes_available = 0;
+ my $n_bytes;
+ my $s;
+ my $c;
+ my $flag13;
+ my $code;
+ my $w_bits;
+
+ my $result = "";
+
+ my $fh = new FileHandle $self->{filename};
+ if (!defined $fh) { $self->{error} = "PDF::Image::GIF.pm: $self->{filename}: $!"; return 0 }
+ binmode $fh;
+ seek($fh, $self->{private}->{datapos}, 0);
+ my $pos = 0;
+ my $data;
+ read $fh, $data, (-s $self->{filename});
+
+ use integer;
+
+ $self->{imagesize} = 0;
+ BLOCKS: while (1) {
+ $s = substr($data, $pos, 1); $pos++;
+ $n_bytes = unpack("C", $s);
+ if (!$n_bytes) {
+ last BLOCKS;
+ }
+
+ $c_mask = (1 << $c_size) - 1;
+ $flag13 = 0;
+
+ BLOCK: while (1) {
+ $w_bits = $c_size; # number of bits to write
+ $code = 0;
+
+ #get at least c_size bits into i_buff
+ while ($i_bits < $c_size) {
+ if ($n_bytes == 0) {
+ last BLOCK;
+ }
+ $n_bytes--;
+ $s = substr($data, $pos, 1); $pos++;
+ $c = unpack("C", $s);
+ $i_buff |= $c << $i_bits; #EOF will be caught later
+ $i_bits += 8;
+ }
+
+ $code = $i_buff & $c_mask;
+
+ $i_bits -= $c_size;
+ $i_buff >>= $c_size;
+
+ if ($flag13 && $code!=256 && $code!=257) {
+ $self->{error} = "PDF::Image::GIF.pm: LZW code size overflow.";
+ return 0;
+ }
+
+ if ($o_bits > 0) {
+ $o_buff |= $code >> ($c_size - 8 + $o_bits);
+ $w_bits -= 8 - $o_bits;
+ $result.=chr($o_buff & 255);
+ }
+
+ if ($w_bits >= 8) {
+ $w_bits -= 8;
+ $result.=chr(($code >> $w_bits) & 255);
+ }
+ $o_bits = $w_bits;
+ if ($o_bits > 0) {
+ $o_buff = $code << (8 - $o_bits);
+ }
+
+ $t_size++;
+ if ($code == 256) { #clear code
+ $c_size = 9;
+ $c_mask = (1 << $c_size) - 1;
+ $t_size = 257;
+ $flag13 = 0;
+ }
+
+ if ($code == 257) { #end code
+ last BLOCK;
+ }
+
+ if ($t_size == (1 << $c_size)) {
+ if (++$c_size > 12) {
+ $c_size--;
+ $flag13 = 1;
+ } else {
+ $c_mask = (1 << $c_size) - 1;
+ }
+ }
+ } # while () for block
+ } # while () for all blocks
+
+ #interlaced?
+ if ($self->{private}->{interlaced}) {
+ #when interlaced first uncompress image
+ $result = $self->UnLZW($result);
+ #remove interlacing
+ $result = $self->UnInterlace($result);
+ #compress image again
+ $result = $self->LZW($result);
+ }
+
+ $self->{imagesize} = length($result);
+ $result;
+}
+
+
+1;
+
Added: branches/upstream/libpdf-create-perl/current/lib/PDF/Image/JPEG.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpdf-create-perl/current/lib/PDF/Image/JPEG.pm?rev=20675&op=file
==============================================================================
--- branches/upstream/libpdf-create-perl/current/lib/PDF/Image/JPEG.pm (added)
+++ branches/upstream/libpdf-create-perl/current/lib/PDF/Image/JPEG.pm Wed Jun 4 16:44:53 2008
@@ -1,0 +1,330 @@
+# -*- mode: Perl -*-
+
+# PDF::Image::JPEG - JPEG image support
+# Author: Michael Gross <info at mdgrosse.net>
+#
+# Copyright 2001 Michael Gross <info at mdgrosse.net>
+# Copyright 2007 Markus Baertschi <markus at markus.org>
+#
+# 27.11.2001 - Bugfix, now also works on Windows (binmode)
+# 03.09.2007 0.07 Markus Baertschi
+# - Added error checking on file open
+# 31.05.2008 1.00 Markus Baertschi <markus at markus.org>
+# - Set version to 1.00 to go with PDF::Create
+
+package PDF::Image::JPEG;
+use strict;
+use vars qw(@ISA @EXPORT $VERSION $DEBUG);
+use Exporter;
+use FileHandle;
+
+ at ISA = qw(Exporter);
+ at EXPORT = qw();
+$VERSION = 1.00;
+$DEBUG = 0;
+
+sub new {
+ my $self = {};
+
+ $self->{private} = {};
+ $self->{width} = 0;
+ $self->{height} = 0;
+ $self->{colorspacedata} = "";
+ $self->{colorspace} = "";
+ $self->{colorspacesize} = 0;
+ $self->{filename} = "";
+ $self->{error} = "";
+ $self->{imagesize} = 0;
+ $self->{transparent} = 0;
+ $self->{filter} = ["DCTDecode"];
+ $self->{decodeparms} = {};
+
+ bless($self);
+ return $self;
+}
+
+sub pdf_next_jpeg_marker {
+ my $self = shift;
+ my $fh = shift;
+ my $c = 0;
+ my $s;
+ my $M_ERROR = 0x100; #dummy marker, internal use only
+ #my $dbg = "";
+
+ while ($c == 0) {
+ while ($c != 0xFF) {
+ if (eof($fh)) {
+ #print "EOF in next_marker ($dbg)\n";
+ return $M_ERROR;
+ }
+ read $fh, $s, 1;
+ $c = unpack("C", $s);
+ #$dbg.=" " . sprintf("%x", $c);
+ }
+
+ while ($c == 0xFF) {
+ if (eof($fh)) {
+ #print "EOF in next_marker ($dbg)\n";
+ return $M_ERROR;
+ }
+ read $fh, $s, 1;
+ $c = unpack("C", $s);
+ #$dbg.=" " . sprintf("%x", $c);
+ }
+ }
+
+ #print "next_marker: $dbg\n";
+ return $c;
+}
+
+sub Open {
+ my $self = shift;
+ my $filename = shift;
+ $self->{filename} = $filename;
+
+ my $M_SOF0 = 0xc0; # baseline DCT
+ my $M_SOF1 = 0xc1; # extended sequential DCT
+ my $M_SOF2 = 0xc2; # progressive DCT
+ my $M_SOF3 = 0xc3; # lossless (sequential)
+
+ my $M_SOF5 = 0xc5; # differential sequential DCT
+ my $M_SOF6 = 0xc6; # differential progressive DCT
+ my $M_SOF7 = 0xc7; # differential lossless
+
+ my $M_JPG = 0xc8; # JPEG extensions
+ my $M_SOF9 = 0xc9; # extended sequential DCT
+ my $M_SOF10 = 0xca; # progressive DCT
+ my $M_SOF11 = 0xcb; # lossless (sequential)
+
+ my $M_SOF13 = 0xcd; # differential sequential DCT
+ my $M_SOF14 = 0xce; # differential progressive DCT
+ my $M_SOF15 = 0xcf; # differential lossless
+
+ my $M_DHT = 0xc4; # define Huffman tables
+
+ my $M_DAC = 0xcc; # define arithmetic conditioning table
+
+ my $M_RST0 = 0xd0; # restart
+ my $M_RST1 = 0xd1; # restart
+ my $M_RST2 = 0xd2; # restart
+ my $M_RST3 = 0xd3; # restart
+ my $M_RST4 = 0xd4; # restart
+ my $M_RST5 = 0xd5; # restart
+ my $M_RST6 = 0xd6; # restart
+ my $M_RST7 = 0xd7; # restart
+
+ my $M_SOI = 0xd8; # start of image
+ my $M_EOI = 0xd9; # end of image
+ my $M_SOS = 0xda; # start of scan
+ my $M_DQT = 0xdb; # define quantization tables
+ my $M_DNL = 0xdc; # define number of lines
+ my $M_DRI = 0xdd; # define restart interval
+ my $M_DHP = 0xde; # define hierarchical progression
+ my $M_EXP = 0xdf; # expand reference image(s)
+
+ my $M_APP0 = 0xe0; # application marker, used for JFIF
+ my $M_APP1 = 0xe1; # application marker
+ my $M_APP2 = 0xe2; # application marker
+ my $M_APP3 = 0xe3; # application marker
+ my $M_APP4 = 0xe4; # application marker
+ my $M_APP5 = 0xe5; # application marker
+ my $M_APP6 = 0xe6; # application marker
+ my $M_APP7 = 0xe7; # application marker
+ my $M_APP8 = 0xe8; # application marker
+ my $M_APP9 = 0xe9; # application marker
+ my $M_APP10 = 0xea; # application marker
+ my $M_APP11 = 0xeb; # application marker
+ my $M_APP12 = 0xec; # application marker
+ my $M_APP13 = 0xed; # application marker
+ my $M_APP14 = 0xee; # application marker, used by Adobe
+ my $M_APP15 = 0xef; # application marker
+
+ my $M_JPG0 = 0xf0; # reserved for JPEG extensions
+ my $M_JPG13 = 0xfd; # reserved for JPEG extensions
+ my $M_COM = 0xfe; # comment
+
+ my $M_TEM = 0x01; # temporary use
+
+ my $M_ERROR = 0x100; #dummy marker, internal use only
+
+
+ my $b;
+ my $c;
+ my $s;
+ my $i;
+ my $length;
+ my $APP_MAX = 255;
+ my $appstring;
+ my $SOF_done = 0;
+ my $mask = -1;
+ my $adobeflag = 0;
+ my $components = 0;
+
+ my $fh = new FileHandle $filename;
+ if (!defined $fh) { $self->{error} = "PDF::Image::JPEG.pm: $filename: $!"; return 0 }
+ binmode $fh;
+
+ #Tommy's special trick for Macintosh JPEGs: simply skip some
+ # hundred bytes at the beginning of the file!
+ MACTrick: while (!eof($fh)) {
+ $c = 0;
+ while (!eof($fh) && $c!=0xFF) { # skip if not FF
+ read $fh, $s, 1;
+ $c = unpack("C", $s);
+ }
+
+ if (eof($fh)) {
+ close($fh);
+ $self->{error} = "PDF::Image::JPEG.pm: Not a JPEG file.";
+ return 0;
+ }
+
+ while (!eof($fh) && $c==0xFF) { # skip repeated FFs
+ read $fh, $s, 1;
+ $c = unpack("C", $s);
+ }
+
+ $self->{private}->{datapos} = tell($fh) - 2;
+
+ if ($c == $M_SOI) {
+ seek($fh, $self->{private}->{datapos}, 0);
+ last MACTrick;
+ }
+ };
+
+ my $BOGUS_LENGTH = 768;
+ #Heuristics: if we are that far from the start chances are
+ # it is a TIFF file with embedded JPEG data which we cannot
+ # handle - regard as hopeless...
+ if (eof($fh) || $self->{private}->{datapos} > $BOGUS_LENGTH) {
+ close($fh);
+ $self->{error} = "PDF::Image::JPEG.pm: Not a JPEG file.";
+ return 0;
+ }
+
+ #process JPEG markers */
+ JPEGMarkers: while (!$SOF_done && ($c = $self->pdf_next_jpeg_marker($fh)) != $M_EOI) {
+ #print "Marker: " . sprintf("%x", $c) . "\n";
+ if ($c==$M_ERROR || $c==$M_SOF3 || $c==$M_SOF5 || $c==$M_SOF6 || $c==$M_SOF7 || $c==$M_SOF9 || $c==$M_SOF11 || $c==$M_SOF13 || $c==$M_SOF14 || $c==$M_SOF15) {
+ close($fh);
+ $self->{error} = "PDF::Image::JPEG.pm: JPEG compression " . ord($c) . " not supported in PDF 1.3.",
+ return 0;
+ }
+
+ if ($c==$M_SOF2 || $c==$M_SOF10) {
+ close($fh);
+ $self->{error} = "PDF::Image::JPEG.pm: JPEG compression " . ord($c) . " not supported in PDF 1.2.",
+ return 0;
+ }
+
+ if ($c==$M_SOF0 || $c==$M_SOF1) {
+ read $fh, $s, 12;
+ ($c, $self->{bpc}, $self->{height}, $self->{width}, $components) = unpack("nCnnC", $s);
+
+ $SOF_done = 1;
+ last JPEGMarkers;
+ } elsif ($c==$M_APP0) {
+ read $fh, $s, 2;
+ $length = unpack("n", $s) - 2;
+ read $fh, $appstring, $length;
+
+ #Check for JFIF application marker and read density values
+ # per JFIF spec version 1.02.
+
+ my $ASPECT_RATIO = 0; #JFIF unit byte: aspect ratio only
+ my $DOTS_PER_INCH = 1; #JFIF unit byte: dots per inch
+ my $DOTS_PER_CM = 2; #JFIF unit byte: dots per cm
+
+ if ($length >= 12 && $appstring=~/^JFIF/) {
+ ($c, $c, $c, $c, $c, $c, $c, $self->{private}->{unit}, $self->{dpi_x}, $self->{dpi_y}) = unpack("CCCCCCCCnn", $appstring);
+ if ($self->{dpi_x} <= 0 || $self->{dpi_y} <= 0) {
+ $self->{dpi_x} = 0;
+ $self->{dpi_y} = 0;
+ } elsif ($self->{private}->{unit} == $DOTS_PER_INCH) {
+ } elsif ($self->{private}->{unit} == $DOTS_PER_CM) {
+ $self->{dpi_x} *= 2.54;
+ $self->{dpi_y} *= 2.54;
+ } elsif ($self->{private}->{unit} == $ASPECT_RATIO) {
+ $self->{dpi_x} *= -1;
+ $self->{dpi_y} *= -1;
+ }
+ }
+ } elsif ($c==$M_APP14) { #check for Adobe marker
+ read $fh, $s, 2;
+ $length = unpack("n", $s) - 2;
+
+ read $fh, $appstring, $length;
+
+ #Check for Adobe application marker. It is known (per Adobe's TN5116)
+ #to contain the string "Adobe" at the start of the APP14 marker.
+
+ if ($length >= 10 && $appstring=~/^Adobe/) {
+ $adobeflag = 1;
+ }
+ } elsif ($c==$M_SOI || $c==$M_EOI || $c==$M_TEM || $c==$M_RST0 || $c==$M_RST1 || $c==$M_RST2 || $c==$M_RST3 || $c==$M_RST4 || $c==$M_RST5 || $c==$M_RST6 || $c==$M_RST7) {
+ #no parameters --> ignore
+ } else {
+ #skip variable length markers
+ read $fh, $s, 2;
+ $length = unpack("n", $s) - 2;
+ read $fh, $s, $length;
+ }
+ }
+
+ if ($self->{height} <= 0 || $self->{width} <= 0 || $components <= 0) {
+ close($fh);
+ $self->{error} = "PDF::Image::JPEG.pm: Bad image parameters in JPEG file.";
+ return 0;
+ }
+
+ if ($self->{bpc} != 8) {
+ close($fh);
+ $self->{error} = "PDF::Image::JPEG.pm: Bad bpc in JPEG file.";
+ return 0;
+ }
+
+ if ($components==1) {
+ $self->{colorspace} = "DeviceGray";
+ } elsif ($components==3) {
+ $self->{colorspace} = "DeviceRGB";
+ } elsif ($components==4) {
+ $self->{colorspace} = "DeviceCMYK";
+ #special handling of Photoshop-generated CMYK JPEG files
+ if ($adobeflag) {
+ $self->{invert} = 1;
+ }
+ } else {
+ close($fh);
+ $self->{error} = "PDF::Image::JPEG.pm: Unknown number of color components in JPEG file.",
+ return 0;
+ }
+
+ close($fh);
+
+ 1;
+}
+
+sub ReadData {
+ my $self = shift;
+ my $s = "";
+ my $result;
+ my $JPEG_BUFSIZE = 1024;
+ my $fh = new FileHandle $self->{filename};
+ if (!defined $fh) { $self->{error} = "PDF::Image::JPEG.pm: $self->{filename}: $!"; return 0 }
+ binmode $fh;
+ seek($fh, $self->{private}->{datapos}, 0);
+
+ while (read($fh, $s, $JPEG_BUFSIZE) > 0) {
+ $result.=$s;
+ }
+
+ $self->{imagesize} = length($result);
+
+ close $fh;
+
+ $result;
+}
+
+
+1;
+
More information about the Pkg-perl-cvs-commits
mailing list