Quick and Dirty JPEG DQT Extractor

extract-dqt.pl

use 5.012;
my @zigzag = qw{                                                                
   0  1  5  6 14 15 27 28                                                       
   2  4  7 13 16 26 29 42                                                       
   3  8 12 17 25 30 41 43                                                       
   9 11 18 24 31 40 44 53                                                       
  10 19 23 32 39 45 52 54                                                       
  20 22 33 38 46 51 55 60                                                       
  21 34 37 47 50 56 59 61                                                       
  35 36 48 49 57 58 62 63                                                       
};
my $fn  = shift;
my $jpg = do {
    local $/;
    open my $fh, '<', $fn or die "$fn:$!";
    my $bytes = <$fh>;
    close $fh;
    $bytes;
};
die "Not in JFIF format" unless $jpg =~ /\A\xFF\xD8/;    # SOI                  
$jpg =~ s/\xFF\xC0.*\z//sm;                              # throw away img       
$jpg =~ s{\xFF\xDB(..)(.)}{ # find DQT                                          
  my $len = unpack 'n', $1; # get its length                                    
  my $id  = ord $2 & 0x0f;  # and its ID                                        
  my (@dqt) = unpack 'C*', substr($jpg, $+[1] + 1, $len); # and DQT             
  say "ID$id";
  for my $rows (0..7){ # unzigzag and print                                     
      say join "\t", map {$dqt[$zigzag[$_]]} ($rows*8..$rows*8+7);
  }
}egsm;