1package Image::Info::PNG; 2 3# Copyright 1999-2000, Gisle Aas. 4# 5# This library is free software; you can redistribute it and/or 6# modify it under the same terms as Perl itself. 7 8=begin register 9 10MAGIC: /^\x89PNG\x0d\x0a\x1a\x0a/ 11 12Information from IHDR, PLTE, gAMA, pHYs, tEXt, tIME chunks are 13extracted. The sequence of chunks are also given by the C<PNG_Chunks> 14key. 15 16=end register 17 18=cut 19 20use strict; 21 22# Test for Compress::Zlib (for reading zTXt chunks) 23my $have_zlib = 0; 24eval { 25 require Compress::Zlib; 26 $have_zlib++; 27}; 28 29sub my_read 30{ 31 my($source, $len) = @_; 32 my $buf; 33 my $n = read($source, $buf, $len); 34 die "read failed: $!" unless defined $n; 35 die "short read ($len/$n)" unless $n == $len; 36 $buf; 37} 38 39 40sub process_file 41{ 42 my($info, $fh) = @_; 43 44 my $signature = my_read($fh, 8); 45 die "Bad PNG signature" 46 unless $signature eq "\x89PNG\x0d\x0a\x1a\x0a"; 47 48 $info->push_info(0, "file_media_type" => "image/png"); 49 $info->push_info(0, "file_ext" => "png"); 50 51 my @chunks; 52 53 while (1) { 54 my($len, $type) = unpack("Na4", my_read($fh, 8)); 55 56 if (@chunks) { 57 my $last = $chunks[-1]; 58 $last =~ s/\s(\d+)$//; 59 my $count = $1 || 1; 60 if ($last eq $type) { 61 $count++; 62 $chunks[-1] = "$type $count"; 63 } 64 else { 65 push(@chunks, $type); 66 } 67 } 68 else { 69 push(@chunks, $type); 70 } 71 72 last if $type eq "IEND"; 73 my $data = my_read($fh, $len + 4); 74 my $crc = unpack("N", substr($data, -4, 4, "")); 75 if ($type eq "IHDR" && $len == 13) { 76 my($w, $h, $depth, $ctype, $compression, $filter, $interlace) = 77 unpack("NNCCCCC", $data); 78 $ctype = { 79 0 => "Gray", 80 2 => "RGB", 81 3 => "Indexed-RGB", 82 4 => "GrayA", 83 6 => "RGBA", 84 }->{$ctype} || "PNG-$ctype"; 85 86 $compression = "Deflate" if $compression == 0; 87 $filter = "Adaptive" if $filter == 0; 88 $interlace = "Adam7" if $interlace == 1; 89 90 $info->push_info(0, "width", $w); 91 $info->push_info(0, "height", $h); 92 $info->push_info(0, "SampleFormat", "U$depth"); 93 $info->push_info(0, "color_type", $ctype); 94 95 $info->push_info(0, "Compression", $compression); 96 $info->push_info(0, "PNG_Filter", $filter); 97 $info->push_info(0, "Interlace", $interlace) 98 if $interlace; 99 } 100 elsif ($type eq "PLTE") { 101 my @table; 102 while (length $data) { 103 push(@table, sprintf("#%02x%02x%02x", 104 unpack("C3", substr($data, 0, 3, "")))); 105 } 106 $info->push_info(0, "ColorPalette" => \@table); 107 } 108 elsif ($type eq "gAMA" && $len == 4) { 109 $info->push_info(0, "Gamma", unpack("N", $data)/100_000); 110 } 111 elsif ($type eq "pHYs" && $len == 9) { 112 my $res; 113 my($res_x, $res_y, $unit) = unpack("NNC", $data); 114 if (0 && $unit == 1) { 115 # convert to dpi 116 $unit = "dpi"; 117 for ($res_x, $res_y) { 118 $_ *= 0.0254; 119 } 120 } 121 $res = ($res_x == $res_y) ? $res_x : "$res_x/$res_y"; 122 if ($unit) { 123 if ($unit == 1) { 124 $res .= " dpm"; 125 } 126 else { 127 $res .= " png-unit-$unit"; 128 } 129 } 130 $info->push_info(0, "resolution" => $res) 131 } 132 elsif ($type eq "tEXt") { 133 my($key, $val) = split(/\0/, $data, 2); 134 # XXX should make sure $key is not in conflict with any 135 # other key we might generate 136 $info->push_info(0, $key, $val); 137 } 138 elsif ($type eq "zTXt" && $have_zlib) { 139 my($key, $val) = split(/\0/, $data, 2); 140 my($method,$ctext) = split(//, $val, 2); 141 if ($method == 0) { 142 $info->push_info(0, $key, Compress::Zlib::uncompress($ctext)); 143 } else { 144 $info->push_info(0, "Chunk-$type" => $data); 145 } 146 } 147 elsif ($type eq "tIME" && $len == 7) { 148 $info->push_info(0, "LastModificationTime", 149 sprintf("%04d-%02d-%02d %02d:%02d:%02d", 150 unpack("nC5", $data))); 151 } 152 elsif ($type eq "sBIT") { 153 $info->push_info(0, "SignificantBits" => unpack("C*", $data)); 154 } 155 elsif ($type eq "IDAT") { 156 # ignore 157 } 158 else { 159 $info->push_info(0, "Chunk-$type" => $data); 160 } 161 } 162 163 $info->push_info(0, "PNG_Chunks", @chunks); 164 165 unless ($info->get_info(0, "resolution")) { 166 $info->push_info(0, "resolution", "1/1"); 167 } 168} 169 1701; 171