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