#!/usr/local/bin/perl
## PNG Tester for checking MNG/PNG/JNG files
## pngtester.cgi v0.8a May 3 2001 by techan
## Usage: http://(Path)/pngtester.cgi?Filename1[&Filename2][&Filename3]...
## The latest version is here:
## http://homepage2.nifty.com/sophia0/sub04.html
# Do you check CRC? (yes:1 no:0)
$crc_check = 1;
# Do you check pallet colors? (yes:1 no:0)
$pallet_check = 1;
# MainRoutine
%colortypes = ( 0=>"gray", 2=>"RGB", 3=>"palletted", 4=>"gray+alpha", 6=>"RGB+alpha");
# %filtertypes = ( 0=>"none", 1=>"sub", 2=>"up", 3=>"average", 4=>"paeth");
%windowsize = ( 0=>"0.25K", 1=>"0.5K", 2=>"1K", 3=>"2K", 4=>"4K", 5=>"8K", 6=>"16K", 7=>"32K", 8=>"unknown");
%argorithm = ( 0=>"fastest", 1=>"fast", 2=>"default", 3=>"slowest");
%rendering_intent = ( 0=>"perceptual", 1=>"relative colorimetric", 2=>"saturation", 3=>"absolute colorimetric");
%termination = ( 0=>"last frame", 1=>"cease", 2=>"first frame", 3=>"repeat");
%condition = ( 0=>"Deterministic, not cacheable",
1=>"Decoder discretion, not cacheable",
2=>"User discretion, not cacheable",
3=>"External signal, not cacheable",
4=>"Deterministic, cacheable",
5=>"Decoder discretion, cacheable",
6=>"User discretion, cacheable",
7=>"External signal, cacheable");
%change = ( 0=>"No", 1=>"Yes, for the upcoming subframe only",
2=>"Yes, also reset default");
%change_timeout = ( 0=>"No", 1=>"Deterministic, for the upcoming subframe only",
2=>"Deterministic, also reset default",
3=>"Decoder-discretion, for the upcoming subframe only",
4=>"Decoder-discretion, also reset default",
5=>"User-discretion, for the upcoming subframe only",
6=>"User-discretion, also reset default",
7=>"External-signal, for the upcoming subframe only",
8=>"External-signal, also reset default");
%magnification = ( 0=>"no magnification", 1=>"replication of color and alpha",
2=>"mgnified with interpolation of color and alpha",
3=>"magnified with replication of color and alpha",
4=>"magnified with interpolation of color and replication of alpha",
5=>"magnified with interpolation of alpha and replication of color");
%entrytypes = ( 0=>"Segment (nominal)", 1=>"Segment", 2=>"Subframe", 3=>"Exported image");
$buffer = $ENV{'QUERY_STRING'};
if ($buffer) {
@arg=split(/&/, $buffer);
if ($#arg+1) {
for ($i=0;$i<=$#arg;$i++) {
$arg[$i] =~ s/[^\w\-\~\/\.]//g;
}
}
}
$crc_test_ok = 0;
if ($crc_check) { &TestCrc; }
print "Content-type: text/html\n\n";
print "\n\n";
print "PNG TESTER\n";
print "\n\n";
if ($arg[0] eq "") { print 'This script is operable.
'; }
else { foreach $file (@arg) { &Testing($file); } }
print "\n";
print "\n";
exit;
# SubRoutine
sub Testing
{
print "==> Testing file "$file"
\n";
$pngsize= -s $file;
unless (open(IN, "< $file")) {
print "Can\'t open file!
\n";
return;
}
binmode(IN);
read (IN, $sig, 8);
unless (&ValidateSignature) {
close(IN);
print "Bad PNG/MNG/JNG signature!
\n";
return;
}
read (IN, $png, $pngsize-8);
close(IN);
$color="";
$pos=0;
print "\n";
print "\n";
print "\t| $find | \n";
print "\tBytes | \n";
print "\tChunk Data | \n";
if ($crc_test_ok) { print "\tCRC | \n"; }
print "
\n";
1 while (&FindChunk);
print "
\n";
if ($crc_check && !$crc_test_ok) { print "note: Can\'t check CRC.
\n"; }
print "
\n";
}
sub ValidateSignature
{
if ($sig eq "\x89PNG\r\n\x1a\n") { $find = 'PNG'; return 1; }
elsif ($sig eq "\x8aMNG\r\n\x1a\n") { $find = 'MNG'; return 1; }
elsif ($sig eq "\x8bJNG\r\n\x1a\n") { $find = 'JNG'; return 1; }
else { return 0; }
}
sub FindChunk
{
if ($pos >= $pngsize-8) { return 0; }
$chunk=substr($png, $pos, 8);
if (length($chunk) !=8) { return 0; }
($length, $type)=unpack("N A4", $chunk);
$type_data=substr($chunk, 4, 4);
$pos +=8;
$chunk=substr($png,$pos,$length+4);
if (length($chunk) !=$length+4) {
if ($crc_test_ok) { $c_n="4"; }
else { $c_n="3"; }
print "\n\t| Premature end error! | \n
\n";
return 0;
}
$crc=substr($chunk,$length,4);
$chunk=substr($chunk,0,$length);
$data=$type_data.$chunk;
$pos +=$length+4;
print "\n";
print "\t| $type | \n";
print "\t$length | \n";
print "\t";
if (!$length) { print "\@"; }
else {
if ($type eq 'MHDR') { &MHDR; }
elsif ($type eq 'DEFI') { &DEFI; }
elsif ($type eq 'FRAM') { &FRAM; }
elsif ($type eq 'TERM') { &TERM; }
elsif ($type eq 'IHDR') { &IHDR; }
elsif ($type eq 'BASI') { &BASI; }
elsif ($type eq 'PLTE') { &PLTE; }
elsif ($type eq 'JHDR') { &JHDR; }
elsif ($type eq 'DHDR') { &DHDR; }
elsif ($type eq 'IDAT') { &IDAT; }
elsif ($type eq 'gAMA') { &gAMA; }
elsif ($type eq 'sBIT') { &sBIT; }
elsif ($type eq 'sRGB') { &sRGB; }
elsif ($type eq 'tEXt') { &tEXt; }
elsif ($type eq 'zTXt') { &zTXt; }
elsif ($type eq 'iTXt') { &iTXt; }
elsif ($type eq 'sPLT') { &sPLT; }
elsif ($type eq 'iCCP') { &iCCP; }
elsif ($type eq 'tIME') { &tIME; }
elsif ($type eq 'pHYs') { &pHYs; }
elsif ($type eq 'cHRM') { &cHRM; }
elsif ($type eq 'LOOP') { &LOOP; }
elsif ($type eq 'ENDL') { &ENDL; }
elsif ($type eq 'SHOW') { &SHOW; }
elsif ($type eq 'MOVE') { &MOVE; }
elsif ($type eq 'CLON') { &CLON; }
elsif ($type eq 'CLIP') { &CLIP; }
elsif ($type eq 'DISC') { &DISC; }
elsif ($type eq 'PAST') { &PAST; }
elsif ($type eq 'MAGN') { &MAGN; }
elsif ($type eq 'SAVE') { &SAVE; }
elsif ($type eq 'SEEK') { &SEEK; }
elsif ($type eq 'eXPI') { &eXPI; }
elsif ($type eq 'fPRI') { &fPRI; }
elsif ($type eq 'nEED') { &nEED; }
elsif ($type eq 'PROM') { &PROM; }
elsif ($type eq 'DROP') { &DROP; }
elsif ($type eq 'DBYK') { &DBYK; }
elsif ($type eq 'ORDR') { &ORDR; }
elsif ($type eq 'bKGD') { &bKGD; }
elsif ($type eq 'hIST') { &hIST; }
elsif ($type eq 'tRNS') { &tRNS; }
elsif ($type eq 'BACK') { &BACK; }
elsif ($type eq 'PPLT') { &PPLT; }
else { print "\@"; }
}
$previous = $type;
print " | \n";
if ($crc_test_ok) {
print "\t";
if ($crc eq &CalcCrc($data)) { print "OK"; }
else { print "NG"; }
print " | \n";
}
print "
\n";
return 1;
}
sub JHDR
{
my $mpos=0;
$Width = unpack("N",substr($chunk,$mpos,4)); $mpos +=4;
$Height = unpack("N",substr($chunk,$mpos,4)); $mpos +=4;
$Color_type = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Image_sample_depth = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Image_compression_method = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Image_interlace_method = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Alpha_sample_depth = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Alpha_compression_method = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Alpha_filter_method = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Alpha_interlace_method = unpack("C",substr($chunk,$mpos,1));
print "$Width x $Height";
if ($Color_type == 8) { print ", gray"; }
elsif ($Color_type == 10) { print ", color"; }
elsif ($Color_type == 12) { print ", gray-alpha"; }
elsif ($Color_type == 14) { print ", color-alpha"; }
else { print ", unknown color type"; }
if ($Image_sample_depth == 8) { print ", 8 bit"; }
elsif ($Image_sample_depth == 12) { print ", 12 bit"; }
elsif ($Image_sample_depth == 20) { print ", 8+12 bit"; }
else { print ", unknown depth"; }
if ($Image_compression_method == 8) { print ", JPEG"; }
else { print ", unknown compression method"; }
if ($Image_interlace_method == 0) { print ", sequential"; }
elsif ($Image_interlace_method == 8) { print ", progressive"; }
else { print ", unknown interlace"; }
if ($Alpha_compression_method == 0) { print ", $Alpha_sample_depth bit IDAT"; }
elsif ($Alpha_compression_method == 8) { print ", $Alpha_sample_depth bit JDAA"; }
else { print ", unknown alpha compression"; }
if ($Alpha_filter_method !=0) { print ", unknown alpha filter"; }
if ($Alpha_interlace_method !=0) { print ", unknown alpha interlace"; }
}
sub MHDR
{
my $mpos=0;
$Frame_width = unpack("N",substr($chunk,$mpos,4)); $mpos +=4;
$Frame_height = unpack("N",substr($chunk,$mpos,4)); $mpos +=4;
$Ticks_per_second = unpack("N",substr($chunk,$mpos,4)); $mpos +=4;
$Nominal_layer_count = unpack("N",substr($chunk,$mpos,4)); $mpos +=4;
$Nominal_frame_count = unpack("N",substr($chunk,$mpos,4)); $mpos +=4;
$Nominal_play_time = unpack("N",substr($chunk,$mpos,4)); $mpos +=4;
$Simplicity_profile = unpack("N",substr($chunk,$mpos,4));
print "$Frame_width x $Frame_height";
print ", $Ticks_per_second\/s";
print ", $Nominal_layer_count layers";
print ", $Nominal_frame_count frames";
print ", time=$Nominal_play_time";
$first = $Simplicity_profile & 0xff;
$second = ($Simplicity_profile & 0xff00) >> 8;
if ($first & 0x01) { print ", specified"; }
else { print "unspecified"; }
if ($first & 0x02) { print ", simple MNG"; }
if ($first & 0x04) { print ", complex MNG"; }
if ($first & 0x08) { print ", transparency"; }
if ($first & 0x10) { print ", JNG/JDAA"; }
if ($first & 0x20) { print ", Delta-PNG"; }
if ($first & 0x40) {
if ($first & 0x80) { print ", background trasparency"; }
if ($second & 0x01) { print ", semitransparency"; }
if ($second & 0x02) { print ", stored object buffers"; }
}
}
sub IHDR
{
my $mpos=0;
$width = unpack("N", substr($chunk, $mpos, 4)); $mpos+=4;
$height = unpack("N", substr($chunk, $mpos, 4)); $mpos+=4;
$depth = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$color = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$compress = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$filter = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$interlace = unpack("C", substr($chunk, $mpos, 1));
print "$width x $height, $depth-bit depth, $colortypes{$color}";
if ($compress !=0) { print ", unkonwn compression method!"; }
if ($filter == 0) { print ", basic filter"; }
elsif ($filter == 64) { print ", intrapixel differencing filter"; }
else { print ", unknown filter type!"; }
if ($interlace == 0) { print ", not interlaced"; }
elsif ($interlace == 1) { print ", Adam7-interlaced"; }
else { print ", unknown interlace type!"; }
}
sub BASI
{
&IHDR;
my $mpos=13;
if ($length <= $mpos) { return; }
$R_sample = '#'.unpack("H4",substr($chunk,$mpos,2)); $mpos+=2;
if ($color == 0 || $color == 4) { print ", Gray sample: $R_sample"; }
else { print ", Red sample: $R_sample"; }
if ($length <= $mpos) { return; }
if ($color == 0 || $color == 4) { $mpos+=4; }
else {
$G_sample = '#'.unpack("H4",substr($chunk,$mpos,2)); $mpos+=2;
print ", Green sample: $G_sample";
if ($length <= $mpos) { return; }
$B_sample = '#'.unpack("H4",substr($chunk,$mpos,2)); $mpos+=2;
print ", Blue sample: $B_sample";
}
if ($length <= $mpos) { return; }
$A_sample = '#'.unpack("H4",substr($chunk,$mpos,2)); $mpos+=2;
print ", Alpha sample: $A_sample";
if ($length <= $mpos) { return; }
$Viewable = unpack("C", substr($chunk, $mpos, 1));
if ($Viewable == 0) { print ", not viewable"; }
else { print ", viewable"; }
}
sub CLON
{
my $mpos=0;
$Source_id = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
$Clone_id = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print "Source_id=$Source_id, Clone_id=$Clone_id";
if ($length <= $mpos) { return; }
$Clone_type = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
if ($Clone_type == 0) { print ", Full clone"; }
elsif ($Clone_type == 1) { print ", Partial clone"; }
elsif ($Clone_type == 2) { print ", Renumber object"; }
if ($length <= $mpos) { return; }
$Do_not_show = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
if ($Do_not_show == 0) { print ", visible"; }
elsif ($Do_not_show == 1) { print ", not visible"; }
if ($length <= $mpos) { return; }
$Concrete_flag = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
if ($Concrete_flag == 0) { print ", same concrete flag as that of the parent object"; }
elsif ($Concrete_flag == 1) { print ", abstract"; }
if ($length <= $mpos) { return; }
$Loca_delta_type = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$X_location = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Y_location = &CalcNegative(unpack("N", substr($chunk, $mpos, 4)));
if ($Loca_delta_type == 0) { print ", direct location"; }
elsif ($Loca_delta_type == 1) { print ", relative to the position of the parent object"; }
print ", X=$X_location, Y=$Y_location";
}
sub CLIP
{
my $mpos=0;
$First_object = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
$Last_object = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
$Clip_delta_type = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$Left_cb = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Right_cb = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Top_cb = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Bottom_cb = &CalcNegative(unpack("N", substr($chunk, $mpos, 4)));
print "First_object=$First_object, Last_object=$Last_object";
if ($Clip_delta_type == 0) { print ", direct"; }
elsif ($Clip_delta_type == 1) { print ", not direct"; }
print ", Left_cb=$Left_cb, Right_cb=$Right_cb, Top_cb=$Top_cb, Bottom_cb=$Bottom_cb";
}
sub DISC
{
my @Discard_id=();
$D_length = int($length / 2);
@Discard_id = unpack("n$D_length", $chunk);
print "Discard_id: ", join(",",@Discard_id);
}
sub PAST
{
my $mpos=0;
my $i;
my $id_count;
$Destination_id = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print "Destination_id=$Destination_id";
if ($length <= $mpos) { return; }
$Target_delta_type = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$Target_x = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Target_y = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
if ($Target_delta_type == 0) { print ", direct"; }
elsif ($Target_delta_type == 1) { print ", from previous PAST with the same id"; }
elsif ($Target_delta_type == 2) { print ", from previous PAST regardless of its id"; }
print ", Target_x=$Target_x, Target_y=$Target_y";
if ($length <= $mpos) { return; }
if (($length - $mpos) % 30 !=0) { print ", Abnormal data sequence!"; return; }
$id_count = ($length - $mpos) / 30;
for ($i=0;$i<$id_count;$i++) {
$Source_id = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
$Composition_mode = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$Orientation = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$Offset_origin = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$X_offset = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Y_offset = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Boundary_origin = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
$Left_past_cb = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Right_past_cb = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Top_past_cb = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
$Bottom_past_cb = &CalcNegative(unpack("N", substr($chunk, $mpos, 4))); $mpos+=4;
print ", Source_id=$Source_id";
if ($Composition_mode == 0) { print ", composite over"; }
elsif ($Composition_mode == 1) { print ", replace"; }
elsif ($Composition_mode == 2) { print ", composite under"; }
if ($Orientation == 0) { print ", same as source image"; }
elsif ($Orientation == 2) { print ", flipped left-right and up-down"; }
elsif ($Orientation == 4) { print ", flipped left-right"; }
elsif ($Orientation == 6) { print ", flipped up-down"; }
elsif ($Orientation == 8) { print ", tiled with source image"; }
if ($Offset_origin == 0) { print ", Offsets measured from (0,0)"; }
elsif ($Offset_origin == 1) { print ", Offsets measured from (target_x,target_y)"; }
print "X_offset=$X_offset, Y_offset=$Y_offset";
if ($Boundary_origin == 0) { print ", Boundaries measured from (0,0)"; }
elsif ($Boundary_origin == 1) { print ", Boundaries measured from (target_x,target_y)"; }
print ", Left_past_cb=$Left_past_cb, Right_past_cb=$Right_past_cb";
print ", Top_past_cb=$Top_past_cb, Bottom_past_cb=$Bottom_past_cb";
}
}
sub MAGN
{
my $mpos=0;
$First_magnified_object_id = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print "First_magnified_object_id=$First_magnified_object_id";
if ($length <= $mpos) { return; }
$Last_magnified_object_id = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print "Last_magnified_object_id=$Last_magnified_object_id";
if ($length <= $mpos) { return; }
$X_method = unpack("C", substr($chunk, $mpos, 1)); $mpos++;
print ", X_method: $magnification{$X_method}";
if ($length <= $mpos) { return; }
$MX = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print ", MX=$MX";
if ($length <= $mpos) { return; }
$MY = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print ", MY=$MY";
if ($length <= $mpos) { return; }
$ML = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print ", ML=$ML";
if ($length <= $mpos) { return; }
$MR = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print ", MR=$MR";
if ($length <= $mpos) { return; }
$MT = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print ", MT=$MT";
if ($length <= $mpos) { return; }
$MB = unpack("n", substr($chunk, $mpos, 2)); $mpos+=2;
print ", MB=$MB";
if ($length <= $mpos) { return; }
$Y_method = unpack("C", substr($chunk, $mpos, 1));
print ", Y_method: $magnification{$Y_method}";
}
sub DHDR
{
my $mpos=0;
$Object_id = unpack("n", substr($chunk,$mpos,2)); $mpos+=2;
$Image_type = unpack("C", substr($chunk,$mpos,1)); $mpos++;
$Delta_type = unpack("C", substr($chunk,$mpos,1)); $mpos++;
print "object_id=$Object_id";
if ($Image_type == 0) { print ", unspecified image type"; }
elsif ($Image_type == 1) { print ", PNG type"; }
elsif ($Image_type == 2) { print ", JNG type"; }
print ", delta_type=$Delta_type";
if ($length <= $mpos) { return; }
$Block_width = unpack("N", substr($chunk,$mpos,4)); $mpos+=4;
$Block_height = unpack("N", substr($chunk,$mpos,4)); $mpos+=4;
print ", block size= $Block_width x $Block_height";
if ($length <= $mpos) { return; }
$Block_X_location = unpack("N", substr($chunk,$mpos,4)); $mpos+=4;
$Block_Y_location = unpack("N", substr($chunk,$mpos,4)); $mpos+=4;
print ", block location: X=$Block_X_location, Y=$Block_Y_location";
}
sub PLTE
{
my $i;
my @RGB=();
if ($length % 3 !=0) { print "Incorrect pallet entry!"; return; }
$p_entry = $length / 3;
print "$p_entry pallet entries";
if (!$pallet_check) { return; }
for ($i=0;$i<$p_entry;$i++) {
$RGB[$i] = '#'.unpack("H6",substr($chunk,$i*3,3));
}
print ":
", join(", ", @RGB);
}
sub hIST
{
my $i;
my @frequency=();
if ($length % 2 !=0) { print "Incorrect histogram!"; return; }
$h_entry = $length / 2;
print "$h_entry histogram entries";
if (!$pallet_check) { return; }
for ($i=0;$i<$h_entry;$i++) {
$frequency[$i] = '#'.unpack("H4",substr($chunk,$i*2,2));
}
print ":
", join(", ", @frequency);
}
sub bKGD
{
if ($length == 1) {
my $p_index = unpack("C",$chunk);
print "Background pallet index=$p_index";
} elsif ($length == 2) {
my $gray = '#'.unpack("H4",$chunk);
print "Background gray=$gray";
} elsif ($length == 6) {
my $R = '#'.unpack("H4", substr($chunk,0,2));
my $G = '#'.unpack("H4", substr($chunk,2,2));
my $B = '#'.unpack("H4", substr($chunk,4,2));
print "Background color: Red=$R, Green=$G, Blue=$B";
}
}
sub BACK
{
my $mpos=0;
my $R = '#'.unpack("H4",substr($chunk,$mpos,2)); $mpos+=2;
my $G = '#'.unpack("H4",substr($chunk,$mpos,2)); $mpos+=2;
my $B = '#'.unpack("H4",substr($chunk,$mpos,2)); $mpos+=2;
print "Background color: Red=$R, Green=$G, Blue=$B";
if ($length <= $mpos) { return; }
my $M = unpack("C",substr($chunk,$mpos,1)); $mpos++;
if ($M == 0) { print ", advisory color and image"; }
elsif ($M == 1) { print ", mandatory color and advisory image"; }
elsif ($M == 2) { print ", mandatory image and advisory color"; }
elsif ($M == 3) { print ", mandatory color and image"; }
if ($length <= $mpos) { return; }
my $id = unpack("n",substr($chunk,$mpos,2)); $mpos+=2;
print ", Background_image_id=$id";
if ($length <= $mpos) { return; }
my $tile = unpack("C",substr($chunk,$mpos,1));
if ($tile == 0) { print ", not tile"; }
elsif ($tile == 1) { print ", tile"; }
}
sub tRNS
{
if ($color eq "" || $color == 3) {
my @value=();
for ($i=0;$i<$length;$i++) {
$value[$i] = '#'.unpack("H2",substr($chunk,$i,1));
}
print "Alpha: ", join(", ",@value);
} elsif ($color == 0) {
my $gray = '#'.unpack("H4",$chunk);
print "Transparent gray=$gray";
} elsif ($color == 2) {
my $R = '#'.unpack("H4",substr($chunk,0,2));
my $G = '#'.unpack("H4",substr($chunk,2,2));
my $B = '#'.unpack("H4",substr($chunk,4,2));
print "Transparent color: Red=$R, Green=$G, Blue=$B";
} else {
print "unknown!";
}
}
sub IDAT
{
if ($previous eq 'IDAT') { print "\@"; return; }
$cmf_flg = substr($chunk,0,2);
($cmf,$flg) = unpack("CC", $cmf_flg);
if ((($cmf * 256 + $flg) % 31) != 0) { print "incorrect FCHECK"; }
else {
$cm = $cmf & 0x0f;
if ($cm!=8) { print "unknown compression method!"; }
else {
$cinfo = ($cmf & 0xf0) >> 4;
print "$windowsize{$cinfo} window size";
$flg = ($flg & 0xe0) >> 5;
$fdict = $flg & 0x01;
$flevel = ($flg & 0x06) >> 1;
print ", $argorithm{$flevel} argorithm";
if ($fdict) { print ", preset dictionary"; }
}
}
}
sub LOOP
{
my $mpos = 0;
my @Signal_number=();
$Nest_level = unpack("C", substr($chunk,$mpos,1)); $mpos++;
$Iteration_count = unpack("N", substr($chunk,$mpos,4)); $mpos +=4;
print "Nest_level=$Nest_level, Iteration_count=$Iteration_count";
if ($length <= $mpos) { return; }
$Termination_condition = unpack("C", substr($chunk,$mpos,1)); $mpos++;
print ", $condition{$Termination_condition}";
if ($length <= $mpos) { return; }
$Iteration_min = unpack("N", substr($chunk,$mpos,4)); $mpos +=4;
print ", Iteration_min=$Iteration_min";
if ($length <= $mpos) { return; }
$Iteration_max = unpack("N", substr($chunk,$mpos,4)); $mpos +=4;
print ", Iteration_max=$Iteration_max";
if ($length <= $mpos) { return; }
@Signal_number = unpack("N*", substr($chunk,$mpos));
print ", Signal_number: ", join(",",@Signal_number);
}
sub ENDL
{
$Nest_level = unpack("C", substr($chunk,0,1));
print "Nest_level=$Nest_level";
}
sub SHOW
{
my $mpos=0;
$First_image = unpack("n", substr($chunk,$mpos,2)); $mpos+=2;
print "First_image=$First_image";
if ($length < 4) { return; }
$Last_image = unpack("n", substr($chunk,$mpos,2)); $mpos+=2;
print ", Last_image=$Last_image";
if ($length < 5) { return; }
$Show_mode = unpack("C", substr($chunk,$mpos,1));
print ", Show_mode=$Show_mode";
}
sub MOVE
{
my $mpos=0;
$First_object = unpack("n", substr($chunk,$mpos,2)); $mpos+=2;
print "First_object=$First_object";
if ($length < 4) { return; }
$Last_object = unpack("n", substr($chunk,$mpos,2)); $mpos+=2;
print ", Last_object=$Last_object";
if ($length < 5) { return; }
$Location_delta_type = unpack("C", substr($chunk,$mpos,1)); $mpos++;
if ($Location_delta_type == 0) { print ", direct"; }
elsif ($Location_delta_type == 1) { print ", relative to the parent object"; }
if ($length < 13) { return; }
$X_location = &CalcNegative(unpack("N", substr($chunk,$mpos,4))); $mpos+=4;
$Y_location = &CalcNegative(unpack("N", substr($chunk,$mpos,4)));
print ", X=$X_location Y=$Y_location";
}
sub gAMA
{
$gamma= unpack ("N", $chunk) / 100000.0;
printf "%2.4f (1/%2.4f)", $gamma, 1/$gamma;
}
sub sBIT
{
my @values=();
@values = unpack("C$length", $chunk);
print "Significant_bits: ", join(", ",@values);
}
sub sRGB
{
my $render = unpack("C", $chunk);
print "$rendering_intent{$render}";
}
sub tEXt
{
$chunk =~ s/\0/: /;
$chunk =~ s/&/&/g;
$chunk =~ s/\"/"/g;
$chunk =~ s/>/>/g;
$chunk =~ s//>/g;
$Key =~ s/";
if (!$pallet_check) { return; }
if ($Sample_depth == 8) {
if (($length - $mpos) % 6 !=0) {
print ", Abnormal pallet entries";
return;
} else {
while ($length > $mpos) {
$rgb = '#'.unpack("H6", substr($chunk,$mpos,3)); $mpos+=3;
$alpha = '-#'.unpack("H2", substr($chunk,$mpos,1)); $mpos++;
$frequency = '-#'.unpack("H4", substr($chunk,$mpos,2)); $mpos+=2;
print ", $rgb$alpha$frequency";
}
}
} elsif ($Sample_depth == 16) {
if (($length - $mpos) % 10 !=0) {
print ", Abnormal pallet entries";
return;
} else {
while ($length > $mpos) {
$rgb = '#'.unpack("H12", substr($chunk,$mpos,6)); $mpos+=12;
$alpha = '-#'.unpack("H4", substr($chunk,$mpos,2)); $mpos+=2;
$frequency = '-#'.unpack("H4", substr($chunk,$mpos,2)); $mpos+=2;
print ", $rgb$alpha$frequency";
}
}
}
}
sub iCCP
{
&zTXt0;
}
sub tIME
{
($Year,$Month,$Day,$Hour,$Minute,$Second)=unpack("nC5", $chunk);
print "Updated $Year $Month $Day $Hour:$Minute:$Second";
}
sub pHYs
{
($X_pixels_per_unit, $Y_pixels_per_unit, $Unit_specifier)=unpack("NNC", $chunk);
print "X: $X_pixels_per_unit pixels per unit";
print ", Y: $Y_pixels_per_unit pixels per unit, unit: ";
if ($Unit_specifier == 1) { print "meter"; }
else { print "unknown"; }
}
sub cHRM
{
my $mpos=0;
$White_Point_x = unpack("N",substr($chunk,$mpos,4)) / 100000.0; $mpos+=4;
$White_Point_y = unpack("N",substr($chunk,$mpos,4)) / 100000.0; $mpos+=4;
$Red_x = unpack("N",substr($chunk,$mpos,4)) / 100000.0; $mpos+=4;
$Red_y = unpack("N",substr($chunk,$mpos,4)) / 100000.0; $mpos+=4;
$Green_x = unpack("N",substr($chunk,$mpos,4)) / 100000.0; $mpos+=4;
$Green_y = unpack("N",substr($chunk,$mpos,4)) / 100000.0; $mpos+=4;
$Blue_x = unpack("N",substr($chunk,$mpos,4)) / 100000.0; $mpos+=4;
$Blue_y = unpack("N",substr($chunk,$mpos,4)) / 100000.0;
printf "White (x= %2.4f, y= %2.4f) ",$White_Point_x,$White_Point_y;
printf "Red (x= %2.4f, y= %2.4f) ",$Red_x,$Red_y;
printf "Green (x= %2.4f, y= %2.4f) ",$Green_x,$Green_y;
printf "Blue (x= %2.4f, y= %2.4f)",$Blue_x,$Blue_y;
}
sub DEFI
{
my $mpos=0;
$Object_id = unpack("n",substr($chunk,$mpos,2)); $mpos+=2;
print "object_id=$Object_id";
if ($length <= 2) { return; }
$Do_not_show = unpack("C",substr($chunk,$mpos,1)); $mpos++;
if ($Do_not_show) { print ", not visible"; }
else { print ", visible"; }
if ($length <= 3) { return; }
$Concrete_flag = unpack("C",substr($chunk,$mpos,1)); $mpos++;
if ($Concrete_flag) { print ", concrete"; }
else { print ", abstract"; }
if ($length <= 4) { return; }
$X_location = &CalcNegative(unpack("N",substr($chunk,$mpos,4))); $mpos+=4;
$Y_location = &CalcNegative(unpack("N",substr($chunk,$mpos,4))); $mpos+=4;
print ", X=$X_location Y=$Y_location";
if ($length <= 12) { return; }
$Left_cb = &CalcNegative(unpack("N",substr($chunk,$mpos,4))); $mpos+=4;
$Right_cb = &CalcNegative(unpack("N",substr($chunk,$mpos,4))); $mpos+=4;
$Top_cb = &CalcNegative(unpack("N",substr($chunk,$mpos,4))); $mpos+=4;
$Bottom_cb = &CalcNegative(unpack("N",substr($chunk,$mpos,4)));
print ", left_cb=$Left_cb, right_cb=$Right_cb, top_cb=$Top_cb, bottom_cb=$Bottom_cb";
}
sub FRAM
{
my $mpos=0;
$Framing_mode = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print "framing_mode=$Framing_mode";
if ($length <= $mpos) { return; }
$ipos = index($chunk,"\0",$mpos);
if ($ipos != $mpos) {
$Subframe_name = substr($chunk, $mpos, $ipos-$mpos);
print ", "$Subframe_name"";
}
$mpos = $ipos + 1;
if ($length <= $mpos) { return; }
$Change_interframe_delay = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print ", Change_interframe_delay: $change{$Change_interframe_delay}";
if ($length <= $mpos) { return; }
$Change_timeout_and_termination = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print ", Change_timeout: $change_timeout{$Change_timeout_and_termination}";
if ($length <= $mpos) { return; }
$Change_layer_clipping_boundaries = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print ", Change_layer_clipping_boundaries: $change{$Change_layer_clipping_boundaries}";
if ($length <= $mpos) { return; }
$Change_sync_id_list = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print ", Change_sync_id_list: $change{$Change_sync_id_list}";
if ($length <= $mpos) { return; }
$Interframe_delay = unpack("N",substr($chunk,$mpos,4)); $mpos+=4;
print ", Interframe_delay=$Interframe_delay";
if ($length <= $mpos) { return; }
$Timeout = unpack("N",substr($chunk,$mpos,4)); $mpos+=4;
print ", Timeout=$Timeout";
if ($length <= $mpos) { return; }
$Layer_clipping_boundary_delta_type = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print ", Layer_clipping_boundary_delta_type: ";
if ($Layer_clipping_boundary_delta_type == 0) { print "direct"; }
else { print "relative to the previous subframe"; }
if ($length <= $mpos) { return; }
$Left_layer_cb = &CalcNegative(unpack("N",substr($chunk,$mpos,4))); $mpos+=4;
print ", Left_layer_cb=$Left_layer_cb";
if ($length <= $mpos) { return; }
$Right_layer_cb = &CalcNegative(unpack("N",substr($chunk,$mpos,4))); $mpos+=4;
print ", Right_layer_cb=$Right_layer_cb";
if ($length <= $mpos) { return; }
$Top_layer_cb = &CalcNegative(unpack("N",substr($chunk,$mpos,4))); $mpos+=4;
print ", Top_layer_cb=$Top_layer_cb";
if ($length <= $mpos) { return; }
$Bottom_layer_cb = &CalcNegative(unpack("N",substr($chunk,$mpos,4))); $mpos+=4;
print ", Bottom_layer_cb=$Bottom_layer_cb";
if ($length <= $mpos) { return; }
$Sync_id = unpack("N",substr($chunk,$mpos,4));
print ", Sync_id=$Sync_id";
}
sub TERM
{
my $mpos=0;
$Termination_action = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print "Termination_action: $termination{$Termination_action}";
if ($length <= $mpos) { return; }
$Action_after_iterations = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Delay = unpack("N",substr($chunk,$mpos,4)); $mpos+=4;
$Iteration_max = unpack("N",substr($chunk,$mpos,4));
print ", Action_after_iterations: $termination{$Action_after_iterations}";
print ", Delay=$Delay, Iteration_max=$Iteration_max";
}
sub SAVE
{
my $mpos=0;
$Offset_size = unpack("C",substr($chunk,$mpos,1)); $mpos++;
if ($Offset_size == 4) { print "Offsets expressed as 32-bit integers"; }
elsif ($Offset_size == 8) { print "Offsets expressed as 64-bit integers"; }
else { print "unknown offsets"; return; }
while ($length > $mpos) {
$Entry_type = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print ", Entry_type: $entrytypes{$Entry_type}";
if ($Entry_type <= 1) {
if ($Offset_size==4) {
$Offset = unpack("H8", substr($chunk,$mpos,4)); $mpos+=4;
} else {
$Offset = unpack("H16", substr($chunk,$mpos,8)); $mpos+=8;
}
print ", Offset=#$Offset";
}
if ($Entry_type == 0) {
if ($Offset_size == 4) {
$Nominal_start_time = unpack("H8", substr($chunk,$mpos,4)); $mpos+=4;
} else {
$Nominal_start_time = unpack("H16", substr($chunk,$mpos,8)); $mpos+=8;
}
print ", Nominal_start_time=#$Nominal_start_time";
$Nominal_layer_number = unpack("N",substr($chunk,$mpos,4)); $mpos+=4;
print ", Nominal_layer_number=$Nominal_layer_number";
$Nominal_frame_number = unpack("N",substr($chunk,$mpos,4)); $mpos+=4;
print ", Nominal_frame_number=$Nominal_frame_number";
}
if ($length <= $mpos) { last; }
$sep_pos = index($chunk,"\0",$mpos);
if ($sep_pos < 0) {
$Name = substr($chunk,$mpos);
print ", "$Name"";
$mpos = $length-1;
} elsif ($sep_pos != $mpos) {
$Name = substr($chunk,$mpos,$sep_pos-$mpos);
print ", "$Name"";
$mpos=$sep_pos;
}
$mpos++;
}
}
sub SEEK
{
if ($length > 79) { print "Segment_name is abnormal!"; }
else { print "Segment_name: $chunk"; }
}
sub eXPI
{
my $mpos=0;
$Snapshot_id = unpack("n",substr($chunk,$mpos,2)); $mpos+=2;
print "Snapshot_id=$Snapshot_id";
if ($length <= $mpos) { return; }
$Snapshot_name = substr($chunk,$mpos);
print ", Snapshot_name: $Snapshot_name";
}
sub fPRI
{
my $mpos=0;
$fPRI_delta_type = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Priority = unpack("C",substr($chunk,$mpos,1));
if ($fPRI_delta_type == 0) { print "direct"; }
elsif ($fPRI_delta_type == 1) { print "not direct"; }
print ", Priority=$Priority";
}
sub nEED
{
my @needs=();
@needs = split(/\0/, $chunk);
print "Keywords: ", join(",",@needs);
}
sub PROM
{
my $mpos=0;
$New_color_type = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$New_sample_depth = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Fill_method = unpack("C",substr($chunk,$mpos,1));
print "New_color_type=$New_color_type, New_sample_depth=$New_sample_depth";
if ($Fill_method == 0) { print ", left-bit-replication"; }
elsif ($Fill_method == 1) { print ", zero fill"; }
}
sub DROP
{
print "Chunk_name: $chunk";
}
sub DBYK
{
my $mpos=0;
while ($length > $mpos) {
$Chunk_name = substr($chunk,$mpos,4); $mpos+=4;
print "Chunk_name: $Chunk_name";
$Priority = unpack("C", substr($chunk,$mpos,1)); $mpos++;
if ($Priority == 0) { print ", only"; }
elsif ($Priority == 1) { print ", all-but"; }
$null_point = index($chunk,"\0",$mpos);
if ($null_point+1) {
$Keywords = substr($chunk,$mpos,$null_point-$mpos);
print "Keywords: $Keyword";
$mpos=$null_point+1;
} else {
$Keywords = substr($chunk,$mpos);
print "Keywords: $Keyword";
$mpos=$length;
}
}
}
sub ORDR
{
my $mpos=0;
while ($length > $mpos) {
$Chunk_name = substr($chunk,$mpos,4); $mpos+=4;
print "Chunk_name: $Chunk_name";
$Order_type = unpack("C", substr($chunk,$mpos,1)); $mpos++;
if ($Order_type == 0) { print ", anywhere"; }
elsif ($Order_type == 1) { print ", after IDAT/JDAT/JDAA"; }
elsif ($Order_type == 2) { print ", before IDAT/JDAT/JDAA"; }
elsif ($Order_type == 3) { print ", before IDAT but not before PLTE"; }
elsif ($Order_type == 4) { print ", before IDAT but not after PLTE"; }
}
}
sub PPLT
{
my $mpos=0;
my $group=1;
$PPLT_delta_type = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print "PPLT_delta_type: ";
if ($PPLT_delta_type == 0) { print "replacement RBG"; }
elsif ($PPLT_delta_type == 1) { print "delta RBG"; }
elsif ($PPLT_delta_type == 2) { print "replacement alpha"; }
elsif ($PPLT_delta_type == 3) { print "delta alpha"; }
elsif ($PPLT_delta_type == 4) { print "replacement RBG+alpha"; }
elsif ($PPLT_delta_type == 5) { print "delta RBG+alpha"; }
while ($length > $mpos) {
print "
Group=$group: ";
$First_index = unpack("C",substr($chunk,$mpos,1)); $mpos++;
$Last_index = unpack("C",substr($chunk,$mpos,1)); $mpos++;
print "First_index=$First_index to Last_index=$Last_index";
if ($PPLT_delta_type <= 1) {
if ($pallet_check==0) { $mpos+=3; }
else {
for ($i=$First_index;$i<=$Last_index;$i++) {
$rgb = '#'.unpack("H6",substr($chunk,$mpos,3)); $mpos+=3;
print ", $rgb";
}
}
} elsif ($PPLT_delta_type >= 4) {
if ($pallet_check==0) { $mpos+=4; }
else {
for ($i=$First_index;$i<=$Last_index;$i++) {
$rgb = '#'.unpack("H6",substr($chunk,$mpos,3)); $mpos+=3;
$alpha = '-#'.unpack("H2",substr($chunk,$mpos,1)); $mpos++;
print ", $rgba$alpha";
}
}
}
else {
if ($pallet_check==0) { $mpos++; }
else {
for ($i=$First_index;$i<=$Last_index;$i++) {
$alpha = '#'.unpack("H2",substr($chunk,$mpos,1)); $mpos++;
print ", $alpha";
}
}
}
$group++;
}
}
sub CalcNegative
{
my $n =$_[0];
if ($n > 0x7fffffff) { $n = -(~$n + 1); }
return($n);
}
sub CalcCrc
{
my $data = $_[0];
my $c = 0xffffffff;
foreach (unpack("C*", $data)) {
$c = $crc_table[($c ^ $_) & 0xff] ^ (($c >> 8) & 0xffffff);
}
return(pack("N", ~$c));
}
sub TestCrc
{
my $test_data = "IEND";
my $test_crc= "\xaeB`\x82";
&CrcTableInit;
$crc_test_ok = ($test_crc eq &CalcCrc($test_data)) ? 1: 0;
}
sub CrcTableInit
{
my $d;
@crc_table = ();
for (0 .. 255) {
$d = $_;
for (0 .. 7) {
if ($d & 1) { $d = 0xedb88320 ^ (($d >> 1) & 0x7fffffff); }
else { $d = ($d >> 1) & 0x7fffffff; }
}
$crc_table[$_] = $d;
}
}
__END__