#!/usr/bin/perl
use vars qw/ $opt_A $opt_a $opt_B $opt_b $opt_c $opt_D $opt_d $opt_e $opt_F $opt_f $opt_H $opt_h $opt_i $opt_j $opt_l $opt_N $opt_O $opt_o $opt_s
$opt_t $opt_v $opt_X $opt_x /;
our $VERSION = '1.4';
my ($offset1, $radix, $data, @arr, $lim);
my ($lastline, $strfmt, $ml);
my %charescs = (
0 => ' \0',
7 => ' \a',
8 => ' \b',
9 => ' \t',
10 => ' \n',
11 => ' \v',
12 => ' \f',
13 => ' \r',
92 => ' \\\\',
);
my %charname = (
0 => 'nul',
1 => 'soh',
2 => 'stx',
3 => 'etx',
4 => 'eot',
5 => 'enq',
6 => 'ack',
7 => 'bel',
8 => ' bs',
9 => ' ht',
10 => ' nl',
11 => ' vt',
12 => ' ff',
13 => ' cr',
14 => ' so',
15 => ' si',
16 => 'dle',
17 => 'dc1',
18 => 'dc2',
19 => 'dc3',
20 => 'dc4',
21 => 'nak',
22 => 'syn',
23 => 'etb',
24 => 'can',
25 => ' em',
26 => 'sub',
27 => 'esc',
28 => ' fs',
29 => ' gs',
30 => ' rs',
31 => ' us',
32 => ' sp',
127 => 'del',
);
$offset1 = 0;
$lastline = '';
my $Program = basename($0);
getopts('A:aBbcDdeFfHhij:lN:Oost:vXx') or help();
if (defined $opt_A) {
if ($opt_A !~ m/\A[doxn]\z/) {
warn "$Program: unexpected radix: '$opt_A'\n";
exit EX_FAILURE;
}
if ($opt_A ne 'n') {
$radix = $opt_A;
}
}
else {
$radix = 'o';
}
if (defined $opt_j) {
if ($opt_j =~ m/\D/) {
warn "$Program: bad argument to -j: '$opt_j'\n";
exit EX_FAILURE;
}
}
if (defined $opt_N) {
if ($opt_N =~ m/\D/) {
warn "$Program: bad argument to -N: '$opt_N'\n";
exit EX_FAILURE;
}
$lim = $opt_N;
}
my $fmt;
if ($opt_a) {
$fmt = \&char7bit;
}
elsif ($opt_b) {
$fmt = \&octal1;
}
elsif ($opt_c) {
$fmt = \&char1;
}
elsif ($opt_D) {
$fmt = \&udecimal4;
}
elsif ($opt_d) {
$fmt = \&udecimal2;
}
elsif ($opt_e || $opt_F) {
$fmt = \&float8;
}
elsif ($opt_f) {
$fmt = \&float4;
}
elsif ($opt_H || $opt_X) {
$fmt = \&hex4;
}
elsif ($opt_h || $opt_x) {
$fmt = \&hex2;
}
elsif ($opt_i || $opt_s) {
$fmt = \&decimal2;
}
elsif ($opt_l) {
$fmt = \&long;
}
elsif ($opt_O) {
$fmt = \&octal4;
}
elsif ($opt_B || $opt_o) {
$fmt = \&octal2;
}
else {
$fmt = \&octal2;
}
if (defined $opt_t) {
if ($opt_t eq 'x1') {
$fmt = \&hex1;
} elsif ($opt_t eq 'x2') {
$fmt = \&hex2;
} elsif ($opt_t eq 'x4') {
$fmt = \&hex4;
} elsif ($opt_t eq 'x8') {
$fmt = \&hex8;
} elsif ($opt_t eq 'o1') {
$fmt = \&octal1;
} elsif ($opt_t eq 'o2') {
$fmt = \&octal2;
} elsif ($opt_t eq 'o4') {
$fmt = \&octal4;
} elsif ($opt_t eq 'o8') {
$fmt = \&octal8;
} elsif ($opt_t eq 'd1') {
$fmt = \&decimal1;
} elsif ($opt_t eq 'd2') {
$fmt = \&decimal2;
} elsif ($opt_t eq 'd4') {
$fmt = \&decimal4;
} elsif ($opt_t eq 'd8') {
$fmt = \&decimal8;
} elsif ($opt_t eq 'u1') {
$fmt = \&udecimal1;
} elsif ($opt_t eq 'u2') {
$fmt = \&udecimal2;
} elsif ($opt_t eq 'u4') {
$fmt = \&udecimal4;
} elsif ($opt_t eq 'u8') {
$fmt = \&udecimal8;
} elsif ($opt_t eq 'f4') {
$fmt = \&float4;
} elsif ($opt_t eq 'f8') {
$fmt = \&float8;
} elsif ($opt_t eq 'a') {
$fmt = \&char7bit;
} elsif ($opt_t eq 'c') {
$fmt = \&char1;
} else {
warn "$Program: unexpected output format specifier\n";
exit EX_FAILURE;
}
if ($opt_t =~ m/\A[doux]8\Z/) {
my $has_quad = eval {
unpack 'Q', '';
1;
};
unless ($has_quad) {
warn "$Program: 64-bit perl needed for $opt_t format\n";
exit EX_FAILURE;
}
}
}
my $nread = 0;
my $rc = EX_SUCCESS;
foreach my $file (@ARGV) {
if (-d $file) {
warn "$Program: '$file' is a directory\n";
$rc = EX_FAILURE;
next;
}
my $fh;
unless (open $fh, '<', $file) {
warn "$Program: cannot open '$file': $!\n";
$rc = EX_FAILURE;
next;
}
binmode $fh;
do_skip($fh) if $opt_j;
dump_file($fh);
close $fh;
}
unless (@ARGV) {
do_skip(*STDIN) if $opt_j;
dump_file(*STDIN);
}
dump_line() if (defined $data);
emit_offset(1);
exit $rc;
sub VERSION_MESSAGE {
print "$Program version $VERSION\n";
exit EX_SUCCESS;
}
sub limit_reached {
return defined($lim) && $nread >= $lim;
}
sub emit_offset {
my $nl = shift;
return unless $radix;
printf "%.8$radix%s", $offset1, $nl ? "\n" : ' ';
}
sub dump_line {
unless ($opt_v) {
if (diffdata()) {
$lastline = $data . '|';
$ml = 0;
} else {
print "*\n" unless $ml;
$ml = 1;
}
}
unless ($ml) {
emit_offset();
&$fmt;
printf "$strfmt\n", @arr;
}
$offset1 += length $data;
undef $data;
}
sub dump_file {
my $fh = shift;
my $buf;
while (!limit_reached() && !eof($fh)) {
my $len = read $fh, $buf, 1;
unless (defined $len) {
warn "$Program: read error: $!\n";
$rc = EX_FAILURE;
return;
}
$data .= $buf;
$nread++;
dump_line() if (length($data) == LINESZ);
}
}
sub do_skip {
my $fh = shift;
my $buf;
while ($opt_j > 0) {
my $len = read $fh, $buf, 1;
if ($len == 0) {
warn "$Program: skip past end of input\n";
exit EX_FAILURE;
}
unless (defined $len) {
warn "$Program: read error: $!\n";
exit EX_FAILURE;
}
$opt_j--;
$offset1++;
}
}
sub octal1 {
@arr = unpack 'C*', $data;
$strfmt = '%.3o ' x (scalar @arr);
}
sub decimal1 {
@arr = unpack 'c*', $data;
$strfmt = '%4d ' x (scalar @arr);
}
sub udecimal1 {
@arr = unpack 'C*', $data;
$strfmt = '%3u ' x (scalar @arr);
}
sub hex1 {
@arr = unpack 'C*', $data;
$strfmt = '%.2x ' x (scalar @arr);
}
sub char1 {
@arr = ();
my @arr1 = unpack 'C*', $data;
for my $val (@arr1) {
if (exists $charescs{$val}) {
$arr[0] .= $charescs{$val} . " ";
}
elsif ($val > PRINTMAX || chr($val) !~ m/[[:print:]]/) {
$arr[0] .= sprintf('%03o ', $val);
}
else {
$arr[0] .= " " . chr($val) . " ";
}
}
$strfmt = '%s';
}
sub char7bit {
@arr = ();
my @arr1 = unpack 'C*', $data;
for my $val (@arr1) {
my $n = $val & 0x7f;
if (exists $charname{$n}) {
$arr[0] .= $charname{$n} . " ";
}
else {
$arr[0] .= " " . chr($n) . " ";
}
}
$strfmt = '%s';
}
sub udecimal2 {
@arr = unpack 'S*', $data . zeropad(length($data), 2);
$strfmt = '%5u ' x (scalar @arr);
}
sub float4 {
@arr = unpack 'f*', $data . zeropad(length($data), 4);
$strfmt = '%15.7e ' x (scalar @arr);
}
sub float8 {
@arr = unpack 'd*', $data . zeropad(length($data), 8);
$strfmt = '%24.16e ' x (scalar @arr);
}
sub decimal2 {
@arr = unpack 's*', $data . zeropad(length($data), 2);
$strfmt = '%6d ' x (scalar @arr);
}
sub long {
@arr = unpack 'L*', $data . zeropad(length($data), 4);
$strfmt = '%10ld ' x (scalar @arr);
}
sub octal2 {
@arr = unpack 'S*', $data . zeropad(length($data), 2);
$strfmt = '%.6o ' x (scalar @arr);
}
sub octal4 {
@arr = unpack 'L*', $data . zeropad(length($data), 4);
$strfmt = '%.11o ' x (scalar @arr);
}
sub decimal4 {
@arr = unpack 'L*', $data . zeropad(length($data), 4);
$strfmt = '%11d ' x (scalar @arr);
}
sub udecimal4 {
@arr = unpack 'L*', $data . zeropad(length($data), 4);
$strfmt = '%11u ' x (scalar @arr);
}
sub hex2 {
@arr = unpack 'S*', $data . zeropad(length($data), 2);
$strfmt = '%.4x ' x (scalar @arr);
}
sub hex4 {
@arr = unpack 'L*', $data . zeropad(length($data), 4);
$strfmt = '%.8x ' x (scalar @arr);
}
sub hex8 {
@arr = unpack 'Q*', $data . zeropad(length($data), 8);
$strfmt = '%.16x ' x (scalar @arr);
}
sub octal8 {
@arr = unpack 'Q*', $data . zeropad(length($data), 8);
$strfmt = '%.22o ' x (scalar @arr);
}
sub udecimal8 {
@arr = unpack 'Q*', $data . zeropad(length($data), 8);
$strfmt = '%22u ' x (scalar @arr);
}
sub decimal8 {
@arr = unpack 'Q*', $data . zeropad(length($data), 8);
$strfmt = '%22d ' x (scalar @arr);
}
sub zeropad {
my ($len, $wantbytes) = @_;
my $remain = $len % $wantbytes;
return '' unless $remain;
return "\0" x ($wantbytes - $remain);
}
sub diffdata {
my $currdata = $data . '|';
return ($currdata eq $lastline) ? 0 : 1;
}
sub help {
print "usage: od [-aBbcDdeFfHhilOosXxv] [-A radix] [-j skip_bytes] ",
"[-N limit_bytes] [-t type] [file]...\n";
exit EX_FAILURE;
}