1############################################################################### 2# 3# This file copyright (c) 2015 by Randy J. Ray, all rights reserved 4# 5# Copying and distribution are permitted under the terms of the Artistic 6# License 2.0 (http://www.opensource.org/licenses/artistic-license-2.0.php) or 7# the GNU LGPL (http://www.opensource.org/licenses/lgpl-2.1.php). 8# 9############################################################################### 10# 11# Once upon a time, this code was lifted almost verbatim from wwwis by Alex 12# Knowles, alex@ed.ac.uk. Since then, even I barely recognize it. It has 13# contributions, fixes, additions and enhancements from all over the world. 14# 15# See the file ChangeLog for change history. 16# 17############################################################################### 18 19package Image::Size; 20 21require 5.006001; 22 23# These are the Perl::Critic policies that are being turned off globally: 24## no critic(RequireBriefOpen) 25## no critic(ProhibitAutomaticExportation) 26 27use strict; 28use warnings; 29use bytes; 30use vars qw( 31 @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $NO_CACHE %CACHE 32 $GIF_BEHAVIOR @TYPE_MAP %PCD_MAP $PCD_SCALE $READ_IN $LAST_POS 33); 34 35use Exporter 'import'; 36 37BEGIN 38{ 39 @EXPORT = qw(imgsize); 40 @EXPORT_OK = qw(imgsize html_imgsize attr_imgsize 41 %CACHE $NO_CACHE $PCD_SCALE $GIF_BEHAVIOR); 42 %EXPORT_TAGS = ('all' => [ @EXPORT_OK ]); 43 44 $VERSION = '3.300'; 45 $VERSION = eval $VERSION; ## no critic(ProhibitStringyEval) 46 47 # Default behavior for GIFs is to return the "screen" size 48 $GIF_BEHAVIOR = 0; 49} 50 51# This allows people to specifically request that the cache not be used 52$NO_CACHE = 0; 53 54# Package lexicals - invisible to outside world, used only in imgsize 55# 56# Mapping of patterns to the sizing routines 57@TYPE_MAP = ( 58 qr{^GIF8[79]a} => \&gifsize, 59 qr{^\xFF\xD8} => \&jpegsize, 60 qr{^\x89PNG\x0d\x0a\x1a\x0a} => \&pngsize, 61 qr{^P[1-7]} => \&ppmsize, # also XVpics 62 qr{#define\s+\S+\s+\d+} => \&xbmsize, 63 qr{/[*] XPM [*]/} => \&xpmsize, 64 qr{^MM\x00\x2a} => \&tiffsize, 65 qr{^II\x2a\x00} => \&tiffsize, 66 qr{^BM} => \&bmpsize, 67 qr{^8BPS} => \&psdsize, 68 qr{^PCD_OPA} => \&pcdsize, 69 qr{^FWS} => \&swfsize, 70 qr{^CWS} => \&swfmxsize, 71 qr{^\x8aMNG\x0d\x0a\x1a\x0a} => \&mngsize, 72 qr{^\x01\x00\x00\x00} => \&emfsize, 73 qr{^RIFF(?s:....)WEBP} => \&webpsize, 74 qr{^\x00\x00\x01\x00} => \&icosize, 75 qr{^\x00\x00\x02\x00} => \&cursize, 76); 77# Kodak photo-CDs are weird. Don't ask me why, you really don't want details. 78%PCD_MAP = ( 'base/16' => [ 192, 128 ], 79 'base/4' => [ 384, 256 ], 80 'base' => [ 768, 512 ], 81 'base4' => [ 1536, 1024 ], 82 'base16' => [ 3072, 2048 ], 83 'base64' => [ 6144, 4096 ], ); 84# Default scale for PCD images 85$PCD_SCALE = 'base'; 86 87# These are lexically-scoped anonymous subroutines for reading the three 88# types of input streams. When the input to imgsize() is typed, then the 89# lexical "read_in" is assigned one of these, thus allowing the individual 90# routines to operate on these streams abstractly. 91 92my $read_io = sub { 93 my $handle = shift; 94 my ($length, $offset) = @_; 95 96 if (defined($offset) && ($offset != $LAST_POS)) 97 { 98 $LAST_POS = $offset; 99 return q{} if (! seek $handle, $offset, 0); 100 } 101 102 my ($buffer, $rtn) = (q{}, 0); 103 $rtn = read $handle, $buffer, $length; 104 if (! $rtn) 105 { 106 $buffer = q{}; 107 } 108 $LAST_POS = tell $handle; 109 110 return $buffer; 111}; 112 113my $read_buf = sub { 114 my $buf = shift; 115 my ($length, $offset) = @_; 116 117 if (defined($offset) && ($offset != $LAST_POS)) 118 { 119 $LAST_POS = $offset; 120 return q{} if ($LAST_POS > length ${$buf}); 121 } 122 123 my $content = substr ${$buf}, $LAST_POS, $length; 124 $LAST_POS += length $content; 125 126 return $content; 127}; 128 129sub imgsize ## no critic(ProhibitExcessComplexity) 130{ 131 my $stream = shift; 132 133 my ($handle, $header); 134 my ($x, $y, $id, $mtime, @list); 135 # These only used if $stream is an existing open FH 136 my ($save_pos, $need_restore) = (0, 0); 137 # This is for when $stream is a locally-opened file 138 my $need_close = 0; 139 # This will contain the file name, if we got one 140 my $file_name = undef; 141 142 $header = q{}; 143 144 if (ref($stream) eq 'SCALAR') 145 { 146 $handle = $stream; 147 $READ_IN = $read_buf; 148 $header = substr ${$handle} || q{}, 0, 256; 149 } 150 elsif (ref $stream) 151 { 152 # I no longer require $stream to be in the IO::* space. So I'm assuming 153 # you don't hose yourself by passing a ref that can't do fileops. If 154 # you do, you fix it. 155 $handle = $stream; 156 $READ_IN = $read_io; 157 $save_pos = tell $handle; 158 $need_restore = 1; 159 160 # First alteration (didn't wait long, did I?) to the existing handle: 161 # 162 # assist dain-bramaged operating systems -- SWD 163 # SWD: I'm a bit uncomfortable with changing the mode on a file 164 # that something else "owns" ... the change is global, and there 165 # is no way to reverse it. 166 # But image files ought to be handled as binary anyway. 167 binmode $handle; 168 seek $handle, 0, 0; 169 read $handle, $header, 256; 170 seek $handle, 0, 0; 171 } 172 else 173 { 174 if (! $NO_CACHE) 175 { 176 require Cwd; 177 require File::Spec; 178 179 if (! File::Spec->file_name_is_absolute($stream)) 180 { 181 $stream = File::Spec->catfile(Cwd::cwd(), $stream); 182 } 183 $mtime = (stat $stream)[9]; 184 if (-e "$stream" and exists $CACHE{$stream}) 185 { 186 @list = split /,/, $CACHE{$stream}, 4; 187 188 # Don't return the cache if the file is newer. 189 if ($mtime <= $list[0]) 190 { 191 return @list[1 .. 3]; 192 } 193 # In fact, clear it 194 delete $CACHE{$stream}; 195 } 196 } 197 198 # first try to open the stream 199 require Symbol; 200 $handle = Symbol::gensym(); 201 if (! open $handle, '<', $stream) 202 { 203 return (undef, undef, "Can't open image file $stream: $!"); 204 } 205 206 $need_close = 1; 207 # assist dain-bramaged operating systems -- SWD 208 binmode $handle; 209 read $handle, $header, 256; 210 seek $handle, 0, 0; 211 $READ_IN = $read_io; 212 $file_name = $stream; 213 } 214 $LAST_POS = 0; 215 216 # Right now, $x, $y and $id are undef. If the while-loop below doesn't 217 # match the header to a file-type and call a subroutine, then the later 218 # block that tried Image::Magick will default to setting the id/error to 219 # "unknown file type". 220 my $tm_idx = 0; 221 while ($tm_idx < @TYPE_MAP) 222 { 223 if ($header =~ $TYPE_MAP[$tm_idx]) 224 { 225 ($x, $y, $id) = $TYPE_MAP[$tm_idx + 1]->($handle); 226 last; 227 } 228 $tm_idx += 2; 229 } 230 231 # Added as an afterthought: I'm probably not the only one who uses the 232 # same shaded-sphere image for several items on a bulleted list: 233 if (! ($NO_CACHE or (ref $stream) or (! defined $x))) 234 { 235 $CACHE{$stream} = join q{,}, $mtime, $x, $y, $id; 236 } 237 238 # If we were passed an existing file handle, we need to restore the 239 # old filepos: 240 if ($need_restore) 241 { 242 seek $handle, $save_pos, 0; 243 } 244 # ...and if we opened the file ourselves, we need to close it 245 if ($need_close) 246 { 247 close $handle; ## no critic(RequireCheckedClose) 248 } 249 250 if (! defined $id) 251 { 252 if ($file_name) 253 { 254 # Image::Magick operates on file names. 255 ($x, $y, $id) = imagemagick_size($file_name); 256 } 257 else 258 { 259 $id = 'Data stream is not a known image file format'; 260 } 261 } 262 263 # results: 264 return (wantarray) ? ($x, $y, $id) : (); 265} 266 267sub imagemagick_size 268{ 269 my $file_name = shift; 270 271 my $module_name; 272 # First see if we have already loaded Graphics::Magick or Image::Magick 273 # If so, just use whichever one is already loaded. 274 if (exists $INC{'Graphics/Magick.pm'}) 275 { 276 $module_name = 'Graphics::Magick'; 277 } 278 elsif (exists $INC{'Image/Magick.pm'}) 279 { 280 $module_name = 'Image::Magick'; 281 } 282 # If neither are already loaded, try loading either one. 283 elsif (_load_magick_module('Graphics::Magick')) 284 { 285 $module_name = 'Graphics::Magick'; 286 } 287 elsif (_load_magick_module('Image::Magick')) 288 { 289 $module_name = 'Image::Magick'; 290 } 291 292 if ($module_name) 293 { 294 my $img = $module_name->new(); 295 my $x = $img->Read($file_name); 296 # Image::Magick error handling is a bit weird, see 297 # <http://www.simplesystems.org/ImageMagick/www/perl.html#erro> 298 if("$x") { 299 return (undef, undef, "$x"); 300 } else { 301 return ($img->Get('width', 'height', 'format')); 302 } 303 304 } 305 else { 306 return (undef, undef, 'Data stream is not a known image file format'); 307 } 308} 309 310# load Graphics::Magick or Image::Magick if one is not already loaded. 311sub _load_magick_module { 312 my $module_name = shift; 313 my $retval = eval { 314 local $SIG{__DIE__} = q{}; 315 require $module_name; 316 1; 317 }; 318 return $retval ? 1 : 0; 319} 320 321 322sub html_imgsize 323{ 324 my @args = @_; 325 @args = imgsize(@args); 326 327 # Use lowercase and quotes so that it works with xhtml. 328 return ((defined $args[0]) ? 329 sprintf('width="%d" height="%d"', @args[0,1]) : 330 undef); 331} 332 333sub attr_imgsize 334{ 335 my @args = @_; 336 @args = imgsize(@args); 337 338 return ((defined $args[0]) ? 339 (('-width', '-height', @args)[0, 2, 1, 3]) : 340 undef); 341} 342 343# This used only in gifsize: 344sub img_eof 345{ 346 my $stream = shift; 347 348 if (ref($stream) eq 'SCALAR') 349 { 350 return ($LAST_POS >= length ${$stream}); 351 } 352 353 return eof $stream; 354} 355 356# Simple converter-routine used by SWF and CWS code 357sub _bin2int 358{ 359 my $val = shift; 360 # "no critic" because I want it clear which args are being used by 361 # substr() versus unpack(). 362 ## no critic (ProhibitParensWithBuiltins) 363 return unpack 'N', pack 'B32', substr(('0' x 32) . $val, -32); 364} 365 366########################################################################### 367# Subroutine gets the size of the specified GIF 368########################################################################### 369sub gifsize ## no critic(ProhibitExcessComplexity) 370{ 371 my $stream = shift; 372 373 my ($cmapsize, $buf, $sh, $sw, $x, $y, $type); 374 375 my $gif_blockskip = sub { 376 my ($skip, $blocktype) = @_; 377 my ($lbuf); 378 379 $READ_IN->($stream, $skip); # Skip header (if any) 380 while (1) 381 { 382 if (img_eof($stream)) 383 { 384 return (undef, undef, 385 "Invalid/Corrupted GIF (at EOF in GIF $blocktype)"); 386 } 387 $lbuf = $READ_IN->($stream, 1); # Block size 388 last if ord($lbuf) == 0; # Block terminator 389 $READ_IN->($stream, ord $lbuf); # Skip data 390 } 391 }; 392 393 if ($GIF_BEHAVIOR > 2) 394 { 395 return (undef, undef, 396 "\$Image::Size::GIF_BEHAVIOR out of range: $GIF_BEHAVIOR"); 397 } 398 399 # Skip over the identifying string, since we already know this is a GIF 400 $type = $READ_IN->($stream, 6); 401 if (length($buf = $READ_IN->($stream, 7)) != 7 ) 402 { 403 return (undef, undef, 'Invalid/Corrupted GIF (bad header)'); 404 } 405 ($sw, $sh, $x) = unpack 'vv C', $buf; 406 if ($GIF_BEHAVIOR == 0) 407 { 408 return ($sw, $sh, 'GIF'); 409 } 410 411 if ($x & 0x80) 412 { 413 $cmapsize = 3 * (2**(($x & 0x07) + 1)); 414 if (! $READ_IN->($stream, $cmapsize)) 415 { 416 return (undef, undef, 417 'Invalid/Corrupted GIF (global color map too small?)'); 418 } 419 } 420 421 # Before we start this loop, set $sw and $sh to 0s and use them to track 422 # the largest sub-image in the overall GIF. 423 $sw = $sh = 0; 424 425 FINDIMAGE: 426 while (1) 427 { 428 if (img_eof($stream)) 429 { 430 # At this point, if we haven't returned then the user wants the 431 # largest of the sub-images. So, if $sh and $sw are still 0s, then 432 # we didn't see even one Image Descriptor block. Otherwise, return 433 # those two values. 434 if ($sw and $sh) 435 { 436 return ($sw, $sh, 'GIF'); 437 } 438 else 439 { 440 return (undef, undef, 441 'Invalid/Corrupted GIF (no Image Descriptors)'); 442 } 443 } 444 $buf = $READ_IN->($stream, 1); 445 ($x) = unpack 'C', $buf; 446 if ($x == 0x2c) 447 { 448 # Image Descriptor (GIF87a, GIF89a 20.c.i) 449 if (length($buf = $READ_IN->($stream, 8)) != 8) 450 { 451 return (undef, undef, 452 'Invalid/Corrupted GIF (missing image header?)'); 453 } 454 ($x, $y) = unpack 'x4 vv', $buf; 455 return ($x, $y, 'GIF') if ($GIF_BEHAVIOR == 1); 456 if ($x > $sw and $y > $sh) 457 { 458 $sw = $x; 459 $sh = $y; 460 } 461 } 462 if ($x == 0x21) 463 { 464 # Extension Introducer (GIF89a 23.c.i, could also be in GIF87a) 465 $buf = $READ_IN->($stream, 1); 466 ($x) = unpack 'C', $buf; 467 if ($x == 0xF9) 468 { 469 # Graphic Control Extension (GIF89a 23.c.ii) 470 $READ_IN->($stream, 6); # Skip it 471 next FINDIMAGE; # Look again for Image Descriptor 472 } 473 elsif ($x == 0xFE) 474 { 475 # Comment Extension (GIF89a 24.c.ii) 476 $gif_blockskip->(0, 'Comment'); 477 next FINDIMAGE; # Look again for Image Descriptor 478 } 479 elsif ($x == 0x01) 480 { 481 # Plain Text Label (GIF89a 25.c.ii) 482 $gif_blockskip->(13, 'text data'); 483 next FINDIMAGE; # Look again for Image Descriptor 484 } 485 elsif ($x == 0xFF) 486 { 487 # Application Extension Label (GIF89a 26.c.ii) 488 $gif_blockskip->(12, 'application data'); 489 next FINDIMAGE; # Look again for Image Descriptor 490 } 491 else 492 { 493 return (undef, undef, 494 sprintf 'Invalid/Corrupted GIF (Unknown ' . 495 'extension %#x)', $x); 496 } 497 } 498 else 499 { 500 return (undef, undef, 501 sprintf 'Invalid/Corrupted GIF (Unknown code %#x)', $x); 502 } 503 } 504 505 return (undef, undef, 'gifsize fell through to the end, error'); 506} 507 508sub xbmsize 509{ 510 my $stream = shift; 511 512 my $input; 513 my ($x, $y, $id) = (undef, undef, 'Could not determine XBM size'); 514 515 $input = $READ_IN->($stream, 1024); 516 if ($input =~ /^\#define\s*\S*\s*(\d+)\s*\n\#define\s*\S*\s*(\d+)/ix) 517 { 518 ($x, $y) = ($1, $2); 519 $id = 'XBM'; 520 } 521 522 return ($x, $y, $id); 523} 524 525# Added by Randy J. Ray, 30 Jul 1996 526# Size an XPM file by looking for the "X Y N W" line, where X and Y are 527# dimensions, N is the total number of colors defined, and W is the width of 528# a color in the ASCII representation, in characters. We only care about X & Y. 529sub xpmsize 530{ 531 my $stream = shift; 532 533 my $line; 534 my ($x, $y, $id) = (undef, undef, 'Could not determine XPM size'); 535 536 while ($line = $READ_IN->($stream, 1024)) 537 { 538 if ($line =~ /"\s*(\d+)\s+(\d+)(\s+\d+\s+\d+){1,2}\s*"/) 539 { 540 ($x, $y) = ($1, $2); 541 $id = 'XPM'; 542 last; 543 } 544 } 545 546 return ($x, $y, $id); 547} 548 549# pngsize : gets the width & height (in pixels) of a png file 550# cor this program is on the cutting edge of technology! (pity it's blunt!) 551# 552# Re-written and tested by tmetro@vl.com 553sub pngsize 554{ 555 my $stream = shift; 556 557 my ($x, $y, $id) = (undef, undef, 'Could not determine PNG size'); 558 my ($offset, $length); 559 560 # Offset to first Chunk Type code = 8-byte ident + 4-byte chunk length + 1 561 $offset = 12; $length = 4; 562 if ($READ_IN->($stream, $length, $offset) eq 'IHDR') 563 { 564 # IHDR = Image Header 565 $length = 8; 566 ($x, $y) = unpack 'NN', $READ_IN->($stream, $length); 567 $id = 'PNG'; 568 } 569 570 return ($x, $y, $id); 571} 572 573# mngsize: gets the width and height (in pixels) of an MNG file. 574# See <URL:http://www.libpng.org/pub/mng/spec/> for the specification. 575# 576# Basically a copy of pngsize. 577sub mngsize 578{ 579 my $stream = shift; 580 581 my ($x, $y, $id) = (undef, undef, 'Could not determine MNG size'); 582 my ($offset, $length); 583 584 # Offset to first Chunk Type code = 8-byte ident + 4-byte chunk length + 1 585 $offset = 12; $length = 4; 586 if ($READ_IN->($stream, $length, $offset) eq 'MHDR') 587 { 588 # MHDR = Image Header 589 $length = 8; 590 ($x, $y) = unpack 'NN', $READ_IN->($stream, $length); 591 $id = 'MNG'; 592 } 593 594 return ($x, $y, $id); 595} 596 597# jpegsize: gets the width and height (in pixels) of a jpeg file 598# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995 599# modified slightly by alex@ed.ac.uk 600# and further still by rjray@blackperl.com 601# optimization and general re-write from tmetro@vl.com 602sub jpegsize 603{ 604 my $stream = shift; 605 606 my $MARKER = chr 0xff; # Section marker 607 608 my $SIZE_FIRST = 0xC0; # Range of segment identifier codes 609 my $SIZE_LAST = 0xC3; # that hold size info. 610 611 my ($x, $y, $id) = (undef, undef, 'Could not determine JPEG size'); 612 613 my ($marker, $code, $length); 614 my $segheader; 615 616 # Dummy read to skip header ID 617 $READ_IN->($stream, 2); 618 while (1) 619 { 620 $segheader = $READ_IN->($stream, 2); 621 622 # Extract the segment header. 623 ($marker, $code) = unpack 'a a', $segheader; 624 625 while ( $code eq $MARKER && ($marker = $code) ) { 626 $segheader = $READ_IN->($stream, 1); 627 ($code) = unpack 'a', $segheader; 628 } 629 $segheader = $READ_IN->($stream, 2); 630 $length = unpack 'n', $segheader; 631 632 # Verify that it's a valid segment. 633 if ($marker ne $MARKER) 634 { 635 # Was it there? 636 $id = 'JPEG marker not found'; 637 last; 638 } 639 elsif ((ord($code) >= $SIZE_FIRST) && (ord($code) <= $SIZE_LAST)) 640 { 641 # Segments that contain size info 642 $length = 5; 643 my $buf = $READ_IN->($stream, $length); 644 # unpack dies on truncated data 645 last if (length($buf) < $length); 646 ($y, $x) = unpack 'xnn', $buf; 647 $id = 'JPG'; 648 last; 649 } 650 else 651 { 652 # Dummy read to skip over data 653 $READ_IN->($stream, ($length - 2)); 654 } 655 } 656 657 return ($x, $y, $id); 658} 659 660# ppmsize: gets data on the PPM/PGM/PBM family. 661# 662# Contributed by Carsten Dominik <dominik@strw.LeidenUniv.nl> 663sub ppmsize 664{ 665 my $stream = shift; 666 667 my ($x, $y, $id) = 668 (undef, undef, 'Unable to determine size of PPM/PGM/PBM data'); 669 my $n; 670 my @table = qw(nil PBM PGM PPM PBM PGM PPM); 671 672 my $header = $READ_IN->($stream, 1024); 673 674 # PPM file of some sort 675 $header =~ s/^\#.*//mg; 676 if ($header =~ /^(?:P([1-7]))\s+(\d+)\s+(\d+)/) 677 { 678 ($n, $x, $y) = ($1, $2, $3); 679 680 if ($n == 7) 681 { 682 # John Bradley's XV thumbnail pics (from inwap@jomis.Tymnet.COM) 683 $id = 'XV'; 684 ($x, $y) = ($header =~ /IMGINFO:(\d+)x(\d+)/s); 685 } 686 else 687 { 688 $id = $table[$n]; 689 } 690 } 691 692 return ($x, $y, $id); 693} 694 695# tiffsize: size a TIFF image 696# 697# Contributed by Cloyce Spradling <cloyce@headgear.org> 698sub tiffsize 699{ 700 my $stream = shift; 701 702 my ($x, $y, $id) = (undef, undef, 'Unable to determine size of TIFF data'); 703 704 my $endian = 'n'; # Default to big-endian; I like it better 705 my $header = $READ_IN->($stream, 4); 706 if ($header =~ /II\x2a\x00/o) 707 { 708 # little-endian 709 $endian = 'v'; 710 } 711 712 # Set up an association between data types and their corresponding 713 # pack/unpack specification. Don't take any special pains to deal with 714 # signed numbers; treat them as unsigned because none of the image 715 # dimensions should ever be negative. (I hope.) 716 my @packspec = ( undef, # nothing (shouldn't happen) 717 'C', # BYTE (8-bit unsigned integer) 718 undef, # ASCII 719 $endian, # SHORT (16-bit unsigned integer) 720 uc $endian, # LONG (32-bit unsigned integer) 721 undef, # RATIONAL 722 'c', # SBYTE (8-bit signed integer) 723 undef, # UNDEFINED 724 $endian, # SSHORT (16-bit unsigned integer) 725 uc $endian, # SLONG (32-bit unsigned integer) 726 ); 727 728 my $offset = $READ_IN->($stream, 4, 4); # Get offset to IFD 729 $offset = unpack uc $endian, $offset; # Fix it so we can use it 730 731 my $ifd = $READ_IN->($stream, 2, $offset); # Get num. of directory entries 732 my $num_dirent = unpack $endian, $ifd; # Make it useful 733 $offset += 2; 734 $num_dirent = $offset + ($num_dirent * 12); # Calc. maximum offset of IFD 735 736 # Do all the work 737 $ifd = q{}; 738 my $tag = 0; 739 my $type = 0; 740 while ((! defined $x) || (! defined$y)) { 741 $ifd = $READ_IN->($stream, 12, $offset); # Get first directory entry 742 last if (($ifd eq q{}) || ($offset > $num_dirent)); 743 $offset += 12; 744 $tag = unpack $endian, $ifd; # ...and decode its tag 745 $type = unpack $endian, substr $ifd, 2, 2; # ...and the data type 746 # Check the type for sanity. 747 next if (($type > @packspec+0) || (! defined $packspec[$type])); 748 if ($tag == 0x0100) # ImageWidth (x) 749 { 750 # Decode the value 751 $x = unpack $packspec[$type], substr $ifd, 8, 4; 752 } 753 elsif ($tag == 0x0101) # ImageLength (y) 754 { 755 # Decode the value 756 $y = unpack $packspec[$type], substr $ifd, 8, 4; 757 } 758 } 759 760 # Decide if we were successful or not 761 if (defined $x and defined $y) 762 { 763 $id = 'TIF'; 764 } 765 else 766 { 767 $id = q{}; 768 if (! defined $x) 769 { 770 $id = 'ImageWidth '; 771 } 772 if (! defined $y) 773 { 774 if ($id ne q{}) 775 { 776 $id .= 'and '; 777 } 778 $id .= 'ImageLength '; 779 } 780 $id .= 'tag(s) could not be found'; 781 } 782 783 return ($x, $y, $id); 784} 785 786# bmpsize: size a Windows-ish BitMaP image 787# 788# Adapted from code contributed by Aldo Calpini <a.calpini@romagiubileo.it> 789sub bmpsize 790{ 791 my $stream = shift; 792 793 my ($x, $y, $id) = (undef, undef, 'Unable to determine size of BMP data'); 794 my $buffer; 795 796 $buffer = $READ_IN->($stream, 26); 797 my $header_size = unpack 'x14V', $buffer; 798 if ($header_size == 12) 799 { 800 ($x, $y) = unpack 'x18vv', $buffer; # old OS/2 header 801 } 802 else 803 { 804 ($x, $y) = unpack 'x18VV', $buffer; # modern Windows header 805 } 806 if (defined $x and defined $y) 807 { 808 $id = 'BMP'; 809 } 810 811 return ($x, $y, $id); 812} 813 814# psdsize: determine the size of a PhotoShop save-file (*.PSD) 815sub psdsize 816{ 817 my $stream = shift; 818 819 my ($x, $y, $id) = (undef, undef, 'Unable to determine size of PSD data'); 820 my $buffer; 821 822 $buffer = $READ_IN->($stream, 26); 823 ($y, $x) = unpack 'x14NN', $buffer; 824 if (defined $x and defined $y) 825 { 826 $id = 'PSD'; 827 } 828 829 return ($x, $y, $id); 830} 831 832# swfsize: determine size of ShockWave/Flash files. Adapted from code sent by 833# Dmitry Dorofeev <dima@yasp.com> 834sub swfsize 835{ 836 my $image = shift; 837 my $header = $READ_IN->($image, 33); 838 839 my $ver = _bin2int(unpack 'B8', substr $header, 3, 1); 840 my $bs = unpack 'B133', substr $header, 8, 17; 841 my $bits = _bin2int(substr $bs, 0, 5); 842 my $x = int _bin2int(substr $bs, 5+$bits, $bits)/20; 843 my $y = int _bin2int(substr $bs, 5+$bits*3, $bits)/20; 844 845 return ($x, $y, 'SWF'); 846} 847 848# Suggested by Matt Mueller <mueller@wetafx.co.nz>, and based on a piece of 849# sample Perl code by a currently-unknown author. Credit will be placed here 850# once the name is determined. 851sub pcdsize 852{ 853 my $stream = shift; 854 855 my ($x, $y, $id) = (undef, undef, 'Unable to determine size of PCD data'); 856 my $buffer = $READ_IN->($stream, 0xf00); 857 858 # Second-tier sanity check 859 if (substr($buffer, 0x800, 3) ne 'PCD') 860 { 861 return ($x, $y, $id); 862 } 863 864 my $orient = ord(substr $buffer, 0x0e02, 1) & 1; # Clear down to one bit 865 ($x, $y) = @{$Image::Size::PCD_MAP{lc $Image::Size::PCD_SCALE}} 866 [($orient ? (0, 1) : (1, 0))]; 867 868 return ($x, $y, 'PCD'); 869} 870 871# swfmxsize: determine size of compressed ShockWave/Flash MX files. Adapted 872# from code sent by Victor Kuriashkin <victor@yasp.com> 873sub swfmxsize 874{ 875 my $image = shift; 876 877 my $retval = eval { 878 local $SIG{__DIE__} = q{}; 879 require Compress::Zlib; 880 1; 881 }; 882 if (! $retval) 883 { 884 return (undef, undef, "Error loading Compress::Zlib: $@"); 885 } 886 887 my $header = $READ_IN->($image, 1058); 888 my $ver = _bin2int(unpack 'B8', substr $header, 3, 1); 889 890 my ($d, $status) = Compress::Zlib::inflateInit(); 891 $header = substr $header, 8, 1024; 892 $header = $d->inflate($header); 893 894 my $bs = unpack 'B133', substr $header, 0, 17; 895 my $bits = _bin2int(substr $bs, 0, 5); 896 my $x = int _bin2int(substr $bs, 5+$bits, $bits)/20; 897 my $y = int _bin2int(substr $bs, 5+$bits*3, $bits)/20; 898 899 return ($x, $y, 'CWS'); 900} 901 902# Windows EMF files, requested by Jan v/d Zee 903sub emfsize 904{ 905 my $image = shift; 906 907 my ($x, $y); 908 my $buffer = $READ_IN->($image, 24); 909 910 my ($topleft_x, $topleft_y, $bottomright_x, $bottomright_y) = 911 unpack 'x8V4', $buffer; 912 913 # The four values describe a box *around* the image, not *of* the image. 914 # In other words, the dimensions are not inclusive. 915 $x = $bottomright_x - $topleft_x - 1; 916 $y = $bottomright_y - $topleft_y - 1; 917 918 return ($x, $y, 'EMF'); 919} 920 921# WEBP files, see https://developers.google.com/speed/webp/docs/riff_container 922# Added by Baldur Kristinsson, github.com/bk 923sub webpsize { 924 my $img = shift; 925 926 # There are 26 bytes of lead-in, before the width and height info: 927 # 1. WEBP container 928 # - 'RIFF', 4 bytes 929 # - filesize, 4 bytes 930 # - 'WEBP', 4 bytes 931 # 2. VP8 frame 932 # - 'VP8', 3 bytes 933 # - frame meta, 8 bytes 934 # - marker, 3 bytes 935 my $buf = $READ_IN->($img, 4, 26); 936 my ($raw_w, $raw_h) = unpack 'SS', $buf; 937 my $b14 = 2**14 - 1; 938 939 # The width and height values contain a 2-bit scaling factor, 940 # which is left-shifted by 14 bits. We ignore this, since it seems 941 # not to be relevant for our purposes. WEBP images in actual use 942 # all seem to have a scaling factor of 0, anyway. (The meaning 943 # of the scaling factor is as follows: 0=no upscale, 1=upscale by 5/4, 944 # 2=upscale by 5/3, 3=upscale by 2). 945 # 946 # my $wscale = $raw_w >> 14; 947 # my $hscale = $raw_h >> 14; 948 my $x = $raw_w & $b14; 949 my $y = $raw_h & $b14; 950 951 return ($x, $y, 'WEBP'); 952} 953 954# ICO files, originally contributed by Thomas Walloschke <thw@cpan.org>, 955# see https://rt.cpan.org/Public/Bug/Display.html?id=46279 956# (revised by Baldur Kristinsson, github.com/bk) 957sub icosize { 958 my $img = shift; 959 my ($x, $y) = unpack 'CC', $READ_IN->($img, 2, 6); 960 if ($x == 0) { $x = 256; } 961 if ($y == 0) { $y = 256; } 962 return ($x, $y, 'ICO'); 963} 964 965# CUR files, originally contributed by Thomas Walloschke <thw@cpan.org>, 966# see https://rt.cpan.org/Public/Bug/Display.html?id=46279 967# (revised by Baldur Kristinsson, github.com/bk) 968sub cursize { 969 my ($x, $y, $ico) = icosize(shift); 970 return ($x, $y, 'CUR'); 971} 972 973 9741; 975 976__END__ 977 978=encoding utf8 979 980=head1 NAME 981 982Image::Size - read the dimensions of an image in several popular formats 983 984=head1 SYNOPSIS 985 986 use Image::Size; 987 # Get the size of globe.gif 988 ($globe_x, $globe_y) = imgsize("globe.gif"); 989 # Assume X=60 and Y=40 for remaining examples 990 991 use Image::Size 'html_imgsize'; 992 # Get the size as 'width="X" height="Y"' for HTML generation 993 $size = html_imgsize("globe.gif"); 994 # $size == 'width="60" height="40"' 995 996 use Image::Size 'attr_imgsize'; 997 # Get the size as a list passable to routines in CGI.pm 998 @attrs = attr_imgsize("globe.gif"); 999 # @attrs == ('-width', 60, '-height', 40) 1000 1001 use Image::Size; 1002 # Get the size of an in-memory buffer 1003 ($buf_x, $buf_y) = imgsize(\$buf); 1004 # Assuming that $buf was the data, imgsize() needed a 1005 $ reference to a scalar 1006 1007=head1 DESCRIPTION 1008 1009The B<Image::Size> library is based upon the C<wwwis> script written by 1010Alex Knowles I<(alex@ed.ac.uk)>, a tool to examine HTML and add 'width' and 1011'height' parameters to image tags. The sizes are cached internally based on 1012file name, so multiple calls on the same file name (such as images used 1013in bulleted lists, for example) do not result in repeated computations. 1014 1015=head1 SUBROUTINES/METHODS 1016 1017B<Image::Size> provides three interfaces for possible import: 1018 1019=over 1020 1021=item imgsize(I<stream>) 1022 1023Returns a three-item list of the X and Y dimensions (width and height, in 1024that order) and image type of I<stream>. Errors are noted by undefined 1025(B<undef>) values for the first two elements, and an error string in the third. 1026The third element can be (and usually is) ignored, but is useful when 1027sizing data whose type is unknown. 1028 1029=item html_imgsize(I<stream>) 1030 1031Returns the width and height (X and Y) of I<stream> pre-formatted as a single 1032string C<'width="X" height="Y"'> suitable for addition into generated HTML IMG 1033tags. If the underlying call to C<imgsize> fails, B<undef> is returned. The 1034format returned is dually suited to both HTML and XHTML. 1035 1036=item attr_imgsize(I<stream>) 1037 1038Returns the width and height of I<stream> as part of a 4-element list useful 1039for routines that use hash tables for the manipulation of named parameters, 1040such as the Tk or CGI libraries. A typical return value looks like 1041C<("-width", X, "-height", Y)>. If the underlying call to C<imgsize> fails, 1042B<undef> is returned. 1043 1044=back 1045 1046By default, only C<imgsize()> is exported. Any one or combination of the three 1047may be explicitly imported, or all three may be with the tag B<:all>. 1048 1049=head2 Input Types 1050 1051The sort of data passed as I<stream> can be one of three forms: 1052 1053=over 1054 1055=item string 1056 1057If an ordinary scalar (string) is passed, it is assumed to be a file name 1058(either absolute or relative to the current working directory of the 1059process) and is searched for and opened (if found) as the source of data. 1060Possible error messages (see DIAGNOSTICS below) may include file-access 1061problems. 1062 1063=item scalar reference 1064 1065If the passed-in stream is a scalar reference, it is interpreted as pointing 1066to an in-memory buffer containing the image data. 1067 1068 # Assume that &read_data gets data somewhere (WWW, etc.) 1069 $img = &read_data; 1070 ($x, $y, $id) = imgsize(\$img); 1071 # $x and $y are dimensions, $id is the type of the image 1072 1073=item Open file handle 1074 1075The third option is to pass in an open filehandle (such as an object of 1076the C<IO::File> class, for example) that has already been associated with 1077the target image file. The file pointer will necessarily move, but will be 1078restored to its original position before subroutine end. 1079 1080 # $fh was passed in, is IO::File reference: 1081 ($x, $y, $id) = imgsize($fh); 1082 # Same as calling with filename, but more abstract. 1083 1084=back 1085 1086=head2 Recognized Formats 1087 1088Image::Size natively understands and sizes data in the following formats: 1089 1090=over 4 1091 1092=item GIF 1093 1094=item JPG 1095 1096=item XBM 1097 1098=item XPM 1099 1100=item PPM family (PPM/PGM/PBM) 1101 1102=item XV thumbnails 1103 1104=item PNG 1105 1106=item MNG 1107 1108=item TIF 1109 1110=item BMP 1111 1112=item PSD (Adobe PhotoShop) 1113 1114=item SWF (ShockWave/Flash) 1115 1116=item CWS (FlashMX, compressed SWF, Flash 6) 1117 1118=item PCD (Kodak PhotoCD, see notes below) 1119 1120=item EMF (Windows Enhanced Metafile Format) 1121 1122=item WEBP 1123 1124=item ICO (Microsoft icon format) 1125 1126=item CUR (Microsoft mouse cursor format) 1127 1128=back 1129 1130Additionally, if the B<Image::Magick> module is present, the file types 1131supported by it are also supported by Image::Size. See also L<"CAVEATS">. 1132 1133When using the C<imgsize> interface, there is a third, unused value returned 1134if the programmer wishes to save and examine it. This value is the identity of 1135the data type, expressed as a 2-3 letter abbreviation as listed above. This is 1136useful when operating on open file handles or in-memory data, where the type 1137is as unknown as the size. The two support routines ignore this third return 1138value, so those wishing to use it must use the base C<imgsize> routine. 1139 1140Note that when the B<Image::Magick> fallback is used (for all non-natively 1141supported files), the data type identity comes directly from the 'format' 1142parameter reported by B<Image::Magick>, so it may not meet the 2-3 letter 1143abbreviation format. For example, a WBMP file might be reported as 1144'Wireless Bitmap (level 0) image' in this case. 1145 1146=head2 Information Caching and C<$NO_CACHE> 1147 1148When a filename is passed to any of the sizing routines, the default behavior 1149of the library is to cache the resulting information. The modification-time of 1150the file is also recorded, to determine whether the cache should be purged and 1151updated. This was originally added due to the fact that a number of CGI 1152applications were using this library to generate attributes for pages that 1153often used the same graphical element many times over. 1154 1155However, the caching can lead to problems when the files are generated 1156dynamically, at a rate that exceeds the resolution of the modification-time 1157value on the filesystem. Thus, the optionally-importable control variable 1158C<$NO_CACHE> has been introduced. If this value is anything that evaluates to a 1159non-false value (be that the value 1, any non-null string, etc.) then the 1160cacheing is disabled until such time as the program re-enables it by setting 1161the value to false. 1162 1163The parameter C<$NO_CACHE> may be imported as with the B<imgsize> routine, and 1164is also imported when using the import tag B<C<:all>>. If the programmer 1165chooses not to import it, it is still accessible by the fully-qualified package 1166name, B<$Image::Size::NO_CACHE>. 1167 1168=head2 Sharing the Cache Between Processes 1169 1170If you are using B<Image::Size> in a multi-thread or multi-process environment, 1171you may wish to enable sharing of the cached information between the 1172processes (or threads). Image::Size does not natively provide any facility 1173for this, as it would add to the list of dependencies. 1174 1175To make it possible for users to do this themselves, the C<%CACHE> hash-table 1176that B<Image::Size> uses internally for storage may be imported in the B<use> 1177statement. The user may then make use of packages such as B<IPC::MMA> 1178(L<IPC::MMA|IPC::MMA>) that can C<tie> a hash to a shared-memory segment: 1179 1180 use Image::Size qw(imgsize %CACHE); 1181 use IPC::MMA; 1182 1183 ... 1184 1185 tie %CACHE, 'IPC::MM::Hash', $mmHash; # $mmHash via mm_make_hash 1186 # Now, forked processes will share any changes made to the cache 1187 1188=head2 Sizing PhotoCD Images 1189 1190With version 2.95, support for the Kodak PhotoCD image format is 1191included. However, these image files are not quite like the others. One file 1192is the source of the image in any of a range of pre-set resolutions (all with 1193the same aspect ratio). Supporting this here is tricky, since there is nothing 1194inherent in the file to limit it to a specific resolution. 1195 1196The library addresses this by using a scale mapping, and requiring the user 1197(you) to specify which scale is preferred for return. Like the C<$NO_CACHE> 1198setting described earlier, this is an importable scalar variable that may be 1199used within the application that uses B<Image::Size>. This parameter is called 1200C<$PCD_SCALE>, and is imported by the same name. It, too, is also imported 1201when using the tag B<C<:all>> or may be referenced as 1202B<$Image::Size::PCD_SCALE>. 1203 1204The parameter should be set to one of the following values: 1205 1206 base/16 1207 base/4 1208 base 1209 base4 1210 base16 1211 base64 1212 1213Note that not all PhotoCD disks will have included the C<base64> 1214resolution. The actual resolutions are not listed here, as they are constant 1215and can be found in any documentation on the PCD format. The value of 1216C<$PCD_SCALE> is treated in a case-insensitive manner, so C<base> is the same 1217as C<Base> or C<BaSe>. The default scale is set to C<base>. 1218 1219Also note that the library makes no effort to read enough of the PCD file to 1220verify that the requested resolution is available. The point of this library 1221is to read as little as necessary so as to operate efficiently. Thus, the only 1222real difference to be found is in whether the orientation of the image is 1223portrait or landscape. That is in fact all that the library extracts from the 1224image file. 1225 1226=head2 Controlling Behavior with GIF Images 1227 1228GIF images present a sort of unusual situation when it comes to reading size. 1229Because GIFs can be a series of sub-images to be played as an animated 1230sequence, what part does the user want to get the size for? 1231 1232When dealing with GIF files, the user may control the behavior by setting the 1233global value B<$Image::Size::GIF_BEHAVIOR>. Like the PCD setting, this may 1234be imported when loading the library. Three values are recognized by the 1235GIF-handling code: 1236 1237=over 4 1238 1239=item Z<>0 1240 1241This is the default value. When this value is chosen, the returned dimensions 1242are those of the "screen". The "screen" is the display area that the GIF 1243declares in the first data block of the file. No sub-images will be greater 1244than this in size; if they are, the specification dictates that they be 1245cropped to fit within the box. 1246 1247This is also the fastest method for sizing the GIF, as it reads the least 1248amount of data from the image stream. 1249 1250=item Z<>1 1251 1252If this value is set, then the size of the first sub-image within the GIF is 1253returned. For plain (non-animated) GIF files, this would be the same as the 1254screen (though it doesn't have to be, strictly-speaking). 1255 1256When the first image descriptor block is read, the code immediately returns, 1257making this only slightly-less efficient than the previous setting. 1258 1259=item Z<>2 1260 1261If this value is chosen, then the code loops through all the sub-images of the 1262animated GIF, and returns the dimensions of the largest of them. 1263 1264This option requires that the full GIF image be read, in order to ensure that 1265the largest is found. 1266 1267=back 1268 1269Any value outside this range will produce an error in the GIF code before any 1270image data is read. 1271 1272The value of dimensions other than the view-port ("screen") is dubious. 1273However, some users have asked for that functionality. 1274 1275=head1 Image::Size AND WEBSERVERS 1276 1277There are a few approaches to getting the most out of B<Image::Size> in a 1278multi-process webserver environment. The two most common are pre-caching and 1279using shared memory. These examples are focused on Apache, but should be 1280adaptable to other server approaches as well. 1281 1282=head2 Pre-Caching Image Data 1283 1284One approach is to include code in an Apache start-up script that reads the 1285information on all images ahead of time. A script loaded via C<PerlRequire>, 1286for example, becomes part of the server memory before child processes are 1287created. When the children are created, they come into existence with a 1288pre-primed cache already available. 1289 1290The shortcoming of this approach is that you have to plan ahead of time for 1291which image files you need to cache. Also, if the list is long-enough it 1292can slow server start-up time. 1293 1294The advantage is that it keeps the information centralized in one place and 1295thus easier to manage and maintain. It also requires no additional CPAN 1296modules. 1297 1298=head2 Shared Memory Caching 1299 1300Another approach is to introduce a shared memory segment that the individual 1301processes all have access to. This can be done with any of a variety of 1302shared memory modules on CPAN. 1303 1304Probably the easiest way to do this is to use one of the packages that allow 1305the tying of a hash to a shared memory segment. You can use this in 1306combination with importing the hash table variable that is used by 1307B<Image::Size> for the cache, or you can refer to it explicitly by full 1308package name: 1309 1310 use IPC::Shareable; 1311 use Image::Size; 1312 1313 tie %Image::Size::CACHE, 'IPC::Shareable', 'size', { create => 1 }; 1314 1315That example uses B<IPC::Shareable> (see L<IPC::Shareable|IPC::Shareable>) and 1316uses the option to the C<tie> command that tells B<IPC::Shareable> to create 1317the segment. Once the initial server process starts to create children, they 1318will all share the tied handle to the memory segment. 1319 1320Another package that provides this capability is B<IPC::MMA> (see 1321L<IPC::MMA|IPC::MMA>), which provides shared memory management via the I<mm> 1322library from Ralf Engelschall (details available in the documentation for 1323B<IPC::MMA>): 1324 1325 use IPC::MMA; 1326 use Image::Size qw(%CACHE); 1327 1328 my $mm = mm_create(65536, '/tmp/test_lockfile'); 1329 my $mmHash = mm_make_hash($mm); 1330 tie %CACHE, 'IPC::MM::Hash', $mmHash; 1331 1332As before, this is done in the start-up phase of the webserver. As the 1333child processes are created, they inherit the pointer to the existing shared 1334segment. 1335 1336=head1 MORE EXAMPLES 1337 1338The B<attr_imgsize> interface is also well-suited to use with the Tk 1339extension: 1340 1341 $image = $widget->Photo(-file => $img_path, attr_imgsize($img_path)); 1342 1343Since the C<Tk::Image> classes use dashed option names as C<CGI> does, no 1344further translation is needed. 1345 1346This package is also well-suited for use within an Apache web server context. 1347File sizes are cached upon read (with a check against the modified time of 1348the file, in case of changes), a useful feature for a B<mod_perl> environment 1349in which a child process endures beyond the lifetime of a single request. 1350Other aspects of the B<mod_perl> environment cooperate nicely with this 1351module, such as the ability to use a sub-request to fetch the full pathname 1352for a file within the server space. This complements the HTML generation 1353capabilities of the B<CGI> module, in which C<CGI::img> wants a URL but 1354C<attr_imgsize> needs a file path: 1355 1356 # Assume $Q is an object of class CGI, $r is an Apache request object. 1357 # $imgpath is a URL for something like "/img/redball.gif". 1358 $r->print($Q->img({ -src => $imgpath, 1359 attr_imgsize($r->lookup_uri($imgpath)->filename) })); 1360 1361The advantage here, besides not having to hard-code the server document root, 1362is that Apache passes the sub-request through the usual request lifecycle, 1363including any stages that would re-write the URL or otherwise modify it. 1364 1365=head1 DIAGNOSTICS 1366 1367The base routine, C<imgsize>, returns B<undef> as the first value in its list 1368when an error has occurred. The third element contains a descriptive 1369error message. 1370 1371The other two routines simply return B<undef> in the case of error. 1372 1373=head1 CAVEATS 1374 1375Caching of size data can only be done on inputs that are file names. Open 1376file handles and scalar references cannot be reliably transformed into a 1377unique key for the table of cache data. Buffers could be cached using the 1378MD5 module, and perhaps in the future I will make that an option. I do not, 1379however, wish to lengthen the dependency list by another item at this time. 1380 1381As B<Image::Magick> operates on file names, not handles, the use of it is 1382restricted to cases where the input to C<imgsize> is provided as file name. 1383 1384=head1 SEE ALSO 1385 1386L<Image::Magick|Image::Magick> and L<Image::Info|Image::Info> Perl modules at 1387CPAN. The B<Graphics::Magick> Perl API at 1388L<http://www.graphicsmagick.org/perl.html>. 1389 1390=head1 CONTRIBUTORS 1391 1392Perl module interface by Randy J. Ray I<(rjray@blackperl.com)>, original 1393image-sizing code by Alex Knowles I<(alex@ed.ac.uk)> and Andrew Tong 1394I<(werdna@ugcs.caltech.edu)>, used with their joint permission. 1395 1396Some bug fixes submitted by Bernd Leibing I<(bernd.leibing@rz.uni-ulm.de)>. 1397PPM/PGM/PBM sizing code contributed by Carsten Dominik 1398I<(dominik@strw.LeidenUniv.nl)>. Tom Metro I<(tmetro@vl.com)> re-wrote the JPG 1399and PNG code, and also provided a PNG image for the test suite. Dan Klein 1400I<(dvk@lonewolf.com)> contributed a re-write of the GIF code. Cloyce Spradling 1401I<(cloyce@headgear.org)> contributed TIFF sizing code and test images. Aldo 1402Calpini I<(a.calpini@romagiubileo.it)> suggested support of BMP images (which 1403I I<really> should have already thought of :-) and provided code to work 1404with. A patch to allow html_imgsize to produce valid output for XHTML, as 1405well as some documentation fixes was provided by Charles Levert 1406I<(charles@comm.polymtl.ca)>. The ShockWave/Flash support was provided by 1407Dmitry Dorofeev I<(dima@yasp.com)>. Though I neglected to take note of who 1408supplied the PSD (PhotoShop) code, a bug was identified by Alex Weslowski 1409<aweslowski@rpinteractive.com>, who also provided a test image. PCD support 1410was adapted from a script made available by Phil Greenspun, as guided to my 1411attention by Matt Mueller I<mueller@wetafx.co.nz>. A thorough read of the 1412documentation and source by Philip Newton I<Philip.Newton@datenrevision.de> 1413found several typos and a small buglet. Ville Skytt� I<(ville.skytta@iki.fi)> 1414provided the MNG and the Image::Magick fallback code. Craig MacKenna 1415I<(mackenna@animalhead.com)> suggested making the cache available so that it 1416could be used with shared memory, and helped test my change before release. 1417 1418=head1 BUGS 1419 1420Please report any bugs or feature requests to 1421C<bug-image-size at rt.cpan.org>, or through the web interface at 1422L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Image-Size>. I will be 1423notified, and then you'll automatically be notified of progress on 1424your bug as I make changes. 1425 1426=head1 SUPPORT 1427 1428=over 4 1429 1430=item * RT: CPAN's request tracker 1431 1432L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Image-Size> 1433 1434=item * AnnoCPAN: Annotated CPAN documentation 1435 1436L<http://annocpan.org/dist/Image-Size> 1437 1438=item * CPAN Ratings 1439 1440L<http://cpanratings.perl.org/d/Image-Size> 1441 1442=item * Search CPAN 1443 1444L<http://search.cpan.org/dist/Image-Size> 1445 1446=item * Project page on GitHub 1447 1448L<http://github.com/rjray/image-size> 1449 1450=back 1451 1452=head1 REPOSITORY 1453 1454L<https://github.com/rjray/image-size> 1455 1456=head1 LICENSE AND COPYRIGHT 1457 1458This file and the code within are copyright (c) 1996-2009 by Randy J. Ray. 1459 1460Copying and distribution are permitted under the terms of the Artistic 1461License 2.0 (L<http://www.opensource.org/licenses/artistic-license-2.0.php>) or 1462the GNU LGPL 2.1 (L<http://www.opensource.org/licenses/lgpl-2.1.php>). 1463 1464=head1 AUTHOR 1465 1466Randy J. Ray C<< <rjray@blackperl.com> >> 1467 1468=cut 1469