fileformatdocs/bmpdump.pl

   1 #!perl
   2 use strict;
   3 use Getopt::Long;
   4
   5 my $dumpall = 0;
   6 my $image = 0;
   7 GetOptions(dumpall => \$dumpall,
   8            image => \$image);
   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 my $filehead;
  19 read($fh, $filehead, 14) == 14
  20   or die "Could not read file header: $!\n";
  21 my ($h_type, $h_size, $res1, $res2, $h_offset)
  22   = unpack("A2VvvV", $filehead);
  23
  24 $h_type eq "BM"
  25   or die "Not a BMP file - no BM signature\n";
  26
  27 print <<EOS;
  28 File header:
  29   Type: $h_type
  30   Size: $h_size
  31   Res1: $res1
  32   Res2: $res2
  33   Offset: $h_offset
  34 EOS
  35
  36 my $bmi;
  37 read($fh, $bmi, 40) == 40
  38   or die "Could not read BITMAPINFO\n";
  39
  40 my ($i_size, $i_width, $i_height, $i_planes, $i_bits, $i_compress, $i_size_img, $i_xppm, $i_yppm, $clr_used, $clr_imp) =
  41   unpack("VVVvvVVVVVV", $bmi);
  42 printf <<EOS,
  43 Bitmapinfo:
  44   biSize: %d
  45   biWidth: %d
  46   biHeight: %d
  47   biPlanes: %d
  48   biBitCount: %d
  49   biCompression: %d
  50   biSizeImage: %d
  51   biXPelsPerMeter: %d
  52   biYPelsPerMeter: %d
  53   biClrUsed: %d
  54   biClrImportant: %d
  55 EOS
  56   $i_size, $i_width, $i_height, $i_planes, $i_bits, $i_compress, $i_size_img, $i_xppm, $i_yppm, $clr_used, $clr_imp;
  57
  58 $i_size < 40
  59   and die "biSize too small\n";
  60
  61 if ($i_size > 40) {
  62   my $extra_head;
  63   read($fh, $extra_head, $i_size - 40) == $i_size - 40
  64     or die "Failed to read rest of header\n";
  65 }