#!/usr/bin/perl
#
#  imgdim.pl
#
#  For Windows 9x/2000/XP, Linux, BSD, & Mac OS X.
#
#  Extracts an image's dimensions and formats them for use
#  in an (X)HTML <img> tag, like so:
#
#     width="132" height="237"
#
#  In Windows, the formatted dimensions are put on the
#  clipboard. Under Linux, the formatted dimensions are
#  written to standard out.
#
#  This program works with the standard Web images types
#  GIF, JPEG, and PNG. If the file name doesn't end in GIF or
#  PNG, it is assumed to be a JPEG. (This is a workaround for
#  DOS's 8+3 file name mangling,)
#
#  Windows use: this program is invoked by a batch file that
#  resides on the desktop. Dragging a file to the batch file's
#  icon will invoke this script on the dropped file.
#
#  Linux use: run from the command line as
#  "perl imgdim.pl <image_file>". Depending on your environment,
#  you may also be able to run it as "imgdim.pl <image_file>".
#
#  Mac OS X use: put the script in your home directory. Create
#  a new script in the Script Editor:
#
#     on open file_
#        set file_ to quoted form of POSIX path of file_
#        set the clipboard to (do shell script "" & file_)
#     end open
#
#  Save as an application.
#
#  If the dropped file isn't one of the recognized image
#  types, or isn't openable, this program will exit without
#  an error. (It's better to fail silently than to destroy
#  the clipboard's current contents.)
#
#  Mark L. Irons
#  4-5 April 2002; revised 20 July 2002
#
#  Adrian Tymes
#  18 July 2002
#
#  Scott Crevier
#  29 April 2004
#
#  Barak Shilo
#  30 October 2006
#
#
#  CHANGE HISTORY
#
#  -- 30 October 2006 --
#  Incorporated Barak's changes for Max OS X. Changed format string
#  for GIFs from "SS" to "vv" to deal with endian problem on PowerPCs.
#
#  -- 29 April 2004 --
#  Incorporated Scott's improvements to OS detection.
#
#  -- 23 September 2003 --
#  Changed output to XHTML.
#
#  -- 20 July 2002 --
#  Modified the information at top to incorporate Adrian's changes.
#
#  -- 18 July 2002 --
#  Tweaked to make it run on Linux too.
#
#  -- 5 April 2002 --
#  Added JPEG & PNG support. Not sure JPEG logic is completely
#  correct; is it legal for the opening marker (0xFFD8) to
#  precede later frames?
#
#  -- 4 April 2002 --
#  Program created, and GIF implemented.
#
#
#  NOTES
#
#  1. unpack() is used extensively. The format strings may not
#     port to all systems, though they do seem to work on Windows,
#     Linux, and BSD.
#
#  2. Tested successfully on:
#       * FreeBSD 4.8-STABLE (perl 5.8.3)
#       * Red Hat Linux 6.2
#       * SuSE Linux 8.1 (perl 5.8.0)
#       * Windows 95 (ActivePerl 5.6.0)
#       * Windows 2000 Professional (ActivePerl 5.8.0)
#       * Windows XP 2002 Professional (ActivePerl 5.8.2)
#       * Mac OS X
#
#
#  KNOWN BUGS
#
#  1. If the script is invoked on a file that isn't one of the recognized
#     image types, garbage will be returned.
#
#
#  LEGAL STUFF
#
#  This program 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 of
#  the License, or (at your option) any later version.
#
#  This program 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.
#
#  You may find the full GNU General Public License at
#  http://www.gnu.org/licenses/gpl.txt, or write to the Free
#  Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
#  MA  02111-1307 USA.


#--------------------------------------------------------------------
#
#  P L A T F O R M
#
#--------------------------------------------------------------------
# Figure out what platform we're on (windows or unix). Different
# os's use different environment variables, so this line of code is
# not fool proof in all environments. Just hard-code it if necessary.
$platform = ($ENV{'SHELL'} =~ m|^/|) ? 'unix' : 'windows';


#--------------------------------------------------------------------
#
#  P A T T E R N S
#
#--------------------------------------------------------------------
# Patterns used to match filenames based on their extensions

$GIFpattern  = ".*\.(g|G)(i|I)(f|F)\$";

$PNGpattern  = ".*\.(p|P)(n|N)(g|G)\$";

# JPEGs can have multiple patterns, like ".jpeg" or ".jpg" or
# ".jpe", so default to JPEG if no other pattern matches.  If it's
# not a JPEG but it doesn't match the other known patterns, we'll
# error out anyway.


#--------------------------------------------------------------------
#
#  F I L E   C H E C K
#
#--------------------------------------------------------------------
# $ARGV[0] holds the name of the dragged-and-dropped file.
# We copy it into $_ so that pattern match tests look nice.

$_ = $ARGV[0];

# make sure the file exists
if (! -r) {
#  print STDOUT "File not found: $_\n";   # uncomment if you want
                                          # an error message if the
                                          # file isn't found
  exit(1);
}


#--------------------------------------------------------------------
#
#  C O D E
#
#--------------------------------------------------------------------
# Now we'll try to figure out what kind of file it is, and
# extract the dimensions if it's one we're interested in.
# If there is any kind of error, (-1,-1) will be returned.
# Otherwise, a legitimate image size will be returned.

my ($w,$h) = (-1,-1);
if (/$GIFpattern/) {
  ($w,$h) = &extractGIFdimensions;
}
elsif (/$PNGpattern/) {
  ($w,$h) = &extractPNGdimensions;
}
else {
  ($w,$h) = &extractJPEGdimensions;
}
$output = "width=\"$w\" height=\"$h\"";

# If the width and height are valid, then:
# For Linux: print them to standard out.
# For Windows: create a clipboard object and paste them.
if (($width >= 0) && ($height >= 0)) {
  if ($platform eq 'unix') {
    print STDOUT "$output\n";
  } else {
    require Win32::Clipboard;
    $CLIP = Win32::Clipboard();
    $CLIP->Set("$output");
  }
} else {
  if ($platform eq 'unix') {
    print STDOUT "Could not determine dimensions of '" .
    $ARGV[0] . "'\n";
  } else {
    # fail silently, do not replace clipboard's contents
  }
}


#----------------------------------------------------------------
# sub extractGIFdimensions
#
# In GIF files, the dimensions are four bytes starting at byte 6:
#
# offset    6-7   width   lsb,msb order
#           8-9   height  lsb,msb order
#----------------------------------------------------------------

sub extractGIFdimensions {
  open(IMAGEFILE,$ARGV[0]) || return(-1,-1);
  binmode IMAGEFILE;
  seek(IMAGEFILE,6,0);
  if (read(IMAGEFILE,$dimensions,4) != 4) {
    close IMAGEFILE;
    return(-1,-1);
  }
  close IMAGEFILE;
  ($width,$height) = unpack("vv",$dimensions);
  return ($width,$height);
}


#----------------------------------------------------------------
# sub extractJPEGdimensions
#
#
#   JPEG is a more complicated format than GIF. It starts with
#   two bytes (0xFFD8) identifying a file as a JPEG, followed by
#   frames of data. Frames have the following structure:
#
#   offset   0       0xFF       frame begin
#            1       marker     frame type
#            2-3     length     length of frame
#            4       precision  ?
#            5-6     height     msb,lsb order
#            7-8     width      msb,lsb order
#            9+      data
#
#   The frame types we're interested in is any of the following:
#
#     0xC0, 0xC1, 0xC2, 0xC3, 0xC5, 0xC6, 0xC7, 0xC9,
#     0xCA, 0xCB, 0xCD, 0xCE, 0xCF
#
#   So we do the following:
#
#   1. Read the first two bytes.
#   2. If they're not 0xFFD8, exit. It's not a JPEG.
#   3. Read the next two bytes.
#   4. If the marker isn't one of the interesting types,
#      skip ahead to the next frame and goto step 3.
#   5. Read & return the height and width.
#
#----------------------------------------------------------------

sub extractJPEGdimensions {

  @InterestingMarkers = (0xC0, 0xC1, 0xC2, 0xC3, 0xC5, 0xC6, 0xC7,
                         0xC9, 0xCA, 0xCB, 0xCD, 0xCE, 0xCF);

  open(IMAGEFILE,$ARGV[0]) || return(-1,-1);
  binmode IMAGEFILE;

  #
  #  Read the first marker.
  #

  if ( (read(IMAGEFILE,$firstmarker,2) != 2) ||
       (unpack("n",$firstmarker) != 0xFFD8)) {
    close(IMAGEFILE);
    return(-1,-1);
  }

  #
  #  Follow the chain of frames until we find one with
  #  the image dimensions.
  #

  while (1) {

    #
    #  Read the header of the next frame
    #

    if (read(IMAGEFILE,$frame_header,2) != 2) {
      close(IMAGEFILE);
      return(-1,-1);
    }
    ($boundary,$marker) = unpack("CC",$frame_header);
    if ($boundary != 0xFF) {
      close(IMAGEFILE);
      return(-1,-1);
    }

    #
    #  Does this marker indicate a frame with dimension information?
    #  Exit the loop if it is.
    #

    $found = 1;
    foreach (@InterestingMarkers) {
      if ($marker == $_) {
        $found = 0;
        last;
      }
    }
    last if ($found == 0);

    #
    #  This isn't a frame we want, so read the length and
    #  skip ahead.
    #

    if (read(IMAGEFILE,$frame_length,2) != 2) {
      close(IMAGEFILE);
      return(-1,-1);
    }
    $frame_length = unpack("n",$frame_length);
    seek(IMAGEFILE,$frame_length-2,1);
  }

  #
  #  This frame should hold the image's dimensions. However,
  #  two pieces of information precede the image dimensions:
  #  a 2-byte frame length, and a 1-byte precision (whatever
  #  that is). Read and discard them.
  #

  if (read(IMAGEFILE,$trash,3) != 3) {
    close(IMAGEFILE);
    return(-1,-1);
  }

  #
  #  Read the dimensions, unpack them, and put them on the
  #  Windows clipboard.
  #

  if ((read(IMAGEFILE,$height,2) != 2) || (read(IMAGEFILE,$width,2)  != 2)) {
    close(IMAGEFILE);
    return(-1,-1);
  }
  $height = unpack("n",$height);
  $width  = unpack("n",$width);

  #
  #  Clean up.
  #

  close IMAGEFILE;
  return($width,$height);
}



#----------------------------------------------------------------
# sub extractPNGdimensions
#
# In PNG files, the dimensions are eight bytes starting at
# offset 16:
#
# offset  16-19   width   4 bytes, msb to lsb in order
#         20-23   height  4 bytes, msb to lsb in order
#----------------------------------------------------------------

sub extractPNGdimensions {
  open(IMAGEFILE,$ARGV[0]) || return(-1,-1);
  binmode IMAGEFILE;

  #
  #  We might consider checking whether the file is a PNG.
  #  It should start with the 8-byte pattern
  #  (137, 80, 78, 71, 13, 10, 26, 10).
  #
  #  For now we'll just assume it is and grab the
  #  dimensions.
  #

  seek(IMAGEFILE,16,0);
  if (read(IMAGEFILE,$dimensions,8) != 8) {
    close IMAGEFILE;
    return(-1,-1);
  }
  close IMAGEFILE;
  ($width,$height) = unpack("NN",$dimensions);
  return($width,$height);
}