#!/usr/bin/perl
##### Time-stamp: "2005-08-19 01:43:16 ADT" sburke@cpan.org
# desc{ display the comment-blocks of GIF files }
#
# list_gif_comments    v1.0
#  This program displays the contents of comment blocks of GIFs 
#  specified on the command line.
#  It dumps these comments on STDOUT, each comment terminated by
#  a form-feed character.
#  Any warnings will be emitted on STDERR, as necessary.
#
# Author:
#  Sean M. Burke, sburke@ling.nwu.edu, http://www.ling.nwu.edu/~sburke/
#  Copyright 1997- by Sean M. Burke.
#
# Note:
#  This program performs no charset conversion or endline translations
#  on content of the comment blocks.  The GIF89 standard has no
#  recommendations about character sets or enline formats.
#
# Example usage:
#  list_gif_comments.pl mystery_pic.gif | less
#
# Revision notes:
#  v1.0, 1997-08-04.  This is basically a chop-job on "Daktari GIF",
#     my well-known and beloved GIF debugger.  Also look for my
#     "add_gif_comment" program.
#
# Availability & Copying:
#
# list_gif_comments is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2, or
# (at your option) any later version.
#
# list_gif_comments is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# To see a copy of the GNU General Public License, see
# http://www.ling.nwu.edu/~sburke/gnu_release.html, or write to the
# Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
######################################################################

unless (@ARGV) { # nothing to do.  give help.
    print <<USAGE;
list_gif_comments, Sean M. Burke sburke\@cpan.org 1997-08-04.
 Released under the GNU Public License.
 Usage:
    list_gif_comments [filenames]
 where [filenames] is the names of gif files to extract comments from.
 The comments are dumped to STDOUT, with formfeeds at the end of
 each comment block.
 Any warnings will be emitted on STDERR, as necessary.
USAGE
    exit;
}

foreach $filespec (@ARGV) { &dump_comments($filespec); }
print "\n";
exit;

##############################################################################
# Work it!

sub dump_comments {
    local($fn) = @_;
    local($palette, $chunk);

    unless (-f $fn) {
        warn "$fn is not a file.  Skipping.\n";
        return;
    }

    unless (-r $fn) {
        warn "$fn is not readable.  Skipping.\n";
        return;
    }

    if (!open(IMAGE, $fn)) {
        warn "Could not open file $fn\n";
        return;
    }

    binmode(IMAGE); # in case it matters

    $type = &read_n_bytes(6);

    if ($type ne "GIF87a" && $type ne "GIF89a") {
        warn "$fn is not a GIF file.\n";
        close(IMAGE);
        return;
    }

    $file_length = -s $fn;

    # Examine the Screen Descriptor
    local($lsw, $lsh, $pf, $background, $par) =
        unpack("vvCCC", &read_n_bytes(7));

    if ($pf & 0x80) {
        # Is it followed by a global palette? as signalled by "M", the 7th bit
        local($palette_size) = 2 << ($pf & 0x07);
        &read_n_bytes(3 * $palette_size);
    }
    # OK, end of header; go thru all the stuff in this GIF

    # The big loop to parse the rest of the GIF
    while (1) {
        # Get the next marker
        $c = &read_1_byte;

        if ($c == 0x21) {
            # it's a "!" -- one of those GIF extensions.

            $c = &read_1_byte;             # read the label.

            $is_comment = ($c == 254);     # is it a comment?

            # Read the remainder of this Extension Block and while we're at
            # it, read all possible Data Sub-blocks as well.
            
            while ($blksize = &read_1_byte) {
                if ($is_comment) {
                    print &read_n_bytes($blksize); # dump it
                } else {
                    &read_n_bytes($blksize);
                }
            }
            print "\f" if $is_comment;

        } elsif ($c == 0x2c) {  # 2c = image separator character
            # Introduces an Image Descriptor block plus data stream
            local($lp,$tp,$w,$h,$pf) = unpack("vvvvC", &read_n_bytes(9));

            if ($pf & 0x80) {
                # Deal with a local palette
                local($palette_size) = 2 << ($pf & 0x07);
                $palette = &read_n_bytes(3 * $palette_size);
            }

            $c = &read_1_byte;   # read the LZW code size.

            # Now read thru the LZW chunks
            while ($blksize = &read_1_byte) {
                &read_n_bytes($blksize);
            }
            # End of image data.  Loop back and find another GIF block.

        } else { # if it's not a 0x21 or an 0x2C
            # hopefully it's an 0x3b
            $offset = tell(IMAGE);
            $from_end = $file_length - $offset;
            close(IMAGE);
            if ($c == 0x3b) {  # AKA the trailer AKA terminator
                if ($from_end == 0) {
                    # print "GIF terminator at end of file.\n";
                } else {
                    warn "GIF terminator at offset $offset, $from_end byte",
                        $from_end == 1 ? '' : 's', " from end of file.\n";
                }
            } else {
                warn "Unknown GIF block ID: $c\.\n";
                if ($from_end == 0) {
                    warn "Quitting at end of file.\n";
                } else {
                    warn "Quitting at offset $offset, $from_end byte",
                        $from_end == 1 ? '' : 's', " from end of file.\n";
                }
            }
            return; # Stop the analysis of this GIF
        }
    } # End of the loop
}

##############################################################################

sub read_1_byte { # Reads one byte from IMAGE, returns the byte's value (ord)
    # If EOF is reached, terminates with an error message.
    return ord(getc(IMAGE));
}

sub read_n_bytes { # Reads N bytes from IMAGE, returns a string.
    # If EOF is reached, terminates with an error message.
    local($n) = @_;
    local($chunk);
    read(IMAGE, $chunk, $n) == $n ||
        print("Premature EOF in GIF file \"$fn\"!\n");
    return $chunk;
}

sub ushort { # Make a signed short into an unsigned.
    local($n) = @_;
    $n += 65536 if ($n < 0);
    return $n;
}

##############################################################################
# end