| 1 | # NOTE: Derived from lib/Image/Size.pm.
|
|---|
| 2 | # Changes made here will be lost when autosplit is run again.
|
|---|
| 3 | # See AutoSplit.pm.
|
|---|
| 4 | package Image::Size;
|
|---|
| 5 |
|
|---|
| 6 | #line 668 "lib/Image/Size.pm (autosplit into blib/lib/auto/Image/Size/gifsize.al)"
|
|---|
| 7 | ###########################################################################
|
|---|
| 8 | # Subroutine gets the size of the specified GIF
|
|---|
| 9 | ###########################################################################
|
|---|
| 10 | sub gifsize
|
|---|
| 11 | {
|
|---|
| 12 | my $stream = shift;
|
|---|
| 13 |
|
|---|
| 14 | my ($cmapsize, $buf, $sh, $sw, $h, $w, $x, $y, $type);
|
|---|
| 15 |
|
|---|
| 16 | my $gif_blockskip = sub {
|
|---|
| 17 | my ($skip, $type) = @_;
|
|---|
| 18 | my ($lbuf);
|
|---|
| 19 |
|
|---|
| 20 | &$read_in($stream, $skip); # Skip header (if any)
|
|---|
| 21 | while (1)
|
|---|
| 22 | {
|
|---|
| 23 | if (&img_eof($stream))
|
|---|
| 24 | {
|
|---|
| 25 | return (undef, undef,
|
|---|
| 26 | "Invalid/Corrupted GIF (at EOF in GIF $type)");
|
|---|
| 27 | }
|
|---|
| 28 | $lbuf = &$read_in($stream, 1); # Block size
|
|---|
| 29 | last if ord($lbuf) == 0; # Block terminator
|
|---|
| 30 | &$read_in($stream, ord($lbuf)); # Skip data
|
|---|
| 31 | }
|
|---|
| 32 | };
|
|---|
| 33 |
|
|---|
| 34 | return (undef, undef,
|
|---|
| 35 | 'Out-of-range value for $Image::Size::GIF_BEHAVIOR: ' .
|
|---|
| 36 | $Image::Size::GIF_BEHAVIOR)
|
|---|
| 37 | if ($Image::Size::GIF_BEHAVIOR > 2);
|
|---|
| 38 |
|
|---|
| 39 | # Skip over the identifying string, since we already know this is a GIF
|
|---|
| 40 | $type = &$read_in($stream, 6);
|
|---|
| 41 | if (length($buf = &$read_in($stream, 7)) != 7 )
|
|---|
| 42 | {
|
|---|
| 43 | return (undef, undef, "Invalid/Corrupted GIF (bad header)");
|
|---|
| 44 | }
|
|---|
| 45 | ($sw, $sh, $x) = unpack("vv C", $buf);
|
|---|
| 46 | if ($Image::Size::GIF_BEHAVIOR == 0)
|
|---|
| 47 | {
|
|---|
| 48 | return ($sw, $sh, 'GIF');
|
|---|
| 49 | }
|
|---|
| 50 |
|
|---|
| 51 | if ($x & 0x80)
|
|---|
| 52 | {
|
|---|
| 53 | $cmapsize = 3 * (2**(($x & 0x07) + 1));
|
|---|
| 54 | if (! &$read_in($stream, $cmapsize))
|
|---|
| 55 | {
|
|---|
| 56 | return (undef, undef,
|
|---|
| 57 | "Invalid/Corrupted GIF (global color map too small?)");
|
|---|
| 58 | }
|
|---|
| 59 | }
|
|---|
| 60 |
|
|---|
| 61 | # Before we start this loop, set $sw and $sh to 0s and use them to track
|
|---|
| 62 | # the largest sub-image in the overall GIF.
|
|---|
| 63 | $sw = $sh = 0;
|
|---|
| 64 |
|
|---|
| 65 | FINDIMAGE:
|
|---|
| 66 | while (1)
|
|---|
| 67 | {
|
|---|
| 68 | if (&img_eof($stream))
|
|---|
| 69 | {
|
|---|
| 70 | # At this point, if we haven't returned then the user wants the
|
|---|
| 71 | # largest of the sub-images. So, if $sh and $sw are still 0s, then
|
|---|
| 72 | # we didn't see even one Image Descriptor block. Otherwise, return
|
|---|
| 73 | # those two values.
|
|---|
| 74 | if ($sw and $sh)
|
|---|
| 75 | {
|
|---|
| 76 | return ($sw, $sh, 'GIF');
|
|---|
| 77 | }
|
|---|
| 78 | else
|
|---|
| 79 | {
|
|---|
| 80 | return (undef, undef,
|
|---|
| 81 | "Invalid/Corrupted GIF (no Image Descriptors)");
|
|---|
| 82 | }
|
|---|
| 83 | }
|
|---|
| 84 | $buf = &$read_in($stream, 1);
|
|---|
| 85 | ($x) = unpack("C", $buf);
|
|---|
| 86 | if ($x == 0x2c)
|
|---|
| 87 | {
|
|---|
| 88 | # Image Descriptor (GIF87a, GIF89a 20.c.i)
|
|---|
| 89 | if (length($buf = &$read_in($stream, 8)) != 8)
|
|---|
| 90 | {
|
|---|
| 91 | return (undef, undef,
|
|---|
| 92 | "Invalid/Corrupted GIF (missing image header?)");
|
|---|
| 93 | }
|
|---|
| 94 | ($x, $y) = unpack("x4 vv", $buf);
|
|---|
| 95 | return ($x, $y, 'GIF') if ($Image::Size::GIF_BEHAVIOR == 1);
|
|---|
| 96 | if ($x > $sw and $y > $sh)
|
|---|
| 97 | {
|
|---|
| 98 | $sw = $x;
|
|---|
| 99 | $sh = $y;
|
|---|
| 100 | }
|
|---|
| 101 | }
|
|---|
| 102 | if ($x == 0x21)
|
|---|
| 103 | {
|
|---|
| 104 | # Extension Introducer (GIF89a 23.c.i, could also be in GIF87a)
|
|---|
| 105 | $buf = &$read_in($stream, 1);
|
|---|
| 106 | ($x) = unpack("C", $buf);
|
|---|
| 107 | if ($x == 0xF9)
|
|---|
| 108 | {
|
|---|
| 109 | # Graphic Control Extension (GIF89a 23.c.ii)
|
|---|
| 110 | &$read_in($stream, 6); # Skip it
|
|---|
| 111 | next FINDIMAGE; # Look again for Image Descriptor
|
|---|
| 112 | }
|
|---|
| 113 | elsif ($x == 0xFE)
|
|---|
| 114 | {
|
|---|
| 115 | # Comment Extension (GIF89a 24.c.ii)
|
|---|
| 116 | &$gif_blockskip(0, "Comment");
|
|---|
| 117 | next FINDIMAGE; # Look again for Image Descriptor
|
|---|
| 118 | }
|
|---|
| 119 | elsif ($x == 0x01)
|
|---|
| 120 | {
|
|---|
| 121 | # Plain Text Label (GIF89a 25.c.ii)
|
|---|
| 122 | &$gif_blockskip(13, "text data");
|
|---|
| 123 | next FINDIMAGE; # Look again for Image Descriptor
|
|---|
| 124 | }
|
|---|
| 125 | elsif ($x == 0xFF)
|
|---|
| 126 | {
|
|---|
| 127 | # Application Extension Label (GIF89a 26.c.ii)
|
|---|
| 128 | &$gif_blockskip(12, "application data");
|
|---|
| 129 | next FINDIMAGE; # Look again for Image Descriptor
|
|---|
| 130 | }
|
|---|
| 131 | else
|
|---|
| 132 | {
|
|---|
| 133 | return (undef, undef,
|
|---|
| 134 | sprintf("Invalid/Corrupted GIF (Unknown " .
|
|---|
| 135 | "extension %#x)", $x));
|
|---|
| 136 | }
|
|---|
| 137 | }
|
|---|
| 138 | else
|
|---|
| 139 | {
|
|---|
| 140 | return (undef, undef,
|
|---|
| 141 | sprintf("Invalid/Corrupted GIF (Unknown code %#x)",
|
|---|
| 142 | $x));
|
|---|
| 143 | }
|
|---|
| 144 | }
|
|---|
| 145 | }
|
|---|
| 146 |
|
|---|
| 147 | # end of Image::Size::gifsize
|
|---|
| 148 | 1;
|
|---|
