fileformatdocs/jpegdump.pl

   1 #!perl
   2 use strict;
   3 use Getopt::Long;
   4
   5 my $dumpall = 0;
   6 my $exiffile;
   7 GetOptions(dumpall => \$dumpall,
   8            "e|exif=s" => \$exiffile);
   9
  10 my $file = shift
  11   or die "Usage: $0 filename\n";
  12
  13 open my $fh, "<", $file
  14   or die "$0: cannot open '$file': $!\n";
  15
  16 binmode $fh;
  17
  18
  19 while (!eof($fh)) {
  20   my $chead;
  21   unless (read($fh, $chead, 2) == 2) {
  22     eof $fh or die "Failed to read start of chunk: $!";
  23     last;
  24   }
  25   if ($chead eq "\xFF\xD8") {
  26     print "Start of image\n";
  27   }
  28   elsif ($chead =~ /^\xFF[\xE0-\xEF]$/) {
  29     # APP0-APP15
  30     my $clen;
  31     unless (read($fh, $clen, 2) == 2) {
  32       die "Couldn't read length for APPn\n";
  33     }
  34     my $len = unpack("S>", $clen);
  35     my $appdata;
  36     unless (read($fh, $appdata, $len-2) == $len-2) {
  37       print "length ", length $appdata, " expected $len\n";
  38       die "Couldn't read application data for APPn\n";
  39     }
  40     if ($chead eq "\xFF\xE0") {
  41       # APP0
  42       my $type = substr($appdata, 0, 5, '');
  43         print "APP0 ", $type =~ tr/\0//dr, "\n";
  44       if ($type eq "JFIF\0") {
  45         my ($version, $units, $xdens, $ydens, $tx, $ty, $rest) =
  46           unpack("S>CS>S>CCa*", $appdata);
  47         printf "  Version: %x\n", $version;
  48         print "  Units: $units\n";
  49         print "  Density: $xdens x $ydens\n";
  50         print "  Thumbnail: $tx x $ty\n";
  51       }
  52       else {
  53         # more to do
  54       }
  55     }
  56     elsif ($chead eq "\xFF\xE1") {
  57       # APP1
  58       if ($appdata =~ s/^Exif\0.//) {
  59         print "  EXIF data\n";
  60         if ($exiffile) {
  61           open my $eh, ">", $exiffile
  62             or die "Cannot create $exiffile: $!\n";
  63           binmode $eh;
  64           print $eh $appdata;
  65           close $eh
  66             or die "Cannot close $exiffile: $!\n";
  67         }
  68       }
  69     }
  70   }
  71   else {
  72     die "I don't know how to handle ", unpack("H*", $chead), "\n";
  73   }
  74 }
  75
  76 =head HEAD
  77
  78 jpegdump.pl - dump the structure of a JPEG image file.
  79
  80 =head1 SYNOPSIS
  81
  82   perl jpegdump.pl [-dumpall] [-exif=exifdata] filename
  83
  84 =head1 DESCRIPTION
  85
  86 Dumps the structure of a JPEG image file.
  87
  88 Options:
  89
  90 =over
  91
  92 =item *
  93
  94 C<-dumpall> - dump the entire contents of each chunk rather than just
  95 the leading bytes.  Currently unimplemented.
  96
  97 =item *
  98
  99 C<< -exif I<filename> >> - extract the EXIF blob to a file.
 100
 101 =back
 102
 103 This is incomplete, I mostly wrote it to extract the EXIF blob, but I
 104 expect I'll finish it at some point.
 105
 106 =cut