init III
This commit is contained in:
92
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Form.pm
Normal file
92
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Form.pm
Normal file
@@ -0,0 +1,92 @@
|
||||
package PDF::API2::Resource::XObject::Form;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
use PDF::API2::Basic::PDF::Utils;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
PDF::API2::Resource::XObject::Form - Base class for external form objects
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item $form = PDF::API2::Resource::XObject::Form->new($pdf)
|
||||
|
||||
Creates a form resource.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ($class, $pdf, $name) = @_;
|
||||
my $self = $class->SUPER::new($pdf, $name);
|
||||
|
||||
$self->subtype('Form');
|
||||
$self->{'FormType'} = PDFNum(1);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
=item ($llx, $lly, $urx, $ury) = $form->bbox($llx, $lly, $urx, $ury)
|
||||
|
||||
Get or set the coordinates of the form object's bounding box
|
||||
|
||||
=cut
|
||||
|
||||
sub bbox {
|
||||
my $self = shift();
|
||||
|
||||
if (scalar @_) {
|
||||
$self->{'BBox'} = PDFArray(map { PDFNum($_) } @_);
|
||||
}
|
||||
|
||||
return map { $_->val() } $self->{'BBox'}->elements();
|
||||
}
|
||||
|
||||
=item $resource = $form->resource($type, $key)
|
||||
|
||||
=item $form->resource($type, $key, $object, $force)
|
||||
|
||||
Get or add a resource required by the form's contents, such as a Font, XObject, ColorSpace, etc.
|
||||
|
||||
By default, an existing C<$key> will not be overwritten. Set C<$force> to override this behavior.
|
||||
|
||||
=cut
|
||||
|
||||
sub resource {
|
||||
my ($self, $type, $key, $object, $force) = @_;
|
||||
# we are a self-contained content stream.
|
||||
|
||||
$self->{'Resources'} ||= PDFDict();
|
||||
|
||||
my $dict = $self->{'Resources'};
|
||||
$dict->realise() if ref($dict) =~ /Objind$/;
|
||||
|
||||
$dict->{$type} ||= PDFDict();
|
||||
$dict->{$type}->realise() if ref($dict->{$type}) =~ /Objind$/;
|
||||
|
||||
unless (defined $object) {
|
||||
return $dict->{$type}->{$key} || undef;
|
||||
}
|
||||
|
||||
if ($force) {
|
||||
$dict->{$type}->{$key} = $object;
|
||||
}
|
||||
else {
|
||||
$dict->{$type}->{$key} ||= $object;
|
||||
}
|
||||
|
||||
return $dict;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,190 @@
|
||||
package PDF::API2::Resource::XObject::Form::BarCode;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Form::Hybrid';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
use PDF::API2::Util;
|
||||
use PDF::API2::Basic::PDF::Utils;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
PDF::API2::Resource::XObject::Form::BarCode - Base class for one-dimensional barcodes
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item $barcode = PDF::API2::Resource::XObject::Form::BarCode->new($pdf, %options)
|
||||
|
||||
Creates a barcode form resource.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ($class, $pdf, %options) = @_;
|
||||
my $self = $class->SUPER::new($pdf);
|
||||
|
||||
$self->{' bfont'} = $options{'-font'};
|
||||
|
||||
$self->{' umzn'} = $options{'-umzn'} || 0; # (u)pper (m)ending (z)o(n)e
|
||||
$self->{' lmzn'} = $options{'-lmzn'} || 0; # (l)ower (m)ending (z)o(n)e
|
||||
$self->{' zone'} = $options{'-zone'} || 0; # barcode height
|
||||
$self->{' quzn'} = $options{'-quzn'} || 0; # (qu)iet (z)o(n)e
|
||||
$self->{' ofwt'} = $options{'-ofwt'} || 0.01; # (o)ver(f)low (w)id(t)h
|
||||
$self->{' fnsz'} = $options{'-fnsz'}; # (f)o(n)t(s)i(z)e
|
||||
$self->{' spcr'} = $options{'-spcr'} || ''; # (sp)a(c)e(r) between chars in label
|
||||
$self->{' mils'} = $options{'-mils'} || 1000/72; # single barcode unit width. 1 mil = 1/1000 of one inch. 1000/72 - for backward compatibility
|
||||
$self->{' color'} = $options{'-color'} || 'black'; # barcode color
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
my %bar_widths = (
|
||||
0 => 0,
|
||||
1 => 1, 'a' => 1, 'A' => 1,
|
||||
2 => 2, 'b' => 2, 'B' => 2,
|
||||
3 => 3, 'c' => 3, 'C' => 3,
|
||||
4 => 4, 'd' => 4, 'D' => 4,
|
||||
5 => 5, 'e' => 5, 'E' => 5,
|
||||
6 => 6, 'f' => 6, 'F' => 6,
|
||||
7 => 7, 'g' => 7, 'G' => 7,
|
||||
8 => 8, 'h' => 8, 'H' => 8,
|
||||
9 => 9, 'i' => 9, 'I' => 9,
|
||||
);
|
||||
|
||||
sub encode {
|
||||
my ($self, $string) = @_;
|
||||
my @bars = map { [ $self->encode_string($_), $_ ] } split //, $string;
|
||||
return @bars;
|
||||
}
|
||||
|
||||
sub encode_string {
|
||||
my ($self, $string) = @_;
|
||||
|
||||
my $bar;
|
||||
foreach my $character (split //, $string) {
|
||||
$bar .= $self->encode_char($character);
|
||||
}
|
||||
return $bar;
|
||||
}
|
||||
|
||||
sub drawbar {
|
||||
my $self = shift();
|
||||
my @sets = @{shift()};
|
||||
my $caption = shift();
|
||||
|
||||
$self->fillcolor($self->{' color'});
|
||||
$self->strokecolor($self->{' color'});
|
||||
$self->linedash();
|
||||
|
||||
my $x = $self->{' quzn'};
|
||||
my $is_space_next = 0;
|
||||
my $wdt_factor = $self->{' mils'} / 1000 * 72;
|
||||
foreach my $set (@sets) {
|
||||
my ($code, $label);
|
||||
if (ref($set)) {
|
||||
($code, $label) = @{$set};
|
||||
}
|
||||
else {
|
||||
$code = $set;
|
||||
$label = undef;
|
||||
}
|
||||
|
||||
my $code_width = 0;
|
||||
my ($font_size, $y_label);
|
||||
foreach my $bar (split //, $code) {
|
||||
my $bar_width = $bar_widths{$bar} * $wdt_factor;
|
||||
|
||||
my ($y0, $y1);
|
||||
if ($bar =~ /[0-9]/) {
|
||||
$y0 = $self->{' quzn'} + $self->{' lmzn'};
|
||||
$y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
|
||||
$y_label = $self->{' quzn'};
|
||||
$font_size = $self->{' fnsz'} || $self->{' lmzn'};
|
||||
}
|
||||
elsif ($bar =~ /[a-z]/) {
|
||||
$y0 = $self->{' quzn'};
|
||||
$y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
|
||||
$y_label = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
|
||||
$font_size = $self->{' fnsz'} || $self->{' umzn'};
|
||||
}
|
||||
elsif ($bar =~ /[A-Z]/) {
|
||||
$y0 = $self->{' quzn'};
|
||||
$y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'};
|
||||
$font_size = $self->{' fnsz'} || $self->{' umzn'};
|
||||
$y_label = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'} - $font_size;
|
||||
}
|
||||
else {
|
||||
$y0 = $self->{' quzn'} + $self->{' lmzn'};
|
||||
$y1 = $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
|
||||
$y_label = $self->{' quzn'};
|
||||
$font_size = $self->{' fnsz'} || $self->{' lmzn'};
|
||||
}
|
||||
|
||||
unless ($is_space_next or $bar eq '0') {
|
||||
$self->linewidth($bar_width - $self->{' ofwt'});
|
||||
$self->move($x + $code_width + $bar_width / 2, $y0);
|
||||
$self->line($x + $code_width + $bar_width / 2, $y1);
|
||||
$self->stroke();
|
||||
}
|
||||
$is_space_next = not $is_space_next;
|
||||
|
||||
$code_width += $bar_width;
|
||||
}
|
||||
|
||||
if (defined($label) and $self->{' lmzn'}) {
|
||||
$label = join($self->{' spcr'}, split //, $label);
|
||||
$self->textstart();
|
||||
$self->translate($x + ($code_width / 2), $y_label);
|
||||
$self->font($self->{' bfont'}, $font_size);
|
||||
$self->text_center($label);
|
||||
$self->textend();
|
||||
}
|
||||
|
||||
$x += $code_width;
|
||||
}
|
||||
|
||||
$x += $self->{' quzn'};
|
||||
|
||||
if (defined $caption) {
|
||||
my $font_size = $self->{' fnsz'} || $self->{' lmzn'};
|
||||
my $y_caption = $self->{' quzn'} - $font_size;
|
||||
$self->textstart();
|
||||
$self->translate($x / 2, $y_caption);
|
||||
$self->font($self->{' bfont'}, $font_size);
|
||||
$self->text_center($caption);
|
||||
$self->textend();
|
||||
}
|
||||
|
||||
$self->{' w'} = $x;
|
||||
$self->{' h'} = 2 * $self->{' quzn'} + $self->{' lmzn'} + $self->{' zone'} + $self->{' umzn'};
|
||||
$self->bbox(0, 0, $self->{' w'}, $self->{' h'});
|
||||
}
|
||||
|
||||
=item $width = $barcode->width()
|
||||
|
||||
=cut
|
||||
|
||||
sub width {
|
||||
my $self = shift();
|
||||
return $self->{' w'};
|
||||
}
|
||||
|
||||
=item $height = $barcode->height()
|
||||
|
||||
=cut
|
||||
|
||||
sub height {
|
||||
my $self = shift();
|
||||
return $self->{' h'};
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,36 @@
|
||||
package PDF::API2::Resource::XObject::Form::BarCode::codabar;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Form::BarCode';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
sub new {
|
||||
my ($class, $pdf, %options) = @_;
|
||||
my $self = $class->SUPER::new($pdf, %options);
|
||||
|
||||
my @bars = $self->encode($options{'-code'});
|
||||
|
||||
$self->drawbar([@bars], $options{'caption'});
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
my $codabar = q|0123456789-$:/.+ABCD|;
|
||||
|
||||
my @barcodabar = qw(
|
||||
11111221 11112211 11121121 22111111 11211211
|
||||
21111211 12111121 12112111 12211111 21121111
|
||||
11122111 11221111 21112121 21211121 21212111
|
||||
11212121 aabbabaa ababaaba ababaaba aaabbbaa
|
||||
);
|
||||
|
||||
sub encode_char {
|
||||
my $self = shift();
|
||||
my $char = uc shift();
|
||||
return $barcodabar[index($codabar, $char)];
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,239 @@
|
||||
package PDF::API2::Resource::XObject::Form::BarCode::code128;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Form::BarCode';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
=head1 NAME
|
||||
|
||||
PDF::API2::Resource::XObject::Form::BarCode::code128 - Code 128 and EAN-128 barcode support
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item $res = PDF::API2::Resource::XObject::Form::BarCode::code128->new($pdf, %options)
|
||||
|
||||
Returns a code128 object. Use '-ean' to encode using EAN128 mode.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ($class, $pdf, %options) = @_;
|
||||
$class = ref($class) if ref($class);
|
||||
|
||||
my $self = $class->SUPER::new($pdf, %options);
|
||||
|
||||
my @bars;
|
||||
if ($options{'-ean'}) {
|
||||
@bars = $self->encode_ean128($options{'-code'});
|
||||
}
|
||||
else {
|
||||
@bars = $self->encode_128($options{'-type'}, $options{'-code'});
|
||||
}
|
||||
|
||||
$self->drawbar(\@bars, $options{'caption'});
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
# CODE-A Encoding Table
|
||||
my $code128a = q| !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_| . join('', map { chr($_) } (0..31)) . qq/\xf3\xf2\x80\xcc\xcb\xf4\xf1\x8a\x8b\x8c\xff/;
|
||||
|
||||
# CODE-B Encoding Table
|
||||
my $code128b = q| !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|.qq/|}~\x7f\xf3\xf2\x80\xcc\xf4\xca\xf1\x8a\x8b\x8c\xff/;
|
||||
|
||||
# CODE-C Encoding Table (00-99 are placeholders)
|
||||
my $code128c = ("\xfe" x 100) . qq/\xcb\xca\xf1\x8a\x8b\x8c\xff/;
|
||||
|
||||
# START A-C
|
||||
my $bar128Sa = "\x8a";
|
||||
my $bar128Sb = "\x8b";
|
||||
my $bar128Sc = "\x8c";
|
||||
|
||||
# FNC1-FNC4
|
||||
my $bar128F1 = "\xf1";
|
||||
my $bar128F2 = "\xf2";
|
||||
my $bar128F3 = "\xf3";
|
||||
my $bar128F4 = "\xf4";
|
||||
|
||||
# CODE A-C
|
||||
my $bar128Ca = "\xca";
|
||||
my $bar128Cb = "\xcb";
|
||||
my $bar128Cc = "\xcc";
|
||||
|
||||
# SHIFT
|
||||
my $bar128sh = "\x80";
|
||||
|
||||
# STOP
|
||||
my $bar128St = "\xff";
|
||||
|
||||
# Note: The stop code (last position) is longer than the other codes because it also has the
|
||||
# termination bar appended, rather than requiring it be added as a separate call.
|
||||
my @bar128 = qw(
|
||||
212222 222122 222221 121223 121322 131222 122213 122312 132212 221213
|
||||
221312 231212 112232 122132 122231 113222 123122 123221 223211 221132
|
||||
221231 213212 223112 312131 311222 321122 321221 312212 322112 322211
|
||||
212123 212321 232121 111323 131123 131321 112313 132113 132311 211313
|
||||
231113 231311 112133 112331 132131 113123 113321 133121 313121 211331
|
||||
231131 213113 213311 213131 311123 311321 331121 312113 312311 332111
|
||||
314111 221411 431111 111224 111422 121124 121421 141122 141221 112214
|
||||
112412 122114 122411 142112 142211 241211 221114 413111 241112 134111
|
||||
111242 121142 121241 114212 124112 124211 411212 421112 421211 212141
|
||||
214121 412121 111143 111341 131141 114113 114311 411113 411311 113141
|
||||
114131 311141 411131 b1a4a2 b1a2a4 b1a2c2 b3c1a1b
|
||||
);
|
||||
|
||||
sub encode_128_char_idx {
|
||||
my ($code, $char) = @_;
|
||||
my $index;
|
||||
|
||||
if (lc($code) eq 'a') {
|
||||
# Ignore CODE-A request if we're already in CODE-A
|
||||
return if $char eq $bar128Ca;
|
||||
|
||||
$index = index($code128a, $char);
|
||||
}
|
||||
elsif (lc($code) eq 'b') {
|
||||
# Ignore CODE-B request if we're already in CODE-B
|
||||
return if $char eq $bar128Cb;
|
||||
$index = index($code128b, $char);
|
||||
}
|
||||
elsif (lc($code) eq 'c') {
|
||||
# Ignore CODE-C request if we're already in CODE-C
|
||||
return if $char eq $bar128Cc;
|
||||
|
||||
if ($char =~ /^([0-9][0-9])$/) {
|
||||
$index = $1;
|
||||
}
|
||||
else {
|
||||
$index = index($code128c, $char);
|
||||
}
|
||||
}
|
||||
|
||||
return ($bar128[$index], $index);
|
||||
}
|
||||
|
||||
sub encode_128_char {
|
||||
my ($code, $char) = @_;
|
||||
my ($b) = encode_128_char_idx($code, $char);
|
||||
return $b;
|
||||
}
|
||||
|
||||
sub encode_128_string {
|
||||
my ($code, $string) = @_;
|
||||
my ($bar, $index, @bars, @checksum);
|
||||
my @characters = split(//, $string);
|
||||
|
||||
my $character;
|
||||
while (defined($character = shift @characters)) {
|
||||
if ($character =~ /[\xf1-\xf4]/) {
|
||||
# CODE-C doesn't have FNC2-FNC4
|
||||
if ($character =~ /[\xf2-\xf4]/ and $code eq 'c') {
|
||||
($bar, $index) = encode_128_char_idx($code, "\xCB");
|
||||
push @bars, $bar;
|
||||
push @checksum, $index;
|
||||
$code = 'b';
|
||||
}
|
||||
|
||||
($bar, $index) = encode_128_char_idx($code, $character);
|
||||
}
|
||||
elsif ($character =~ /[\xCA-\xCC]/) {
|
||||
($bar, $index) = encode_128_char_idx($code, $character);
|
||||
$code = ($character eq "\xCA" ? 'a' :
|
||||
$character eq "\xCB" ? 'b' : 'c');
|
||||
}
|
||||
else {
|
||||
if ($code ne 'c') {
|
||||
# SHIFT: Switch codes for the following character only
|
||||
if ($character eq $bar128sh) {
|
||||
($bar, $index) = encode_128_char_idx($code, $character);
|
||||
push @bars, $bar;
|
||||
push @checksum, $index;
|
||||
$character = shift(@characters);
|
||||
($bar, $index) = encode_128_char_idx($code eq 'a' ? 'b' : 'a', $character);
|
||||
}
|
||||
else {
|
||||
($bar, $index) = encode_128_char_idx($code, $character);
|
||||
}
|
||||
}
|
||||
else {
|
||||
$character .= shift(@characters) if $character =~ /\d/ and scalar @characters;
|
||||
if ($character =~ /^[^\d]*$/ or $character =~ /^\d[^\d]*$/) {
|
||||
($bar, $index) = encode_128_char_idx($code, "\xCB");
|
||||
push @bars, $bar;
|
||||
push @checksum, $index;
|
||||
$code = 'b';
|
||||
}
|
||||
if ($character =~ /^\d[^\d]*$/) {
|
||||
unshift(@characters, substr($character, 1, 1)) if length($character) > 1;
|
||||
$character = substr($character, 0, 1);
|
||||
}
|
||||
($bar, $index) = encode_128_char_idx($code, $character);
|
||||
}
|
||||
}
|
||||
$character = '' if $character =~ /[^\x20-\x7e]/;
|
||||
push @bars, [$bar, $character];
|
||||
push @checksum, $index;
|
||||
}
|
||||
return ([@bars], @checksum);
|
||||
}
|
||||
|
||||
sub encode_128 {
|
||||
my ($self, $code, $string) = @_;
|
||||
my @bars;
|
||||
my $checksum_value;
|
||||
|
||||
# Default to Code C if all characters are digits (and there are at
|
||||
# least two of them). Otherwise, default to Code B.
|
||||
$code ||= $string =~ /^\d{2,}$/ ? 'c' : 'b';
|
||||
|
||||
# Allow the character set to be passed as a capital letter
|
||||
# (consistent with the specification).
|
||||
$code = lc($code) if $code =~ /^[A-C]$/;
|
||||
|
||||
# Ensure a valid character set has been chosen.
|
||||
die "Character set must be A, B, or C (not '$code')" unless $code =~ /^[a-c]$/;
|
||||
|
||||
if ($code eq 'a') {
|
||||
push @bars, encode_128_char($code, $bar128Sa);
|
||||
$checksum_value = 103;
|
||||
}
|
||||
elsif ($code eq 'b') {
|
||||
push @bars, encode_128_char($code, $bar128Sb);
|
||||
$checksum_value = 104;
|
||||
}
|
||||
elsif ($code eq 'c') {
|
||||
push @bars, encode_128_char($code, $bar128Sc);
|
||||
$checksum_value = 105;
|
||||
}
|
||||
my ($bar, @checksum_values) = encode_128_string($code, $string);
|
||||
|
||||
push @bars, @{$bar};
|
||||
|
||||
# Calculate the checksum value
|
||||
foreach my $i (1 .. scalar @checksum_values) {
|
||||
$checksum_value += $i * $checksum_values[$i - 1];
|
||||
}
|
||||
$checksum_value %= 103;
|
||||
push @bars, $bar128[$checksum_value];
|
||||
push @bars, encode_128_char($code, $bar128St);
|
||||
|
||||
return @bars;
|
||||
}
|
||||
|
||||
sub encode_ean128 {
|
||||
my ($self, $string) = @_;
|
||||
$string =~ s/[^a-zA-Z\d]+//g;
|
||||
$string =~ s/(\d+)([a-zA-Z]+)/$1\xcb$2/g;
|
||||
$string =~ s/([a-zA-Z]+)(\d+)/$1\xcc$2/g;
|
||||
|
||||
return $self->encode_128('c', "\xf1$string");
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,113 @@
|
||||
package PDF::API2::Resource::XObject::Form::BarCode::code3of9;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Form::BarCode';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
sub new {
|
||||
my ($class, $pdf, %options) = @_;
|
||||
my $self = $class->SUPER::new($pdf, %options);
|
||||
|
||||
my @bars = encode_3of9($options{'-code'},
|
||||
$options{'-chk'} ? 1 : 0,
|
||||
$options{'-ext'} ? 1 : 0);
|
||||
|
||||
$self->drawbar([@bars], $options{'caption'});
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
my $code3of9 = q(0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%*);
|
||||
|
||||
my @bar3of9 = qw(
|
||||
1112212111 2112111121 1122111121 2122111111
|
||||
1112211121 2112211111 1122211111 1112112121
|
||||
2112112111 1122112111 2111121121 1121121121
|
||||
2121121111 1111221121 2111221111 1121221111
|
||||
1111122121 2111122111 1121122111 1111222111
|
||||
2111111221 1121111221 2121111211 1111211221
|
||||
2111211211 1121211211 1111112221 2111112211
|
||||
1121112211 1111212211 2211111121 1221111121
|
||||
2221111111 1211211121 2211211111 1221211111
|
||||
1211112121 2211112111 1221112111 1212121111
|
||||
1212111211 1211121211 1112121211 abaababaa1
|
||||
);
|
||||
|
||||
my @extended_map = (
|
||||
'%U', '$A', '$B', '$C', '$D', '$E', '$F', '$G', '$H', '$I',
|
||||
'$J', '$K', '$L', '$M', '$N', '$O', '$P', '$Q', '$R', '$S',
|
||||
'$T', '$U', '$V', '$W', '$X', '$Y', '$Z', '%A', '%B', '%C',
|
||||
'%D', '$E', ' ', '/A', '/B', '/C', '/D', '/E', '/F', '/G',
|
||||
'/H', '/I', '/J', '/K', '/L', '-', '.', '/O', '0', '1',
|
||||
'2', '3', '4', '5', '6', '7', '8', '9', '/Z', '%F',
|
||||
'%G', '%H', '%I', '%J', '%V', 'A', 'B', 'C', 'D', 'E',
|
||||
'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
|
||||
'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y',
|
||||
'Z', '%K', '%L', '%M', '%N', '%O', '%W', '+A', '+B', '+C',
|
||||
'+D', '+E', '+F', '+G', '+H', '+I', '+J', '+K', '+L', '+M',
|
||||
'+N', '+O', '+P', '+Q', '+R', '+S', '+T', '+U', '+V', '+W',
|
||||
'+X', '+Y', '+Z', '%P', '%Q', '%R', '%S', '%T'
|
||||
);
|
||||
|
||||
sub encode_3of9_char {
|
||||
my $character = shift();
|
||||
return $bar3of9[index($code3of9, $character)];
|
||||
}
|
||||
|
||||
sub encode_3of9_string {
|
||||
my ($string, $is_mod43) = @_;
|
||||
|
||||
my $bar;
|
||||
my $checksum = 0;
|
||||
foreach my $char (split //, $string) {
|
||||
$bar .= encode_3of9_char($char);
|
||||
$checksum += index($code3of9, $char);
|
||||
}
|
||||
|
||||
if ($is_mod43) {
|
||||
$checksum %= 43;
|
||||
$bar .= $bar3of9[$checksum];
|
||||
}
|
||||
|
||||
return $bar;
|
||||
}
|
||||
|
||||
# Deprecated (rolled into encode_3of9_string)
|
||||
sub encode_3of9_string_w_chk { return encode_3of9_string(shift(), 1); }
|
||||
|
||||
sub encode_3of9 {
|
||||
my ($string, $is_mod43, $is_extended) = @_;
|
||||
|
||||
my $display;
|
||||
unless ($is_extended) {
|
||||
$string = uc $string;
|
||||
$string =~ s/[^0-9A-Z\-\.\ \$\/\+\%]+//g;
|
||||
$display = $string;
|
||||
}
|
||||
else {
|
||||
# Extended Code39 supports all 7-bit ASCII characters
|
||||
$string =~ s/[^\x00-\x7f]//g;
|
||||
$display = $string;
|
||||
|
||||
# Encode, but don't display, non-printable characters
|
||||
$display =~ s/[[:cntrl:]]//g;
|
||||
|
||||
$string = join('', map { $extended_map[ord($_)] } split //, $string);
|
||||
}
|
||||
|
||||
my @bars;
|
||||
push @bars, encode_3of9_char('*');
|
||||
push @bars, [ encode_3of9_string($string, $is_mod43), $display ];
|
||||
push @bars, encode_3of9_char('*');
|
||||
return @bars;
|
||||
}
|
||||
|
||||
# Deprecated (rolled into encode_3of9)
|
||||
sub encode_3of9_w_chk { return encode_3of9(shift(), 1, 0); }
|
||||
sub encode_3of9_ext { return encode_3of9(shift(), 0, 1); }
|
||||
sub encode_3of9_ext_w_chk { return encode_3of9(shift(), 1, 1); }
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,78 @@
|
||||
package PDF::API2::Resource::XObject::Form::BarCode::ean13;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Form::BarCode';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
sub new {
|
||||
my ($class, $pdf, %options) = @_;
|
||||
my $self = $class->SUPER::new($pdf, %options);
|
||||
|
||||
my @bars = $self->encode($options{'-code'});
|
||||
|
||||
$self->drawbar([@bars], $options{'caption'});
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
my @ean_code_odd = qw(3211 2221 2122 1411 1132 1231 1114 1312 1213 3112);
|
||||
my @ean_code_even = qw(1123 1222 2212 1141 2311 1321 4111 2131 3121 2113);
|
||||
my @parity = qw(OOOOOO OOEOEE OOEEOE OOEEEO OEOOEE OEEOOE OEEEOO OEOEOE OEOEEO OEEOEO);
|
||||
|
||||
sub encode {
|
||||
my ($self, $string) = @_;
|
||||
my @digits = split //, $string;
|
||||
|
||||
# The first digit determines the even/odd pattern of the next six
|
||||
# digits, and is printed to the left of the barcode
|
||||
my $first = shift @digits;
|
||||
my @bars = (['07', $first]);
|
||||
|
||||
# Start Guard
|
||||
push @bars, 'a1a';
|
||||
|
||||
# Digits 2-7
|
||||
foreach my $i (0 .. 5) {
|
||||
my $digit = shift @digits;
|
||||
if (substr($parity[$first], $i, 1) eq 'O') {
|
||||
push @bars, [$ean_code_odd[$digit], $digit];
|
||||
}
|
||||
else {
|
||||
push @bars, [$ean_code_even[$digit], $digit];
|
||||
}
|
||||
}
|
||||
|
||||
# Center Guard
|
||||
push @bars, '1a1a1';
|
||||
|
||||
# Digits 8-13
|
||||
for (0..5) {
|
||||
my $digit = shift @digits;
|
||||
push @bars, [$ean_code_odd[$digit], $digit];
|
||||
}
|
||||
|
||||
# Right Guard
|
||||
push @bars, 'a1a';
|
||||
|
||||
return @bars;
|
||||
}
|
||||
|
||||
sub calculate_check_digit {
|
||||
my ($self, $string) = @_;
|
||||
my @digits = split //, $string;
|
||||
my $weight = 1;
|
||||
my $checksum = 0;
|
||||
foreach my $i (0..11) {
|
||||
$checksum += $digits[$i] * $weight;
|
||||
$weight = $weight == 1 ? 3 : 1;
|
||||
}
|
||||
|
||||
$checksum = $checksum % 10;
|
||||
return 0 unless $checksum;
|
||||
return 10 - $checksum;
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,62 @@
|
||||
package PDF::API2::Resource::XObject::Form::BarCode::int2of5;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Form::BarCode';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
# Interleaved 2 of 5 Barcodes
|
||||
|
||||
# Pairs of digits are encoded; the first digit is represented by five
|
||||
# bars, and the second digit is represented by five spaces interleaved
|
||||
# with the bars.
|
||||
|
||||
sub new {
|
||||
my ($class, $pdf, %options) = @_;
|
||||
my $self = $class->SUPER::new($pdf,%options);
|
||||
|
||||
my @bars = $self->encode($options{'-code'});
|
||||
|
||||
$self->drawbar([@bars], $options{'caption'});
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
my @bar25interleaved = qw(11221 21112 12112 22111 11212 21211 12211 11122 21121 12121);
|
||||
|
||||
sub encode {
|
||||
my ($self, $string) = @_;
|
||||
|
||||
# Remove any character that isn't a digit
|
||||
$string =~ s/[^0-9]//g;
|
||||
|
||||
# Prepend a 0 if there is an odd number of digits
|
||||
$string = '0' . $string if length($string) % 2;
|
||||
|
||||
# Start Code
|
||||
my @bars = ('aaaa');
|
||||
|
||||
# Encode pairs of digits
|
||||
my ($c1, $c2, $s1, $s2, $pair);
|
||||
while (length($string)) {
|
||||
($c1, $c2, $string) = split //, $string, 3;
|
||||
|
||||
$s1 = $bar25interleaved[$c1];
|
||||
$s2 = $bar25interleaved[$c2];
|
||||
$pair = '';
|
||||
foreach my $i (0 .. 4) {
|
||||
$pair .= substr($s1, $i, 1);
|
||||
$pair .= substr($s2, $i, 1);
|
||||
}
|
||||
push @bars, [$pair, ($c1 . $c2)];
|
||||
}
|
||||
|
||||
# Stop Code
|
||||
push @bars, 'baaa';
|
||||
|
||||
return @bars;
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,58 @@
|
||||
package PDF::API2::Resource::XObject::Form::Hybrid;
|
||||
|
||||
use base qw(PDF::API2::Content PDF::API2::Resource::XObject::Form);
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
use PDF::API2::Basic::PDF::Dict;
|
||||
use PDF::API2::Basic::PDF::Utils;
|
||||
use PDF::API2::Resource::XObject::Form;
|
||||
|
||||
sub new {
|
||||
my $self = PDF::API2::Resource::XObject::Form::new(@_);
|
||||
|
||||
$self->{' stream'} = '';
|
||||
$self->{' poststream'} = '';
|
||||
$self->{' font'} = undef;
|
||||
$self->{' fontsize'} = 0;
|
||||
$self->{' charspace'} = 0;
|
||||
$self->{' hscale'} = 100;
|
||||
$self->{' wordspace'} = 0;
|
||||
$self->{' lead'} = 0;
|
||||
$self->{' rise'} = 0;
|
||||
$self->{' render'} = 0;
|
||||
$self->{' matrix'} = [1, 0, 0, 1, 0, 0];
|
||||
$self->{' fillcolor'} = [0];
|
||||
$self->{' strokecolor'} = [0];
|
||||
$self->{' translate'} = [0, 0];
|
||||
$self->{' scale'} = [1, 1];
|
||||
$self->{' skew'} = [0, 0];
|
||||
$self->{' rotate'} = 0;
|
||||
$self->{' apiistext'} = 0;
|
||||
|
||||
$self->{'Resources'} = PDFDict();
|
||||
$self->{'Resources'}->{'ProcSet'} = PDFArray(map { PDFName($_) } qw(PDF Text ImageB ImageC ImageI));
|
||||
|
||||
$self->compressFlate();
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub outobjdeep {
|
||||
my ($self, @options) = @_;
|
||||
$self->textend() unless $self->{' nofilt'};
|
||||
|
||||
# Maintainer's Note: This list of keys isn't the same as the list
|
||||
# in new(). Should it be?
|
||||
foreach my $key (qw(api apipdf apipage font fontsize charspace hscale
|
||||
wordspace lead rise render matrix fillcolor
|
||||
strokecolor translate scale skew rotate)) {
|
||||
delete $self->{" $key"};
|
||||
}
|
||||
return PDF::API2::Basic::PDF::Dict::outobjdeep($self, @options);
|
||||
}
|
||||
|
||||
1;
|
||||
145
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Image.pm
Normal file
145
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Image.pm
Normal file
@@ -0,0 +1,145 @@
|
||||
package PDF::API2::Resource::XObject::Image;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
use PDF::API2::Basic::PDF::Utils;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
PDF::API2::Resource::XObject::Image - Base class for external raster image objects
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item $image = PDF::API2::Resource::XObject::Image->new($pdf, $name)
|
||||
|
||||
Returns an image resource object.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ($class, $pdf, $name) = @_;
|
||||
my $self = $class->SUPER::new($pdf, $name);
|
||||
|
||||
$self->subtype('Image');
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
=item $width = $image->width($width)
|
||||
|
||||
Get or set the width value for the image object.
|
||||
|
||||
=cut
|
||||
|
||||
sub width {
|
||||
my $self = shift();
|
||||
$self->{'Width'} = PDFNum(shift()) if scalar @_;
|
||||
return $self->{'Width'}->val();
|
||||
}
|
||||
|
||||
=item $height = $image->height($height)
|
||||
|
||||
Get or set the height value for the image object.
|
||||
|
||||
=cut
|
||||
|
||||
sub height {
|
||||
my $self = shift();
|
||||
$self->{'Height'} = PDFNum(shift()) if scalar @_;
|
||||
return $self->{'Height'}->val();
|
||||
}
|
||||
|
||||
=item $image->smask($xobject)
|
||||
|
||||
Set the soft-mask image object.
|
||||
|
||||
=cut
|
||||
|
||||
sub smask {
|
||||
my $self = shift();
|
||||
$self->{'SMask'} = shift();
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
=item $image->mask(@color_range)
|
||||
|
||||
=item $image->mask($xobject)
|
||||
|
||||
Set the mask to an image mask XObject or an array containing a range
|
||||
of colors to be applied as a color key mask.
|
||||
|
||||
=cut
|
||||
|
||||
sub mask {
|
||||
my $self = shift();
|
||||
if (ref($_[0])) {
|
||||
$self->{'Mask'} = shift();
|
||||
}
|
||||
else {
|
||||
$self->{'Mask'} = PDFArray(map { PDFNum($_) } @_);
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Deprecated (rolled into mask)
|
||||
sub imask { return mask(@_); }
|
||||
|
||||
=item $image->colorspace($name)
|
||||
|
||||
=item $image->colorspace($array)
|
||||
|
||||
Set the color space used by the image. Depending on the color space,
|
||||
this will either be just the name of the color space, or it will be an
|
||||
array containing the color space and any required parameters.
|
||||
|
||||
If passing an array, parameters must already be encoded as PDF
|
||||
objects. The array itself may also be a PDF object. If not, one will
|
||||
be created.
|
||||
|
||||
=cut
|
||||
|
||||
sub colorspace {
|
||||
my ($self, @values) = @_;
|
||||
if (scalar @values == 1 and ref($values[0])) {
|
||||
$self->{'ColorSpace'} = $values[0];
|
||||
}
|
||||
elsif (scalar @values == 1) {
|
||||
$self->{'ColorSpace'} = PDFName($values[0]);
|
||||
}
|
||||
else {
|
||||
$self->{'ColorSpace'} = PDFArray(@values);
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
=item $image->bits_per_component($integer)
|
||||
|
||||
Set the number of bits used to represent each color component.
|
||||
|
||||
=cut
|
||||
|
||||
sub bits_per_component {
|
||||
my $self = shift();
|
||||
$self->{'BitsPerComponent'} = PDFNum(shift());
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Deprecated (renamed)
|
||||
sub bpc { return bits_per_component(@_); }
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,72 @@
|
||||
package PDF::API2::Resource::XObject::Image::GD;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Image';
|
||||
|
||||
use strict;
|
||||
no warnings qw[ deprecated recursion uninitialized ];
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
use PDF::API2::Util;
|
||||
use PDF::API2::Basic::PDF::Utils;
|
||||
use Scalar::Util qw(weaken);
|
||||
|
||||
sub new {
|
||||
my ($class,$pdf,$obj,$name,@opts) = @_;
|
||||
my $self;
|
||||
|
||||
$class = ref $class if ref $class;
|
||||
|
||||
$self=$class->SUPER::new($pdf,$name|| 'Jx'.pdfkey());
|
||||
$pdf->new_obj($self) unless($self->is_obj($pdf));
|
||||
|
||||
$self->{' apipdf'}=$pdf;
|
||||
weaken $self->{' apipdf'};
|
||||
|
||||
$self->read_gd($obj,@opts);
|
||||
|
||||
return($self);
|
||||
}
|
||||
|
||||
sub read_gd {
|
||||
my $self = shift @_;
|
||||
my $gd = shift @_;
|
||||
my %opts = @_;
|
||||
|
||||
my ($w,$h) = $gd->getBounds();
|
||||
my $c = $gd->colorsTotal();
|
||||
|
||||
$self->width($w);
|
||||
$self->height($h);
|
||||
|
||||
$self->bpc(8);
|
||||
$self->colorspace('DeviceRGB');
|
||||
|
||||
if($gd->can('jpeg') && ($c > 256) && !$opts{-lossless}) {
|
||||
|
||||
$self->filters('DCTDecode');
|
||||
$self->{' nofilt'}=1;
|
||||
$self->{' stream'}=$gd->jpeg(75);
|
||||
|
||||
} elsif($gd->can('raw')) {
|
||||
|
||||
$self->filters('FlateDecode');
|
||||
$self->{' stream'}=$gd->raw;
|
||||
|
||||
} else {
|
||||
|
||||
$self->filters('FlateDecode');
|
||||
for(my $y=0;$y<$h;$y++) {
|
||||
for(my $x=0;$x<$w;$x++) {
|
||||
my $index=$gd->getPixel($x,$y);
|
||||
my @rgb=$gd->rgb($index);
|
||||
$self->{' stream'}.=pack('CCC',@rgb);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
return($self);
|
||||
}
|
||||
|
||||
1;
|
||||
227
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Image/GIF.pm
Normal file
227
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Image/GIF.pm
Normal file
@@ -0,0 +1,227 @@
|
||||
package PDF::API2::Resource::XObject::Image::GIF;
|
||||
|
||||
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);
|
||||
|
||||
# added from PDF::Create:
|
||||
# PDF::Image::GIFImage - GIF image support
|
||||
# Author: Michael Gross <mdgrosse@sbox.tugraz.at>
|
||||
# modified for internal use. (c) 2004 fredo.
|
||||
sub unInterlace {
|
||||
my $self = shift;
|
||||
my $data = $self->{' stream'};
|
||||
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++;
|
||||
}
|
||||
|
||||
$self->{' stream'}=join('', @result);
|
||||
}
|
||||
|
||||
sub deGIF {
|
||||
my ($ibits,$stream)=@_;
|
||||
my $bits=$ibits;
|
||||
my $resetcode=1<<($ibits-1);
|
||||
my $endcode=$resetcode+1;
|
||||
my $nextcode=$endcode+1;
|
||||
my $ptr=0;
|
||||
my $maxptr=8*length($stream);
|
||||
my $tag;
|
||||
my $out='';
|
||||
my $outptr=0;
|
||||
|
||||
# print STDERR "reset=$resetcode\nend=$endcode\nmax=$maxptr\n";
|
||||
|
||||
my @d=map { chr($_) } (0..$resetcode-1);
|
||||
|
||||
while(($ptr+$bits)<=$maxptr) {
|
||||
$tag=0;
|
||||
foreach my $off (reverse 0..$bits-1) {
|
||||
$tag<<=1;
|
||||
$tag|=vec($stream,$ptr+$off,1);
|
||||
}
|
||||
# foreach my $off (0..$bits-1) {
|
||||
# $tag<<=1;
|
||||
# $tag|=vec($stream,$ptr+$off,1);
|
||||
# }
|
||||
# print STDERR "ptr=$ptr,tag=$tag,bits=$bits,next=$nextcode\n";
|
||||
# print STDERR "tag to large\n" if($tag>$nextcode);
|
||||
$ptr+=$bits;
|
||||
$bits++ if $nextcode == 1<<$bits and $bits < 12;
|
||||
if($tag==$resetcode) {
|
||||
$bits=$ibits;
|
||||
$nextcode=$endcode+1;
|
||||
next;
|
||||
} elsif($tag==$endcode) {
|
||||
last;
|
||||
} elsif($tag<$resetcode) {
|
||||
$d[$nextcode]=$d[$tag];
|
||||
$out.=$d[$nextcode];
|
||||
$nextcode++;
|
||||
} elsif($tag>$endcode) {
|
||||
$d[$nextcode]=$d[$tag];
|
||||
$d[$nextcode].=substr($d[$tag+1],0,1);
|
||||
$out.=$d[$nextcode];
|
||||
$nextcode++;
|
||||
}
|
||||
}
|
||||
return($out);
|
||||
}
|
||||
|
||||
sub new {
|
||||
my ($class,$pdf,$file,$name,%opts) = @_;
|
||||
my $self;
|
||||
my $inter=0;
|
||||
|
||||
$class = ref $class if ref $class;
|
||||
|
||||
$self=$class->SUPER::new($pdf,$name || 'Gx'.pdfkey());
|
||||
$pdf->new_obj($self) unless($self->is_obj($pdf));
|
||||
|
||||
$self->{' apipdf'}=$pdf;
|
||||
weaken $self->{' apipdf'};
|
||||
|
||||
my $fh = IO::File->new;
|
||||
if (ref($file)) {
|
||||
$fh = $file;
|
||||
}
|
||||
else {
|
||||
open $fh, "<", $file or die "$!: $file";
|
||||
}
|
||||
binmode $fh, ':raw';
|
||||
my $buf;
|
||||
$fh->seek(0,0);
|
||||
$fh->read($buf,6); # signature
|
||||
die "unknown image signature '$buf' -- not a gif." unless($buf=~/^GIF[0-9][0-9][a-b]/);
|
||||
|
||||
$fh->read($buf,7); # logical descr.
|
||||
my($wg,$hg,$flags,$bgColorIndex,$aspect)=unpack('vvCCC',$buf);
|
||||
|
||||
if($flags&0x80) {
|
||||
my $colSize=2**(($flags&0x7)+1);
|
||||
my $dict=PDFDict();
|
||||
$pdf->new_obj($dict);
|
||||
$self->colorspace(PDFArray(PDFName('Indexed'),PDFName('DeviceRGB'),PDFNum($colSize-1),$dict));
|
||||
$fh->read($dict->{' stream'},3*$colSize); # color-table
|
||||
}
|
||||
|
||||
while(!$fh->eof) {
|
||||
$fh->read($buf,1); # tag.
|
||||
my $sep=unpack('C',$buf);
|
||||
if($sep==0x2C){
|
||||
$fh->read($buf,9); # image-descr.
|
||||
my ($left,$top,$w,$h,$flags)=unpack('vvvvC',$buf);
|
||||
|
||||
$self->width($w||$wg);
|
||||
$self->height($h||$hg);
|
||||
$self->bpc(8);
|
||||
|
||||
if($flags&0x80) { # local colormap
|
||||
my $colSize=2**(($flags&0x7)+1);
|
||||
my $dict=PDFDict();
|
||||
$pdf->new_obj($dict);
|
||||
$self->colorspace(PDFArray(PDFName('Indexed'),PDFName('DeviceRGB'),PDFNum($colSize-1),$dict));
|
||||
$fh->read($dict->{' stream'},3*$colSize); # color-table
|
||||
}
|
||||
if($flags&0x40) { # need de-interlace
|
||||
$inter=1;
|
||||
}
|
||||
|
||||
$fh->read($buf,1); # image-lzw-start (should be 9).
|
||||
my ($sep)=unpack('C',$buf);
|
||||
|
||||
$fh->read($buf,1); # first chunk.
|
||||
my ($len)=unpack('C',$buf);
|
||||
my $stream='';
|
||||
while($len>0) {
|
||||
$fh->read($buf,$len);
|
||||
$stream.=$buf;
|
||||
$fh->read($buf,1);
|
||||
$len=unpack('C',$buf);
|
||||
}
|
||||
$self->{' stream'}=deGIF($sep+1,$stream);
|
||||
$self->unInterlace if($inter);
|
||||
last;
|
||||
} elsif($sep==0x3b) {
|
||||
last;
|
||||
} elsif($sep==0x21) {
|
||||
# Graphic Control Extension
|
||||
$fh->read($buf,1); # tag.
|
||||
my $tag=unpack('C',$buf);
|
||||
die "unsupported graphic control extension ($tag)" unless($tag==0xF9);
|
||||
$fh->read($buf,1); # len.
|
||||
my $len=unpack('C',$buf);
|
||||
my $stream='';
|
||||
while($len>0) {
|
||||
$fh->read($buf,$len);
|
||||
$stream.=$buf;
|
||||
$fh->read($buf,1);
|
||||
$len=unpack('C',$buf);
|
||||
}
|
||||
my ($cFlags,$delay,$transIndex)=unpack('CvC',$stream);
|
||||
if(($cFlags&0x01) && !$opts{-notrans}) {
|
||||
$self->{Mask}=PDFArray(PDFNum($transIndex),PDFNum($transIndex));
|
||||
}
|
||||
} else {
|
||||
# extension
|
||||
$fh->read($buf,1); # tag.
|
||||
my $tag=unpack('C',$buf);
|
||||
$fh->read($buf,1); # tag.
|
||||
my $len=unpack('C',$buf);
|
||||
while($len>0) {
|
||||
$fh->read($buf,$len);
|
||||
$fh->read($buf,1);
|
||||
$len=unpack('C',$buf);
|
||||
}
|
||||
}
|
||||
}
|
||||
$fh->close;
|
||||
|
||||
$self->filters('FlateDecode');
|
||||
|
||||
return($self);
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,97 @@
|
||||
package PDF::API2::Resource::XObject::Image::JPEG;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Image';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
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 $fh = IO::File->new();
|
||||
|
||||
$class = ref($class) if ref($class);
|
||||
|
||||
my $self = $class->SUPER::new($pdf, $name || 'Jx' . pdfkey());
|
||||
$pdf->new_obj($self) unless $self->is_obj($pdf);
|
||||
|
||||
$self->{' apipdf'} = $pdf;
|
||||
weaken $self->{' apipdf'};
|
||||
|
||||
if (ref($file)) {
|
||||
$fh = $file;
|
||||
}
|
||||
else {
|
||||
open $fh, "<", $file or die "$!: $file";
|
||||
}
|
||||
binmode $fh, ':raw';
|
||||
|
||||
$self->read_jpeg($fh);
|
||||
|
||||
if (ref($file)) {
|
||||
seek $fh, 0, 0;
|
||||
$self->{' stream'} = '';
|
||||
my $buf = '';
|
||||
while (!eof($fh)) {
|
||||
read $fh, $buf, 512;
|
||||
$self->{' stream'} .= $buf;
|
||||
}
|
||||
$self->{'Length'} = PDFNum(length $self->{' stream'});
|
||||
}
|
||||
else {
|
||||
$self->{'Length'} = PDFNum(-s $file);
|
||||
$self->{' streamfile'} = $file;
|
||||
}
|
||||
|
||||
$self->filters('DCTDecode');
|
||||
$self->{' nofilt'} = 1;
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub read_jpeg {
|
||||
my ($self, $fh) = @_;
|
||||
my ($buf, $p, $h, $w, $c, $ff, $mark, $len);
|
||||
|
||||
$fh->seek(0,0);
|
||||
$fh->read($buf,2);
|
||||
while (1) {
|
||||
$fh->read($buf, 4);
|
||||
my ($ff, $mark, $len) = unpack('CCn', $buf);
|
||||
last if $ff != 0xFF;
|
||||
last if $mark == 0xDA || $mark == 0xD9; # SOS/EOI
|
||||
last if $len < 2;
|
||||
last if $fh->eof();
|
||||
$fh->read($buf, $len - 2);
|
||||
next if $mark == 0xFE;
|
||||
next if $mark >= 0xE0 && $mark <= 0xEF;
|
||||
if ($mark >= 0xC0 && $mark <= 0xCF && $mark != 0xC4 && $mark != 0xC8 && $mark != 0xCC) {
|
||||
($p, $h, $w, $c) = unpack('CnnC', substr($buf, 0, 6));
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
$self->width($w);
|
||||
$self->height($h);
|
||||
$self->bpc($p);
|
||||
|
||||
if ($c == 3) {
|
||||
$self->colorspace('DeviceRGB');
|
||||
}
|
||||
elsif ($c == 4) {
|
||||
$self->colorspace('DeviceCMYK');
|
||||
}
|
||||
elsif ($c == 1) {
|
||||
$self->colorspace('DeviceGray');
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
1;
|
||||
692
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Image/PNG.pm
Normal file
692
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Image/PNG.pm
Normal file
@@ -0,0 +1,692 @@
|
||||
package PDF::API2::Resource::XObject::Image::PNG;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Image';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
use Compress::Zlib;
|
||||
use POSIX qw(ceil floor);
|
||||
|
||||
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, %opts) = @_;
|
||||
my $self;
|
||||
|
||||
$class = ref($class) if ref($class);
|
||||
|
||||
$self = $class->SUPER::new($pdf, $name || 'Px' . pdfkey());
|
||||
$pdf->new_obj($self) unless $self->is_obj($pdf);
|
||||
|
||||
$self->{' apipdf'} = $pdf;
|
||||
weaken $self->{' apipdf'};
|
||||
|
||||
my $fh = IO::File->new();
|
||||
if (ref($file)) {
|
||||
$fh = $file;
|
||||
}
|
||||
else {
|
||||
open $fh, '<', $file or die "$!: $file";
|
||||
}
|
||||
binmode $fh, ':raw';
|
||||
|
||||
my ($buf, $l, $crc, $w, $h, $bpc, $cs, $cm, $fm, $im, $palete, $trns);
|
||||
seek($fh, 8, 0);
|
||||
$self->{' stream'} = '';
|
||||
$self->{' nofilt'} = 1;
|
||||
while (!eof($fh)) {
|
||||
read($fh, $buf, 4);
|
||||
$l = unpack('N', $buf);
|
||||
read($fh, $buf, 4);
|
||||
if ($buf eq 'IHDR') {
|
||||
read($fh, $buf, $l);
|
||||
($w, $h, $bpc, $cs, $cm, $fm, $im) = unpack('NNCCCCC', $buf);
|
||||
die "Unsupported Compression($cm) Method" if $cm;
|
||||
die "Unsupported Interlace($im) Method" if $im;
|
||||
die "Unsupported Filter($fm) Method" if $fm;
|
||||
}
|
||||
elsif ($buf eq 'PLTE') {
|
||||
read($fh, $buf, $l);
|
||||
$palete = $buf;
|
||||
}
|
||||
elsif($buf eq 'IDAT') {
|
||||
read($fh, $buf, $l);
|
||||
$self->{' stream'} .= $buf;
|
||||
}
|
||||
elsif($buf eq 'tRNS') {
|
||||
read($fh, $buf, $l);
|
||||
$trns = $buf;
|
||||
}
|
||||
elsif($buf eq 'IEND') {
|
||||
last;
|
||||
}
|
||||
else {
|
||||
# skip ahead
|
||||
seek($fh, $l, 1);
|
||||
}
|
||||
read($fh, $buf, 4);
|
||||
$crc = $buf;
|
||||
}
|
||||
close $fh;
|
||||
|
||||
$self->width($w);
|
||||
$self->height($h);
|
||||
|
||||
if ($cs == 0) { # greyscale
|
||||
# scanline = ceil(bpc * comp / 8)+1
|
||||
if ($bpc > 8) {
|
||||
die "16-bits of greylevel in png not supported.";
|
||||
}
|
||||
else {
|
||||
$self->filters('FlateDecode');
|
||||
$self->colorspace('DeviceGray');
|
||||
$self->bpc($bpc);
|
||||
my $dict = PDFDict();
|
||||
$self->{'DecodeParms'} = PDFArray($dict);
|
||||
$dict->{'Predictor'} = PDFNum(15);
|
||||
$dict->{'BitsPerComponent'} = PDFNum($bpc);
|
||||
$dict->{'Colors'} = PDFNum(1);
|
||||
$dict->{'Columns'} = PDFNum($w);
|
||||
if (defined $trns && !$opts{-notrans}) {
|
||||
my $m = mMax(unpack('n*', $trns));
|
||||
my $n = mMin(unpack('n*', $trns));
|
||||
$self->{'Mask'} = PDFArray(PDFNum($n), PDFNum($m));
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($cs == 2) { # rgb 8/16 bits
|
||||
if ($bpc > 8) {
|
||||
die "16-bits of rgb in png not supported.";
|
||||
}
|
||||
else {
|
||||
$self->filters('FlateDecode');
|
||||
$self->colorspace('DeviceRGB');
|
||||
$self->bpc($bpc);
|
||||
my $dict = PDFDict();
|
||||
$self->{'DecodeParms'} = PDFArray($dict);
|
||||
$dict->{'Predictor'} = PDFNum(15);
|
||||
$dict->{'BitsPerComponent'} = PDFNum($bpc);
|
||||
$dict->{'Colors'} = PDFNum(3);
|
||||
$dict->{'Columns'} = PDFNum($w);
|
||||
if (defined $trns && !$opts{-notrans}) {
|
||||
my @v = unpack('n*', $trns);
|
||||
my (@cr, @cg, @cb, $m, $n);
|
||||
while (scalar @v > 0) {
|
||||
push @cr, shift(@v);
|
||||
push @cg, shift(@v);
|
||||
push @cb, shift(@v);
|
||||
}
|
||||
@v = ();
|
||||
$m = mMax(@cr);
|
||||
$n = mMin(@cr);
|
||||
push @v, $n, $m;
|
||||
$m = mMax(@cg);
|
||||
$n = mMin(@cg);
|
||||
push @v, $n, $m;
|
||||
$m = mMax(@cb);
|
||||
$n = mMin(@cb);
|
||||
push @v, $n, $m;
|
||||
$self->{'Mask'} = PDFArray(map { PDFNum($_) } @v);
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($cs == 3){ # palette
|
||||
if ($bpc > 8) {
|
||||
die 'bits>8 of palette in png not supported.';
|
||||
}
|
||||
else {
|
||||
my $dict = PDFDict();
|
||||
$pdf->new_obj($dict);
|
||||
$dict->{'Filter'} = PDFArray(PDFName('FlateDecode'));
|
||||
$dict->{' stream'} = $palete;
|
||||
$palete = '';
|
||||
$self->filters('FlateDecode');
|
||||
$self->colorspace(PDFArray(PDFName('Indexed'), PDFName('DeviceRGB'), PDFNum(int(length($dict->{' stream'}) / 3) - 1), $dict));
|
||||
$self->bpc($bpc);
|
||||
$dict = PDFDict();
|
||||
$self->{'DecodeParms'} = PDFArray($dict);
|
||||
$dict->{'Predictor'} = PDFNum(15);
|
||||
$dict->{'BitsPerComponent'} = PDFNum($bpc);
|
||||
$dict->{'Colors'} = PDFNum(1);
|
||||
$dict->{'Columns'} = PDFNum($w);
|
||||
if (defined $trns && !$opts{-notrans}) {
|
||||
$trns .= "\xFF" x 256;
|
||||
$dict = PDFDict();
|
||||
$pdf->new_obj($dict);
|
||||
$dict->{'Type'} = PDFName('XObject');
|
||||
$dict->{'Subtype'} = PDFName('Image');
|
||||
$dict->{'Width'} = PDFNum($w);
|
||||
$dict->{'Height'} = PDFNum($h);
|
||||
$dict->{'ColorSpace'} = PDFName('DeviceGray');
|
||||
$dict->{'Filter'} = PDFArray(PDFName('FlateDecode'));
|
||||
$dict->{'BitsPerComponent'} = PDFNum(8);
|
||||
$self->{'SMask'} = $dict;
|
||||
my $scanline = 1 + ceil($bpc * $w / 8);
|
||||
my $bpp = ceil($bpc / 8);
|
||||
my $clearstream = unprocess($bpc, $bpp, 1, $w, $h, $scanline, \$self->{' stream'});
|
||||
foreach my $n (0 .. ($h * $w) - 1) {
|
||||
vec($dict->{' stream'}, $n, 8) = vec($trns, vec($clearstream, $n, $bpc), 8);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($cs == 4) { # greyscale+alpha
|
||||
if ($bpc > 8) {
|
||||
die '16-bits of greylevel+alpha in png not supported.';
|
||||
}
|
||||
else {
|
||||
$self->filters('FlateDecode');
|
||||
$self->colorspace('DeviceGray');
|
||||
$self->bpc($bpc);
|
||||
my $dict = PDFDict();
|
||||
$self->{'DecodeParms'} = PDFArray($dict);
|
||||
# $dict->{'Predictor'} = PDFNum(15);
|
||||
$dict->{'BitsPerComponent'} = PDFNum($bpc);
|
||||
$dict->{'Colors'} = PDFNum(1);
|
||||
$dict->{'Columns'} = PDFNum($w);
|
||||
|
||||
$dict = PDFDict();
|
||||
unless ($opts{-notrans}) {
|
||||
$pdf->new_obj($dict);
|
||||
$dict->{'Type'} = PDFName('XObject');
|
||||
$dict->{'Subtype'} = PDFName('Image');
|
||||
$dict->{'Width'} = PDFNum($w);
|
||||
$dict->{'Height'} = PDFNum($h);
|
||||
$dict->{'ColorSpace'} = PDFName('DeviceGray');
|
||||
$dict->{'Filter'} = PDFArray(PDFName('FlateDecode'));
|
||||
$dict->{'BitsPerComponent'} = PDFNum($bpc);
|
||||
$self->{'SMask'} = $dict;
|
||||
}
|
||||
my $scanline = 1 + ceil($bpc * 2 * $w / 8);
|
||||
my $bpp = ceil($bpc * 2 / 8);
|
||||
my $clearstream = unprocess($bpc, $bpp, 2, $w, $h, $scanline, \$self->{' stream'});
|
||||
delete $self->{' nofilt'};
|
||||
delete $self->{' stream'};
|
||||
foreach my $n (0 .. ($h * $w) - 1) {
|
||||
vec($dict->{' stream'}, $n, $bpc) = vec($clearstream, ($n * 2) + 1, $bpc);
|
||||
vec($self->{' stream'}, $n, $bpc) = vec($clearstream, $n * 2, $bpc);
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($cs == 6) { # rgb+alpha
|
||||
if ($bpc > 8) {
|
||||
die '16-bits of rgb+alpha in png not supported.';
|
||||
}
|
||||
else {
|
||||
$self->filters('FlateDecode');
|
||||
$self->colorspace('DeviceRGB');
|
||||
$self->bpc($bpc);
|
||||
my $dict = PDFDict();
|
||||
$self->{'DecodeParms'} = PDFArray($dict);
|
||||
# $dict->{'Predictor'} = PDFNum(15);
|
||||
$dict->{'BitsPerComponent'} = PDFNum($bpc);
|
||||
$dict->{'Colors'} = PDFNum(3);
|
||||
$dict->{'Columns'} = PDFNum($w);
|
||||
|
||||
$dict = PDFDict();
|
||||
unless($opts{-notrans}) {
|
||||
$pdf->new_obj($dict);
|
||||
$dict->{'Type'} = PDFName('XObject');
|
||||
$dict->{'Subtype'} = PDFName('Image');
|
||||
$dict->{'Width'} = PDFNum($w);
|
||||
$dict->{'Height'} = PDFNum($h);
|
||||
$dict->{'ColorSpace'} = PDFName('DeviceGray');
|
||||
$dict->{'Filter'} = PDFArray(PDFName('FlateDecode'));
|
||||
$dict->{'BitsPerComponent'} = PDFNum($bpc);
|
||||
$self->{'SMask'} = $dict;
|
||||
}
|
||||
my $scanline = 1 + ceil($bpc * 4 * $w / 8);
|
||||
my $bpp = ceil($bpc * 4 / 8);
|
||||
my $clearstream = unprocess($bpc, $bpp, 4, $w, $h, $scanline, \$self->{' stream'});
|
||||
delete $self->{' nofilt'};
|
||||
delete $self->{' stream'};
|
||||
foreach my $n (0 .. ($h * $w) - 1) {
|
||||
vec($dict->{' stream'}, $n, $bpc) = vec($clearstream, ($n * 4) + 3, $bpc);
|
||||
vec($self->{' stream'}, ($n * 3), $bpc) = vec($clearstream, ($n * 4), $bpc);
|
||||
vec($self->{' stream'}, ($n * 3) + 1, $bpc) = vec($clearstream, ($n * 4) + 1, $bpc);
|
||||
vec($self->{' stream'}, ($n * 3) + 2, $bpc) = vec($clearstream, ($n * 4) + 2, $bpc);
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
die "unsupported png-type ($cs).";
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub PaethPredictor {
|
||||
my ($a, $b, $c) = @_;
|
||||
my $p = $a + $b - $c;
|
||||
my $pa = abs($p - $a);
|
||||
my $pb = abs($p - $b);
|
||||
my $pc = abs($p - $c);
|
||||
if (($pa <= $pb) && ($pa <= $pc)) {
|
||||
return $a;
|
||||
}
|
||||
elsif ($pb <= $pc) {
|
||||
return $b;
|
||||
}
|
||||
else {
|
||||
return $c;
|
||||
}
|
||||
}
|
||||
|
||||
sub unprocess {
|
||||
my ($bpc, $bpp, $comp, $width, $height, $scanline, $sstream) = @_;
|
||||
my $stream = uncompress($$sstream);
|
||||
my $prev = '';
|
||||
my $clearstream = '';
|
||||
foreach my $n (0 .. $height - 1) {
|
||||
# print STDERR "line $n:";
|
||||
my $line = substr($stream, $n * $scanline, $scanline);
|
||||
my $filter = vec($line, 0, 8);
|
||||
my $clear = '';
|
||||
$line = substr($line, 1);
|
||||
# print STDERR " filter=$filter";
|
||||
if ($filter == 0) {
|
||||
$clear = $line;
|
||||
}
|
||||
elsif ($filter == 1) {
|
||||
foreach my $x (0 .. length($line) - 1) {
|
||||
vec($clear, $x, 8) = (vec($line, $x, 8) + vec($clear, $x - $bpp, 8)) % 256;
|
||||
}
|
||||
}
|
||||
elsif ($filter == 2) {
|
||||
foreach my $x (0 .. length($line) - 1) {
|
||||
vec($clear, $x, 8) = (vec($line, $x, 8) + vec($prev, $x, 8)) % 256;
|
||||
}
|
||||
}
|
||||
elsif ($filter == 3) {
|
||||
foreach my $x (0 .. length($line) - 1) {
|
||||
vec($clear, $x, 8) = (vec($line, $x, 8) + floor((vec($clear, $x - $bpp, 8) + vec($prev, $x, 8)) / 2)) % 256;
|
||||
}
|
||||
}
|
||||
elsif ($filter == 4) {
|
||||
foreach my $x (0 .. length($line) - 1) {
|
||||
vec($clear,$x,8) = (vec($line, $x, 8) + PaethPredictor(vec($clear, $x - $bpp, 8), vec($prev, $x, 8), vec($prev, $x - $bpp, 8))) % 256;
|
||||
}
|
||||
}
|
||||
$prev = $clear;
|
||||
foreach my $x (0 .. ($width * $comp) - 1) {
|
||||
vec($clearstream, ($n * $width * $comp) + $x, $bpc) = vec($clear, $x, $bpc);
|
||||
}
|
||||
}
|
||||
return $clearstream;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
RFC 2083
|
||||
PNG: Portable Network Graphics
|
||||
January 1997
|
||||
|
||||
|
||||
4.1.3. IDAT Image data
|
||||
|
||||
The IDAT chunk contains the actual image data. To create this
|
||||
data:
|
||||
|
||||
* Begin with image scanlines represented as described in
|
||||
Image layout (Section 2.3); the layout and total size of
|
||||
this raw data are determined by the fields of IHDR.
|
||||
* Filter the image data according to the filtering method
|
||||
specified by the IHDR chunk. (Note that with filter
|
||||
method 0, the only one currently defined, this implies
|
||||
prepending a filter type byte to each scanline.)
|
||||
* Compress the filtered data using the compression method
|
||||
specified by the IHDR chunk.
|
||||
|
||||
The IDAT chunk contains the output datastream of the compression
|
||||
algorithm.
|
||||
|
||||
To read the image data, reverse this process.
|
||||
|
||||
There can be multiple IDAT chunks; if so, they must appear
|
||||
consecutively with no other intervening chunks. The compressed
|
||||
datastream is then the concatenation of the contents of all the
|
||||
IDAT chunks. The encoder can divide the compressed datastream
|
||||
into IDAT chunks however it wishes. (Multiple IDAT chunks are
|
||||
allowed so that encoders can work in a fixed amount of memory;
|
||||
typically the chunk size will correspond to the encoder's buffer
|
||||
size.) It is important to emphasize that IDAT chunk boundaries
|
||||
have no semantic significance and can occur at any point in the
|
||||
compressed datastream. A PNG file in which each IDAT chunk
|
||||
contains only one data byte is legal, though remarkably wasteful
|
||||
of space. (For that matter, zero-length IDAT chunks are legal,
|
||||
though even more wasteful.)
|
||||
|
||||
|
||||
4.2.9. tRNS Transparency
|
||||
|
||||
The tRNS chunk specifies that the image uses simple
|
||||
transparency: either alpha values associated with palette
|
||||
entries (for indexed-color images) or a single transparent
|
||||
color (for grayscale and truecolor images). Although simple
|
||||
transparency is not as elegant as the full alpha channel, it
|
||||
requires less storage space and is sufficient for many common
|
||||
cases.
|
||||
|
||||
For color type 3 (indexed color), the tRNS chunk contains a
|
||||
series of one-byte alpha values, corresponding to entries in
|
||||
the PLTE chunk:
|
||||
|
||||
Alpha for palette index 0: 1 byte
|
||||
Alpha for palette index 1: 1 byte
|
||||
... etc ...
|
||||
|
||||
Each entry indicates that pixels of the corresponding palette
|
||||
index must be treated as having the specified alpha value.
|
||||
Alpha values have the same interpretation as in an 8-bit full
|
||||
alpha channel: 0 is fully transparent, 255 is fully opaque,
|
||||
regardless of image bit depth. The tRNS chunk must not contain
|
||||
more alpha values than there are palette entries, but tRNS can
|
||||
contain fewer values than there are palette entries. In this
|
||||
case, the alpha value for all remaining palette entries is
|
||||
assumed to be 255. In the common case in which only palette
|
||||
index 0 need be made transparent, only a one-byte tRNS chunk is
|
||||
needed.
|
||||
|
||||
For color type 0 (grayscale), the tRNS chunk contains a single
|
||||
gray level value, stored in the format:
|
||||
|
||||
Gray: 2 bytes, range 0 .. (2^bitdepth)-1
|
||||
|
||||
(For consistency, 2 bytes are used regardless of the image bit
|
||||
depth.) Pixels of the specified gray level are to be treated as
|
||||
transparent (equivalent to alpha value 0); all other pixels are
|
||||
to be treated as fully opaque (alpha value (2^bitdepth)-1).
|
||||
|
||||
For color type 2 (truecolor), the tRNS chunk contains a single
|
||||
RGB color value, stored in the format:
|
||||
|
||||
Red: 2 bytes, range 0 .. (2^bitdepth)-1
|
||||
Green: 2 bytes, range 0 .. (2^bitdepth)-1
|
||||
Blue: 2 bytes, range 0 .. (2^bitdepth)-1
|
||||
|
||||
(For consistency, 2 bytes per sample are used regardless of the
|
||||
image bit depth.) Pixels of the specified color value are to be
|
||||
treated as transparent (equivalent to alpha value 0); all other
|
||||
pixels are to be treated as fully opaque (alpha value
|
||||
2^bitdepth)-1).
|
||||
|
||||
tRNS is prohibited for color types 4 and 6, since a full alpha
|
||||
channel is already present in those cases.
|
||||
|
||||
Note: when dealing with 16-bit grayscale or truecolor data, it
|
||||
is important to compare both bytes of the sample values to
|
||||
determine whether a pixel is transparent. Although decoders
|
||||
may drop the low-order byte of the samples for display, this
|
||||
must not occur until after the data has been tested for
|
||||
transparency. For example, if the grayscale level 0x0001 is
|
||||
specified to be transparent, it would be incorrect to compare
|
||||
only the high-order byte and decide that 0x0002 is also
|
||||
transparent.
|
||||
|
||||
When present, the tRNS chunk must precede the first IDAT chunk,
|
||||
and must follow the PLTE chunk, if any.
|
||||
|
||||
|
||||
6. Filter Algorithms
|
||||
|
||||
This chapter describes the filter algorithms that can be applied
|
||||
before compression. The purpose of these filters is to prepare the
|
||||
image data for optimum compression.
|
||||
|
||||
|
||||
6.1. Filter types
|
||||
|
||||
PNG filter method 0 defines five basic filter types:
|
||||
|
||||
Type Name
|
||||
|
||||
0 None
|
||||
1 Sub
|
||||
2 Up
|
||||
3 Average
|
||||
4 Paeth
|
||||
|
||||
(Note that filter method 0 in IHDR specifies exactly this set of
|
||||
five filter types. If the set of filter types is ever extended, a
|
||||
different filter method number will be assigned to the extended
|
||||
set, so that decoders need not decompress the data to discover
|
||||
that it contains unsupported filter types.)
|
||||
|
||||
The encoder can choose which of these filter algorithms to apply
|
||||
on a scanline-by-scanline basis. In the image data sent to the
|
||||
compression step, each scanline is preceded by a filter type byte
|
||||
that specifies the filter algorithm used for that scanline.
|
||||
|
||||
Filtering algorithms are applied to bytes, not to pixels,
|
||||
regardless of the bit depth or color type of the image. The
|
||||
filtering algorithms work on the byte sequence formed by a
|
||||
scanline that has been represented as described in Image layout
|
||||
(Section 2.3). If the image includes an alpha channel, the alpha
|
||||
data is filtered in the same way as the image data.
|
||||
|
||||
When the image is interlaced, each pass of the interlace pattern
|
||||
is treated as an independent image for filtering purposes. The
|
||||
filters work on the byte sequences formed by the pixels actually
|
||||
transmitted during a pass, and the "previous scanline" is the one
|
||||
previously transmitted in the same pass, not the one adjacent in
|
||||
the complete image. Note that the subimage transmitted in any one
|
||||
pass is always rectangular, but is of smaller width and/or height
|
||||
than the complete image. Filtering is not applied when this
|
||||
subimage is empty.
|
||||
|
||||
For all filters, the bytes "to the left of" the first pixel in a
|
||||
scanline must be treated as being zero. For filters that refer to
|
||||
the prior scanline, the entire prior scanline must be treated as
|
||||
being zeroes for the first scanline of an image (or of a pass of
|
||||
an interlaced image).
|
||||
|
||||
To reverse the effect of a filter, the decoder must use the
|
||||
decoded values of the prior pixel on the same line, the pixel
|
||||
immediately above the current pixel on the prior line, and the
|
||||
pixel just to the left of the pixel above. This implies that at
|
||||
least one scanline's worth of image data will have to be stored by
|
||||
the decoder at all times. Even though some filter types do not
|
||||
refer to the prior scanline, the decoder will always need to store
|
||||
each scanline as it is decoded, since the next scanline might use
|
||||
a filter that refers to it.
|
||||
|
||||
PNG imposes no restriction on which filter types can be applied to
|
||||
an image. However, the filters are not equally effective on all
|
||||
types of data. See Recommendations for Encoders: Filter selection
|
||||
(Section 9.6).
|
||||
|
||||
See also Rationale: Filtering (Section 12.9).
|
||||
|
||||
|
||||
|
||||
6.2. Filter type 0: None
|
||||
|
||||
With the None filter, the scanline is transmitted unmodified; it
|
||||
is only necessary to insert a filter type byte before the data.
|
||||
|
||||
|
||||
6.3. Filter type 1: Sub
|
||||
|
||||
The Sub filter transmits the difference between each byte and the
|
||||
value of the corresponding byte of the prior pixel.
|
||||
|
||||
To compute the Sub filter, apply the following formula to each
|
||||
byte of the scanline:
|
||||
|
||||
Sub(x) = Raw(x) - Raw(x-bpp)
|
||||
|
||||
where x ranges from zero to the number of bytes representing the
|
||||
scanline minus one, Raw(x) refers to the raw data byte at that
|
||||
byte position in the scanline, and bpp is defined as the number of
|
||||
bytes per complete pixel, rounding up to one. For example, for
|
||||
color type 2 with a bit depth of 16, bpp is equal to 6 (three
|
||||
samples, two bytes per sample); for color type 0 with a bit depth
|
||||
of 2, bpp is equal to 1 (rounding up); for color type 4 with a bit
|
||||
depth of 16, bpp is equal to 4 (two-byte grayscale sample, plus
|
||||
two-byte alpha sample).
|
||||
|
||||
Note this computation is done for each byte, regardless of bit
|
||||
depth. In a 16-bit image, each MSB is predicted from the
|
||||
preceding MSB and each LSB from the preceding LSB, because of the
|
||||
way that bpp is defined.
|
||||
|
||||
Unsigned arithmetic modulo 256 is used, so that both the inputs
|
||||
and outputs fit into bytes. The sequence of Sub values is
|
||||
transmitted as the filtered scanline.
|
||||
|
||||
For all x < 0, assume Raw(x) = 0.
|
||||
|
||||
To reverse the effect of the Sub filter after decompression,
|
||||
output the following value:
|
||||
|
||||
Sub(x) + Raw(x-bpp)
|
||||
|
||||
(computed mod 256), where Raw refers to the bytes already decoded.
|
||||
|
||||
|
||||
6.4. Filter type 2: Up
|
||||
|
||||
The Up filter is just like the Sub filter except that the pixel
|
||||
immediately above the current pixel, rather than just to its left,
|
||||
is used as the predictor.
|
||||
|
||||
To compute the Up filter, apply the following formula to each byte
|
||||
of the scanline:
|
||||
|
||||
Up(x) = Raw(x) - Prior(x)
|
||||
|
||||
where x ranges from zero to the number of bytes representing the
|
||||
scanline minus one, Raw(x) refers to the raw data byte at that
|
||||
byte position in the scanline, and Prior(x) refers to the
|
||||
unfiltered bytes of the prior scanline.
|
||||
|
||||
Note this is done for each byte, regardless of bit depth.
|
||||
Unsigned arithmetic modulo 256 is used, so that both the inputs
|
||||
and outputs fit into bytes. The sequence of Up values is
|
||||
transmitted as the filtered scanline.
|
||||
|
||||
On the first scanline of an image (or of a pass of an interlaced
|
||||
image), assume Prior(x) = 0 for all x.
|
||||
|
||||
To reverse the effect of the Up filter after decompression, output
|
||||
the following value:
|
||||
|
||||
Up(x) + Prior(x)
|
||||
|
||||
(computed mod 256), where Prior refers to the decoded bytes of the
|
||||
prior scanline.
|
||||
|
||||
|
||||
6.5. Filter type 3: Average
|
||||
|
||||
The Average filter uses the average of the two neighboring pixels
|
||||
(left and above) to predict the value of a pixel.
|
||||
|
||||
To compute the Average filter, apply the following formula to each
|
||||
byte of the scanline:
|
||||
|
||||
Average(x) = Raw(x) - floor((Raw(x-bpp)+Prior(x))/2)
|
||||
|
||||
where x ranges from zero to the number of bytes representing the
|
||||
scanline minus one, Raw(x) refers to the raw data byte at that
|
||||
byte position in the scanline, Prior(x) refers to the unfiltered
|
||||
bytes of the prior scanline, and bpp is defined as for the Sub
|
||||
filter.
|
||||
|
||||
Note this is done for each byte, regardless of bit depth. The
|
||||
sequence of Average values is transmitted as the filtered
|
||||
scanline.
|
||||
|
||||
The subtraction of the predicted value from the raw byte must be
|
||||
done modulo 256, so that both the inputs and outputs fit into
|
||||
bytes. However, the sum Raw(x-bpp)+Prior(x) must be formed
|
||||
without overflow (using at least nine-bit arithmetic). floor()
|
||||
indicates that the result of the division is rounded to the next
|
||||
lower integer if fractional; in other words, it is an integer
|
||||
division or right shift operation.
|
||||
|
||||
For all x < 0, assume Raw(x) = 0. On the first scanline of an
|
||||
image (or of a pass of an interlaced image), assume Prior(x) = 0
|
||||
for all x.
|
||||
|
||||
To reverse the effect of the Average filter after decompression,
|
||||
output the following value:
|
||||
|
||||
Average(x) + floor((Raw(x-bpp)+Prior(x))/2)
|
||||
|
||||
where the result is computed mod 256, but the prediction is
|
||||
calculated in the same way as for encoding. Raw refers to the
|
||||
bytes already decoded, and Prior refers to the decoded bytes of
|
||||
the prior scanline.
|
||||
|
||||
|
||||
6.6. Filter type 4: Paeth
|
||||
|
||||
The Paeth filter computes a simple linear function of the three
|
||||
neighboring pixels (left, above, upper left), then chooses as
|
||||
predictor the neighboring pixel closest to the computed value.
|
||||
This technique is due to Alan W. Paeth [PAETH].
|
||||
|
||||
To compute the Paeth filter, apply the following formula to each
|
||||
byte of the scanline:
|
||||
|
||||
Paeth(x) = Raw(x) - PaethPredictor(Raw(x-bpp), Prior(x), Prior(x-bpp))
|
||||
|
||||
where x ranges from zero to the number of bytes representing the
|
||||
scanline minus one, Raw(x) refers to the raw data byte at that
|
||||
byte position in the scanline, Prior(x) refers to the unfiltered
|
||||
bytes of the prior scanline, and bpp is defined as for the Sub
|
||||
filter.
|
||||
|
||||
Note this is done for each byte, regardless of bit depth.
|
||||
Unsigned arithmetic modulo 256 is used, so that both the inputs
|
||||
and outputs fit into bytes. The sequence of Paeth values is
|
||||
transmitted as the filtered scanline.
|
||||
|
||||
The PaethPredictor function is defined by the following
|
||||
pseudocode:
|
||||
|
||||
function PaethPredictor (a, b, c)
|
||||
begin
|
||||
; a = left, b = above, c = upper left
|
||||
p := a + b - c ; initial estimate
|
||||
pa := abs(p - a) ; distances to a, b, c
|
||||
pb := abs(p - b)
|
||||
pc := abs(p - c)
|
||||
; return nearest of a,b,c,
|
||||
; breaking ties in order a,b,c.
|
||||
if pa <= pb AND pa <= pc then return a
|
||||
else if pb <= pc then return b
|
||||
else return c
|
||||
end
|
||||
|
||||
The calculations within the PaethPredictor function must be
|
||||
performed exactly, without overflow. Arithmetic modulo 256 is to
|
||||
be used only for the final step of subtracting the function result
|
||||
from the target byte value.
|
||||
|
||||
Note that the order in which ties are broken is critical and must
|
||||
not be altered. The tie break order is: pixel to the left, pixel
|
||||
above, pixel to the upper left. (This order differs from that
|
||||
given in Paeth's article.)
|
||||
|
||||
For all x < 0, assume Raw(x) = 0 and Prior(x) = 0. On the first
|
||||
scanline of an image (or of a pass of an interlaced image), assume
|
||||
Prior(x) = 0 for all x.
|
||||
|
||||
To reverse the effect of the Paeth filter after decompression,
|
||||
output the following value:
|
||||
|
||||
Paeth(x) + PaethPredictor(Raw(x-bpp), Prior(x), Prior(x-bpp))
|
||||
|
||||
(computed mod 256), where Raw and Prior refer to bytes already
|
||||
decoded. Exactly the same PaethPredictor function is used by both
|
||||
encoder and decoder.
|
||||
185
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Image/PNM.pm
Normal file
185
Perl OTRS/Kernel/cpan-lib/PDF/API2/Resource/XObject/Image/PNM.pm
Normal file
@@ -0,0 +1,185 @@
|
||||
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;
|
||||
@@ -0,0 +1,317 @@
|
||||
package PDF::API2::Resource::XObject::Image::TIFF;
|
||||
|
||||
use base 'PDF::API2::Resource::XObject::Image';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
no warnings 'uninitialized';
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
use Compress::Zlib;
|
||||
|
||||
use PDF::API2::Basic::PDF::Utils;
|
||||
use PDF::API2::Resource::XObject::Image::TIFF::File;
|
||||
use PDF::API2::Util;
|
||||
use Scalar::Util qw(weaken);
|
||||
|
||||
=head1 NAME
|
||||
|
||||
PDF::API2::Resource::XObject::Image::TIFF - TIFF image support
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item $res = PDF::API2::Resource::XObject::Image::TIFF->new $pdf, $file [, $name]
|
||||
|
||||
Returns a tiff-image object.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ($class, $pdf, $file, $name) = @_;
|
||||
my $self;
|
||||
|
||||
my $tif = PDF::API2::Resource::XObject::Image::TIFF::File->new($file);
|
||||
|
||||
# in case of problematic things
|
||||
# proxy to other modules
|
||||
|
||||
$class = ref($class) if ref($class);
|
||||
|
||||
$self = $class->SUPER::new($pdf, $name || 'Ix' . pdfkey());
|
||||
$pdf->new_obj($self) unless $self->is_obj($pdf);
|
||||
|
||||
$self->{' apipdf'} = $pdf;
|
||||
weaken $self->{' apipdf'};
|
||||
|
||||
$self->read_tiff($pdf, $tif);
|
||||
|
||||
$tif->close();
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub deLZW {
|
||||
my ($ibits, $stream) = @_;
|
||||
my $bits = $ibits;
|
||||
my $resetcode = 1 << ($ibits - 1);
|
||||
my $endcode = $resetcode + 1;
|
||||
my $nextcode = $endcode + 1;
|
||||
my $ptr = 0;
|
||||
$stream = unpack('B*', $stream);
|
||||
my $maxptr = length($stream);
|
||||
my $tag;
|
||||
my $out = '';
|
||||
my $outptr = 0;
|
||||
|
||||
# print STDERR "reset=$resetcode\nend=$endcode\nmax=$maxptr\n";
|
||||
|
||||
my @d = map { chr($_) } (0 .. $resetcode - 1);
|
||||
|
||||
while (($ptr + $bits) <= $maxptr) {
|
||||
$tag=0;
|
||||
foreach my $off (reverse 1 .. $bits) {
|
||||
$tag <<= 1;
|
||||
$tag |= substr($stream, $ptr + $bits - $off, 1);
|
||||
}
|
||||
# print STDERR "ptr=$ptr,tag=$tag,bits=$bits,next=$nextcode\n";
|
||||
# print STDERR "tag to large\n" if($tag>$nextcode);
|
||||
$ptr += $bits;
|
||||
if ($tag == $resetcode) {
|
||||
$bits = $ibits;
|
||||
$nextcode = $endcode + 1;
|
||||
next;
|
||||
}
|
||||
elsif ($tag == $endcode) {
|
||||
last;
|
||||
}
|
||||
elsif ($tag < $resetcode) {
|
||||
$d[$nextcode] = $d[$tag];
|
||||
$out .= $d[$nextcode];
|
||||
$nextcode++;
|
||||
}
|
||||
elsif ($tag > $endcode) {
|
||||
$d[$nextcode] = $d[$tag];
|
||||
$d[$nextcode] .= substr($d[$tag + 1], 0, 1);
|
||||
$out .= $d[$nextcode];
|
||||
$nextcode++;
|
||||
}
|
||||
$bits++ if $nextcode == (1 << $bits);
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub handle_generic {
|
||||
my ($self, $pdf, $tif) = @_;
|
||||
|
||||
if ($tif->{'filter'}) {
|
||||
# should we die here?
|
||||
# die "unknown tiff-compression";
|
||||
$self->filters($tif->{filter});
|
||||
$self->{' nofilt'} = 1;
|
||||
}
|
||||
else {
|
||||
$self->filters('FlateDecode');
|
||||
}
|
||||
|
||||
if (ref($tif->{'imageOffset'})) {
|
||||
$self->{' stream'} = '';
|
||||
my $d = scalar @{$tif->{'imageOffset'}};
|
||||
foreach (1..$d) {
|
||||
my $buf;
|
||||
$tif->{'fh'}->seek(shift(@{$tif->{'imageOffset'}}), 0);
|
||||
$tif->{'fh'}->read($buf, shift(@{$tif->{'imageLength'}}));
|
||||
$self->{' stream'} .= $buf;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
|
||||
$tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub handle_flate {
|
||||
my ($self, $pdf, $tif) = @_;
|
||||
$self->filters('FlateDecode');
|
||||
|
||||
if (ref($tif->{'imageOffset'})) {
|
||||
$self->{' stream'} = '';
|
||||
my $d = scalar @{$tif->{'imageOffset'}};
|
||||
foreach (1 .. $d) {
|
||||
my $buf;
|
||||
$tif->{'fh'}->seek(shift(@{$tif->{'imageOffset'}}),0);
|
||||
$tif->{'fh'}->read($buf, shift(@{$tif->{'imageLength'}}));
|
||||
$buf=uncompress($buf);
|
||||
$self->{' stream'} .= $buf;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
|
||||
$tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
|
||||
$self->{' stream'} = uncompress($self->{' stream'});
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub handle_lzw {
|
||||
my ($self, $pdf, $tif) = @_;
|
||||
$self->filters('FlateDecode');
|
||||
my $imageWidth = $tif->{'imageWidth'};
|
||||
my $mod = $imageWidth % 8;
|
||||
if ($mod > 0) {
|
||||
$imageWidth += 8 - $mod;
|
||||
}
|
||||
my $max_raw_strip = $imageWidth * $tif->{'bitsPerSample'} * $tif->{'RowsPerStrip'} / 8;
|
||||
|
||||
if (ref($tif->{'imageOffset'})) {
|
||||
$self->{' stream'}='';
|
||||
my $d = scalar @{$tif->{'imageOffset'}};
|
||||
foreach (1 .. $d) {
|
||||
my $buf;
|
||||
$tif->{'fh'}->seek(shift(@{$tif->{imageOffset}}), 0);
|
||||
$tif->{'fh'}->read($buf, shift(@{$tif->{'imageLength'}}));
|
||||
$buf = deLZW(9, $buf);
|
||||
if (length($buf) > $max_raw_strip) {
|
||||
$buf = substr($buf, 0, $max_raw_strip);
|
||||
}
|
||||
$self->{' stream'} .= $buf;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
|
||||
$tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
|
||||
$self->{' stream'} = deLZW(9, $self->{' stream'});
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub handle_ccitt {
|
||||
my ($self, $pdf, $tif) = @_;
|
||||
|
||||
$self->{' nofilt'} = 1;
|
||||
$self->{'Filter'} = PDFName('CCITTFaxDecode');
|
||||
$self->{'DecodeParms'} = PDFDict();
|
||||
$self->{'DecodeParms'}->{'K'} = (($tif->{'ccitt'} == 4 || ($tif->{'g3Options'} & 0x1)) ? PDFNum(-1) : PDFNum(0));
|
||||
$self->{'DecodeParms'}->{'Columns'} = PDFNum($tif->{'imageWidth'});
|
||||
$self->{'DecodeParms'}->{'Rows'} = PDFNum($tif->{'imageHeight'});
|
||||
$self->{'DecodeParms'}->{'Blackls1'} = PDFBool($tif->{'whiteIsZero'} == 1 ? 1 : 0);
|
||||
if (defined($tif->{'g3Options'}) && ($tif->{'g3Options'} & 0x4)) {
|
||||
$self->{'DecodeParms'}->{'EndOfLine'} = PDFBool(1);
|
||||
$self->{'DecodeParms'}->{'EncodedByteAlign'} = PDFBool(1);
|
||||
}
|
||||
# $self->{'DecodeParms'} = PDFArray($self->{'DecodeParms'});
|
||||
$self->{'DecodeParms'}->{'DamagedRowsBeforeError'} = PDFNum(100);
|
||||
|
||||
if (ref($tif->{'imageOffset'})) {
|
||||
die "chunked ccitt g4 tif not supported.";
|
||||
}
|
||||
else {
|
||||
$tif->{'fh'}->seek($tif->{'imageOffset'}, 0);
|
||||
$tif->{'fh'}->read($self->{' stream'}, $tif->{'imageLength'});
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub read_tiff {
|
||||
my ($self, $pdf, $tif) = @_;
|
||||
|
||||
$self->width($tif->{'imageWidth'});
|
||||
$self->height($tif->{'imageHeight'});
|
||||
if ($tif->{'colorSpace'} eq 'Indexed') {
|
||||
my $dict = PDFDict();
|
||||
$pdf->new_obj($dict);
|
||||
$self->colorspace(PDFArray(PDFName($tif->{'colorSpace'}), PDFName('DeviceRGB'), PDFNum(255), $dict));
|
||||
$dict->{'Filter'} = PDFArray(PDFName('FlateDecode'));
|
||||
$tif->{'fh'}->seek($tif->{'colorMapOffset'}, 0);
|
||||
my $colormap;
|
||||
my $straight;
|
||||
$tif->{'fh'}->read($colormap, $tif->{'colorMapLength'});
|
||||
$dict->{' stream'} = '';
|
||||
$straight .= pack('C', ($_ / 256)) for unpack($tif->{'short'} . '*', $colormap);
|
||||
foreach my $c (0 .. (($tif->{'colorMapSamples'} / 3) - 1)) {
|
||||
$dict->{' stream'} .= substr($straight, $c, 1);
|
||||
$dict->{' stream'} .= substr($straight, $c + ($tif->{'colorMapSamples'} / 3), 1);
|
||||
$dict->{' stream'} .= substr($straight, $c + ($tif->{'colorMapSamples'} / 3) * 2, 1);
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->colorspace($tif->{'colorSpace'});
|
||||
}
|
||||
|
||||
$self->{'Interpolate'} = PDFBool(1);
|
||||
$self->bpc($tif->{'bitsPerSample'});
|
||||
|
||||
if ($tif->{'whiteIsZero'} == 1 && $tif->{'filter'} ne 'CCITTFaxDecode') {
|
||||
$self->{'Decode'} = PDFArray(PDFNum(1), PDFNum(0));
|
||||
}
|
||||
|
||||
# check filters and handle seperately
|
||||
if (defined $tif->{'filter'} and $tif->{'filter'} eq 'CCITTFaxDecode') {
|
||||
$self->handle_ccitt($pdf, $tif);
|
||||
}
|
||||
elsif (defined $tif->{'filter'} and $tif->{'filter'} eq 'LZWDecode') {
|
||||
$self->handle_lzw($pdf, $tif);
|
||||
}
|
||||
elsif (defined $tif->{'filter'} and $tif->{filter} eq 'FlateDecode') {
|
||||
$self->handle_flate($pdf, $tif);
|
||||
}
|
||||
else {
|
||||
$self->handle_generic($pdf, $tif);
|
||||
}
|
||||
|
||||
if ($tif->{'fillOrder'} == 2) {
|
||||
my @bl = ();
|
||||
foreach my $n (0 .. 255) {
|
||||
my $b = $n;
|
||||
my $f = 0;
|
||||
foreach (0 .. 7) {
|
||||
my $bit = 0;
|
||||
if ($b & 0x1) {
|
||||
$bit = 1;
|
||||
}
|
||||
$b >>= 1;
|
||||
$f <<= 1;
|
||||
$f |= $bit;
|
||||
}
|
||||
$bl[$n] = $f;
|
||||
}
|
||||
my $l = length($self->{' stream'}) - 1;
|
||||
foreach my $n (0 .. $l) {
|
||||
vec($self->{' stream'}, $n, 8) = $bl[vec($self->{' stream'}, $n, 8)];
|
||||
}
|
||||
}
|
||||
$self->{' tiff'} = $tif;
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
=item $value = $tif->tiffTag $tag
|
||||
|
||||
returns the value of the internal tiff-tag.
|
||||
|
||||
B<Useful Tags:>
|
||||
|
||||
imageDescription, imageId (strings)
|
||||
xRes, yRes (dpi; pixel/cm if resUnit==3)
|
||||
resUnit
|
||||
|
||||
=cut
|
||||
|
||||
sub tiffTag {
|
||||
my ($self, $tag) = @_;
|
||||
return $self->{' tiff'}->{$tag};
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
@@ -0,0 +1,281 @@
|
||||
package PDF::API2::Resource::XObject::Image::TIFF::File;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '2.033'; # VERSION
|
||||
|
||||
use IO::File;
|
||||
|
||||
sub new {
|
||||
my ($class, $file) = @_;
|
||||
|
||||
my $self = {};
|
||||
bless($self, $class);
|
||||
if (ref($file)) {
|
||||
$self->{'fh'} = $file;
|
||||
seek($self->{'fh'}, 0, 0);
|
||||
}
|
||||
else {
|
||||
$self->{'fh'} = IO::File->new();
|
||||
open($self->{'fh'}, '<', $file) or die "$!: $file";
|
||||
}
|
||||
binmode($self->{'fh'}, ':raw');
|
||||
my $fh = $self->{'fh'};
|
||||
|
||||
$self->{'offset'} = 0;
|
||||
$fh->seek($self->{'offset'}, 0);
|
||||
|
||||
# checking byte order of data
|
||||
$fh->read($self->{'byteOrder'}, 2);
|
||||
$self->{'byte'} = 'C';
|
||||
$self->{'short'} = (($self->{'byteOrder'} eq 'MM') ? 'n' : 'v' );
|
||||
$self->{'long'} = (($self->{'byteOrder'} eq 'MM') ? 'N' : 'V' );
|
||||
$self->{'rational'} = (($self->{'byteOrder'} eq 'MM') ? 'NN' : 'VV' );
|
||||
|
||||
# get/check version id
|
||||
$fh->read($self->{'version'}, 2);
|
||||
$self->{'version'} = unpack($self->{'short'}, $self->{'version'});
|
||||
die "Wrong TIFF Id '$self->{version}' (should be 42)." if $self->{'version'} != 42;
|
||||
|
||||
# get the offset to the first tag directory.
|
||||
$fh->read($self->{'ifdOffset'}, 4);
|
||||
$self->{'ifdOffset'} = unpack($self->{'long'}, $self->{'ifdOffset'});
|
||||
|
||||
$self->readTags();
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub readTag {
|
||||
my $self = shift();
|
||||
my $fh = $self->{'fh'};
|
||||
my $buf;
|
||||
$fh->read($buf, 12);
|
||||
my $tag = unpack($self->{'short'}, substr($buf, 0, 2));
|
||||
my $type = unpack($self->{'short'}, substr($buf, 2, 2));
|
||||
my $count = unpack($self->{'long'}, substr($buf, 4, 4));
|
||||
my $len = 0;
|
||||
|
||||
$len = ($type == 1 ? $count : # byte
|
||||
$type == 2 ? $count : # char2
|
||||
$type == 3 ? $count * 2 : # int16
|
||||
$type == 4 ? $count * 4 : # int32
|
||||
$type == 5 ? $count * 8 : # rational: 2 * int32
|
||||
$count);
|
||||
|
||||
my $off = substr($buf, 8, 4);
|
||||
|
||||
if ($len > 4) {
|
||||
$off = unpack($self->{'long'}, $off);
|
||||
}
|
||||
else {
|
||||
$off = ($type == 1 ? unpack($self->{'byte'}, $off) :
|
||||
$type == 2 ? unpack($self->{'long'}, $off) :
|
||||
$type == 3 ? unpack($self->{'short'}, $off) :
|
||||
$type == 4 ? unpack($self->{'long'}, $off) : unpack($self->{'short'}, $off));
|
||||
}
|
||||
|
||||
return ($tag, $type, $count, $len, $off);
|
||||
}
|
||||
|
||||
sub close { ## no critic
|
||||
my $self = shift();
|
||||
return $self->{'fh'}->close();
|
||||
}
|
||||
|
||||
sub readTags {
|
||||
my $self = shift();
|
||||
my $fh = $self->{'fh'};
|
||||
$self->{'fillOrder'} = 1;
|
||||
$self->{'ifd'} = $self->{'ifdOffset'};
|
||||
|
||||
while ($self->{'ifd'} > 0) {
|
||||
$fh->seek($self->{'ifd'}, 0);
|
||||
$fh->read($self->{'ifdNum'}, 2);
|
||||
$self->{'ifdNum'} = unpack($self->{'short'}, $self->{'ifdNum'});
|
||||
$self->{'bitsPerSample'} = 1;
|
||||
foreach (1 .. $self->{'ifdNum'}) {
|
||||
my ($valTag, $valType, $valCount, $valLen, $valOffset) = $self->readTag();
|
||||
# print "tag=$valTag type=$valType count=$valCount len=$valLen off=$valOffset\n";
|
||||
if ($valTag == 0) {
|
||||
}
|
||||
elsif ($valTag == 256) {
|
||||
$self->{'imageWidth'} = $valOffset;
|
||||
}
|
||||
elsif ($valTag == 257) {
|
||||
$self->{'imageHeight'} = $valOffset;
|
||||
}
|
||||
elsif ($valTag == 258) {
|
||||
# bits per sample
|
||||
if ($valCount > 1) {
|
||||
my $here = $fh->tell();
|
||||
my $val;
|
||||
$fh->seek($valOffset, 0);
|
||||
$fh->read($val, 2);
|
||||
$self->{'bitsPerSample'} = unpack($self->{'short'}, $val);
|
||||
$fh->seek($here, 0);
|
||||
}
|
||||
else {
|
||||
$self->{'bitsPerSample'} = $valOffset;
|
||||
}
|
||||
}
|
||||
elsif ($valTag == 259) {
|
||||
# compression
|
||||
$self->{'filter'} = $valOffset;
|
||||
if ($valOffset == 1) {
|
||||
delete $self->{'filter'};
|
||||
}
|
||||
elsif ($valOffset == 3 || $valOffset == 4) {
|
||||
$self->{'filter'} = 'CCITTFaxDecode';
|
||||
$self->{'ccitt'} = $valOffset;
|
||||
}
|
||||
elsif ($valOffset == 5) {
|
||||
$self->{'filter'} = 'LZWDecode';
|
||||
}
|
||||
elsif ($valOffset == 6 || $valOffset == 7) {
|
||||
$self->{'filter'} = 'DCTDecode';
|
||||
}
|
||||
elsif ($valOffset == 8 || $valOffset == 0x80b2) {
|
||||
$self->{'filter'} = 'FlateDecode';
|
||||
}
|
||||
elsif ($valOffset == 32773) {
|
||||
$self->{'filter'} = 'RunLengthDecode';
|
||||
}
|
||||
else {
|
||||
die "unknown/unsupported TIFF compression method with id '$self->{filter}'.";
|
||||
}
|
||||
}
|
||||
elsif ($valTag == 262) {
|
||||
# photometric interpretation
|
||||
$self->{'colorSpace'} = $valOffset;
|
||||
if ($valOffset == 0) {
|
||||
$self->{'colorSpace'} = 'DeviceGray';
|
||||
$self->{'whiteIsZero'} = 1;
|
||||
}
|
||||
elsif ($valOffset == 1) {
|
||||
$self->{'colorSpace'} = 'DeviceGray';
|
||||
$self->{'blackIsZero'} = 1;
|
||||
}
|
||||
elsif ($valOffset == 2) {
|
||||
$self->{'colorSpace'} = 'DeviceRGB';
|
||||
}
|
||||
elsif($valOffset == 3) {
|
||||
$self->{'colorSpace'} = 'Indexed';
|
||||
}
|
||||
# elsif($valOffset == 4) {
|
||||
# $self->{'colorSpace'} = 'TransMask';
|
||||
# }
|
||||
elsif ($valOffset == 5) {
|
||||
$self->{'colorSpace'} = 'DeviceCMYK';
|
||||
}
|
||||
elsif($valOffset == 6) {
|
||||
$self->{'colorSpace'} = 'DeviceRGB';
|
||||
}
|
||||
elsif ($valOffset == 8) {
|
||||
$self->{'colorSpace'} = 'Lab';
|
||||
}
|
||||
else {
|
||||
die "unknown/unsupported TIFF photometric interpretation with id '$self->{colorSpace}'.";
|
||||
}
|
||||
}
|
||||
elsif ($valTag == 266) {
|
||||
$self->{'fillOrder'} = $valOffset;
|
||||
}
|
||||
elsif ($valTag == 270) {
|
||||
# ImageDescription
|
||||
my $here = $fh->tell();
|
||||
$fh->seek($valOffset, 0);
|
||||
$fh->read($self->{'imageDescription'}, $valLen);
|
||||
$fh->seek($here, 0);
|
||||
}
|
||||
elsif($valTag == 282) {
|
||||
# xRes
|
||||
my $here = $fh->tell();
|
||||
$fh->seek($valOffset, 0);
|
||||
$fh->read($self->{'xRes'}, $valLen);
|
||||
$fh->seek($here, 0);
|
||||
$self->{'xRes'} = [unpack($self->{'rational'}, $self->{'xRes'})];
|
||||
$self->{'xRes'} = ($self->{'xRes'}->[0] / $self->{'xRes'}->[1]);
|
||||
}
|
||||
elsif($valTag == 283) {
|
||||
# yRes
|
||||
my $here = $fh->tell();
|
||||
$fh->seek($valOffset, 0);
|
||||
$fh->read($self->{'yRes'}, $valLen);
|
||||
$fh->seek($here, 0);
|
||||
$self->{'yRes'} = [unpack($self->{'rational'}, $self->{'yRes'})];
|
||||
$self->{'yRes'} = ($self->{'yRes'}->[0] / $self->{'yRes'}->[1]);
|
||||
}
|
||||
elsif ($valTag == 296) {
|
||||
# resolution Unit
|
||||
$self->{'resUnit'} = $valOffset;
|
||||
}
|
||||
elsif ($valTag == 273) {
|
||||
# image data offset/strip offsets
|
||||
if ($valCount == 1) {
|
||||
$self->{'imageOffset'} = $valOffset;
|
||||
}
|
||||
else {
|
||||
my $here =$fh->tell();
|
||||
my $val;
|
||||
$fh->seek($valOffset, 0);
|
||||
$fh->read($val, $valLen);
|
||||
$fh->seek($here, 0);
|
||||
$self->{'imageOffset'} = [unpack($self->{'long'} . '*', $val)];
|
||||
}
|
||||
}
|
||||
elsif ($valTag == 277) {
|
||||
$self->{'samplesPerPixel'} = $valOffset;
|
||||
}
|
||||
elsif ($valTag == 278) {
|
||||
$self->{'RowsPerStrip'} = $valOffset;
|
||||
}
|
||||
elsif ($valTag == 279) {
|
||||
# image data length/strip lengths
|
||||
if ($valCount == 1) {
|
||||
$self->{'imageLength'} = $valOffset;
|
||||
}
|
||||
else {
|
||||
my $here = $fh->tell();
|
||||
my $val;
|
||||
$fh->seek($valOffset, 0);
|
||||
$fh->read($val, $valLen);
|
||||
$fh->seek($here, 0);
|
||||
$self->{'imageLength'} = [unpack($self->{'long'} . '*', $val)];
|
||||
}
|
||||
}
|
||||
elsif ($valTag == 292) {
|
||||
$self->{'g3Options'} = $valOffset;
|
||||
}
|
||||
elsif ($valTag == 293) {
|
||||
$self->{'g4Options'} = $valOffset;
|
||||
}
|
||||
elsif ($valTag == 320) {
|
||||
# color map
|
||||
$self->{'colorMapOffset'} = $valOffset;
|
||||
$self->{'colorMapSamples'} = $valCount;
|
||||
$self->{'colorMapLength'} = $valCount * 2; # shorts!
|
||||
}
|
||||
elsif ($valTag == 317) {
|
||||
$self->{'lzwPredictor'} = $valOffset;
|
||||
}
|
||||
elsif ($valTag == 0x800d) {
|
||||
# imageID
|
||||
my $here = $fh->tell();
|
||||
$fh->seek($valOffset, 0);
|
||||
$fh->read($self->{'imageId'}, $valLen);
|
||||
$fh->seek($here, 0);
|
||||
}
|
||||
# else {
|
||||
# print "tag=$valTag, type=$valType, len=$valLen\n";
|
||||
# }
|
||||
}
|
||||
$fh->read($self->{'ifd'}, 4);
|
||||
$self->{'ifd'} = unpack($self->{'long'}, $self->{'ifd'});
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user