package Display::Image; use base qw(Exporter); our @EXPORT_OK = qw(image_size image_markup); =item image_size Returns (width, height) of a variety of image files. Called by icon_markup and line_parse. Uses Image::Size if available, otherwise uses a couple of built-in routines munged together from pngsize and jpegsize in wwwis, by Alex Knowles and Andrew Tong. =cut # needs to call wwwis routine below if we don't have Image::Size... my $has_imgsize = eval 'use Image::Size;'; sub image_size { my ($image_file) = shift; my ($x, $y, $type); if ($has_imgsize) { ($x, $y, $type) = imgsize($image_file); } else { ($x, $y) = wwwis($image_file); } return ($x, $y); } sub wwwis { my ($image_file) = shift; my ($head, $if); if ( ! open $if, '<', $image_file ) { print STDERR "can't open IMG $image_file"; return (0, 0); } else { binmode $if; if ($image_file =~ m/\.png$/) { # it's a PNG my ($a, $b, $c, $d, $e, $f, $g, $h) = 0; if (defined($image_file) && read($if, $head, 8) == 8 && ($head eq "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" || $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a") && read($if, $head, 4) == 4 && read($if, $head, 4) == 4 && ($head eq "MHDR" || $head eq "IHDR") && read($if, $head, 8) == 8) { # ($x, $y) = unpack("I"x2, $head); # doesn't work on little-endian machines # return ($x,$y); ($a,$b,$c,$d,$e,$f,$g,$h) = unpack ("C"x8, $head); return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h); } } elsif ($image_file =~ m/\.jpe?g$/) { # it's a JPEG my($done) = 0; my($c1,$c2,$ch,$s,$length, $dummy) = (0,0,0,0,0,0); my($a,$b,$c,$d); if (defined($image_file) && read($if, $c1, 1) && read($if, $c2, 1) && ord($c1) == 0xFF && ord($c2) == 0xD8) { while (ord($ch) != 0xDA && !$done) { # Find next marker (JPEG markers begin with 0xFF) # This can hang the program!! while (ord($ch) != 0xFF) { return(0,0) unless read($if, $ch, 1); } # JPEG markers can be padded with unlimited 0xFF's while (ord($ch) == 0xFF) { return(0,0) unless read($if, $ch, 1); } # Now, $ch contains the value of the marker. if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) { return(0,0) unless read ($if, $dummy, 3); return(0,0) unless read($if, $s, 4); ($a,$b,$c,$d)=unpack("C"x4,$s); return ($c<<8|$d, $a<<8|$b ); } else { # We **MUST** skip variables, since FF's within # variable names are NOT valid JPEG markers return(0,0) unless read ($if, $s, 2); ($c1, $c2) = unpack("C"x2,$s); $length = $c1<<8|$c2; last if (!defined($length) || $length < 2); read($if, $dummy, $length-2); } } } } return (0,0); } } 1;