correct an old bug link
[imager.git] / 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