Almost-minimal filesystem based blog.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

107 lines
3.6 KiB

  1. package Display::Image;
  2. use base qw(Exporter);
  3. our @EXPORT_OK = qw(image_size image_markup);
  4. =item image_size
  5. Returns (width, height) of a variety of image files. Called by icon_markup and
  6. line_parse. Uses Image::Size if available, otherwise uses a couple of built-in
  7. routines munged together from pngsize and jpegsize in wwwis, by Alex Knowles
  8. and Andrew Tong.
  9. =cut
  10. # needs to call wwwis routine below if we don't have Image::Size...
  11. my $has_imgsize = eval 'use Image::Size;';
  12. sub image_size {
  13. my ($image_file) = shift;
  14. my ($x, $y, $type);
  15. if ($has_imgsize) {
  16. ($x, $y, $type) = imgsize($image_file);
  17. }
  18. else {
  19. ($x, $y) = wwwis($image_file);
  20. }
  21. return ($x, $y);
  22. }
  23. sub wwwis {
  24. my ($image_file) = shift;
  25. my ($head, $if);
  26. if ( ! open $if, '<', $image_file ) {
  27. print STDERR "can't open IMG $image_file";
  28. return (0, 0);
  29. } else {
  30. binmode $if;
  31. if ($image_file =~ m/\.png$/) { # it's a PNG
  32. my ($a, $b, $c, $d, $e, $f, $g, $h) = 0;
  33. if (defined($image_file)
  34. && read($if, $head, 8) == 8
  35. && ($head eq "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" ||
  36. $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a")
  37. && read($if, $head, 4) == 4
  38. && read($if, $head, 4) == 4
  39. && ($head eq "MHDR" || $head eq "IHDR")
  40. && read($if, $head, 8) == 8) {
  41. # ($x, $y) = unpack("I"x2, $head);
  42. # doesn't work on little-endian machines
  43. # return ($x,$y);
  44. ($a,$b,$c,$d,$e,$f,$g,$h) = unpack ("C"x8, $head);
  45. return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h);
  46. }
  47. } elsif ($image_file =~ m/\.jpe?g$/) { # it's a JPEG
  48. my($done) = 0;
  49. my($c1,$c2,$ch,$s,$length, $dummy) = (0,0,0,0,0,0);
  50. my($a,$b,$c,$d);
  51. if (defined($image_file)
  52. && read($if, $c1, 1)
  53. && read($if, $c2, 1)
  54. && ord($c1) == 0xFF
  55. && ord($c2) == 0xD8) {
  56. while (ord($ch) != 0xDA && !$done) {
  57. # Find next marker (JPEG markers begin with 0xFF)
  58. # This can hang the program!!
  59. while (ord($ch) != 0xFF) {
  60. return(0,0) unless read($if, $ch, 1);
  61. }
  62. # JPEG markers can be padded with unlimited 0xFF's
  63. while (ord($ch) == 0xFF) {
  64. return(0,0) unless read($if, $ch, 1);
  65. }
  66. # Now, $ch contains the value of the marker.
  67. if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) {
  68. return(0,0) unless read ($if, $dummy, 3);
  69. return(0,0) unless read($if, $s, 4);
  70. ($a,$b,$c,$d)=unpack("C"x4,$s);
  71. return ($c<<8|$d, $a<<8|$b );
  72. } else {
  73. # We **MUST** skip variables, since FF's within
  74. # variable names are NOT valid JPEG markers
  75. return(0,0) unless read ($if, $s, 2);
  76. ($c1, $c2) = unpack("C"x2,$s);
  77. $length = $c1<<8|$c2;
  78. last if (!defined($length) || $length < 2);
  79. read($if, $dummy, $length-2);
  80. }
  81. }
  82. }
  83. }
  84. return (0,0);
  85. }
  86. }
  87. 1;