Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

dump binaries

by sflitman (Hermit)
on Oct 18, 2008 at 17:29 UTC ( [id://717972]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info sflitman - Stephen Flitman - sflitman >!< xenoscience.com
Description: rolled my own version of od using my favorite tool, Perl! dump is aware of the terminal width using Term::Size if available
#!/usr/bin/perl
# DUMP - bytes and chars for my own version of od
# SSF 041506 initial work 
# SSF 092306 suppress ctrl characters in text, final 00
# SSF 052407 take STDIN if file is -
# SSF 052607 use -u to get rid of weirdness with embedded wide chars
####################################################################

use strict;
use bytes;
use Encode;
use Getopt::Std;
my (%opts,$file,$cols,$rows);
eval "use Term::Size 'chars'";   # if available
($cols,$rows)=chars() unless $@;
getopts('dhosuw:x',\%opts);
map { $file+=$opts{$_} } qw/d o x/;  # prevent specifying exclusive fl
+ags
if (!@ARGV or $opts{h} or $file>1) {
   print "Mutually exclusive flags: -d, -o, -x\n" if $file>1;
   print "Usage: dump [-w chars] [-dhox] file|glob...\n",
         "       Dump bytes and chars for file(s), or STDIN if - given
+ as file\n",
         "-d     Display decimal instead of hex\n",
         "-h     This help display\n",
         "-o     Display octal instead of hex\n",
         "-u     Tolerate wide characters (UTF8, Unicode)\n",
         "-s     Suppress header text\n",
         "-x     Display hex (default)\n";
   exit 1;
}
$opts{w}||=$cols;
$cols=$opts{w}||80;
my $ofmt='%06X ';  # offset format
my $fmt='%02X ';   # byte format
my $spc='   ';     # space (file ends before block boundary)
my $n=3;           # chars to show one byte
my $div=8;         # divider every n bytes
if ($opts{o}) {
   $ofmt='%06o ';
   $fmt='%03o ';
   $spc='    ';
   $n=4;
} 
elsif ($opts{d}) {
   $ofmt='%6d ';
   $fmt='%3d ';
   $spc='    ';
   $n=4;
   $div=10;
}
my $cpr;            # number of chars per row - formulas are offset+di
+viders+bytes+chars
if ($opts{d}) {     # decimal display
   if ($cols>=8+4+$n*30+30) {
      $cpr=30;
   }
   elsif ($cols>=8+2+$n*20+20) {
      $cpr=20;
   }
   else {   # 8+0+$n*10+10
      $cpr=10;
   }
} else {            # hex or octal display
   if ($cols>=8+6+$n*32+32) {
      $cpr=32;
   }
   elsif ($cols>=8+4+$n*24+24) {
      $cpr=24;
   }
   elsif ($cols>=8+2+$n*16+16) {
      $cpr=16;
   }
   else {   # 8+0+$n*8+8
      $cpr=8;
   }
}
my $blk=$cpr*32; # block size
my ($i,$j,$c,$buf,@row); my $offset=0;
my @files;
for $file (@ARGV) {
   if ($file=~/[?*\[\]]/) {
      push @files,glob $file;
   } else {
      push @files,$file;
   }
}
for $file (@files) {
   printf "File %s:\n",($file eq '-' ? 'STDIN' : $file) unless $opts{s
+};
   open(FILE,$file) || die "$file: $!";
   while ($c=sysread(FILE,$buf,$blk)) {
      $buf=Encode::encode('ascii',$buf) if $opts{u};
      for ($i=0; $i<$c; $i+=$cpr) {
          printf $ofmt,$offset+$i;
          @row=0;
          for ($j=0; $j<$cpr; $j++) {
             print '| ' if ($j and !($j%$div));
             if ($i+$j>=length($buf)) {
                print $spc;
             } else {
                $row[$j]=ord(substr($buf,$i+$j,1));
                printf $fmt,$row[$j];
             }
          }        
          for ($j=0; $j<$cpr; $j++) { 
             if ($i+$j>=length($buf)) {
                print ' ';
             } else {
                if ($row[$j]<32 || $row[$j]>126) {
                   print '.';
                } else {
                   print chr($row[$j]);
                }
             }
          }
          print "\n";          
      }
      $offset+=$blk; 
   }
   close FILE;
}
exit;
Replies are listed 'Best First'.
Re: dump binaries
by Anonymous Monk on Oct 20, 2008 at 12:39 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://717972]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (9)
As of 2024-04-25 11:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found