#!/usr/bin/perl -w
#
# $Id: od.kahn,v 1.3 2004/08/05 14:21:14 cwest Exp $
#
# $Log: od.kahn,v $
# Revision 1.3 2004/08/05 14:21:14 cwest
# cleanup, new version number on website
#
# Revision 1.1 2004/07/23 20:10:13 cwest
# initial import
#
# Revision 1.1 1999/03/06 06:12:24 kahn
# Initial revision
#
#
use strict;
use Getopt::Std;
use vars qw/ $opt_A $opt_b $opt_c $opt_d $opt_f $opt_h $opt_i $opt_l $opt_o
$opt_v $opt_x $opt_s /;
my ($offset1, $radix, $data, @arr, $len);
my ($lastline, $upformat, $pffmt, $strfmt, $skip, $ml);
my $retval;
local *FH;
my %charescs = (
0 => ' \0',
1 => '001',
2 => '002',
3 => '003',
4 => '004',
5 => '005',
6 => '006',
7 => ' \a',
8 => ' \b',
9 => ' \t',
10 => ' \n',
11 => ' \v',
12 => ' \f',
13 => ' \r',
14 => '014',
15 => '015',
16 => '016',
17 => '017',
18 => '018',
19 => '019',
20 => '020',
21 => '021',
22 => '022',
23 => '023',
24 => '024',
25 => '025',
26 => '026',
27 => '027',
28 => '028',
29 => '029',
30 => '030',
31 => '031',
);
$offset1 = 0;
$lastline = '';
getopts('A:bcdfhilovxs:');
defined $opt_h && &help;
defined $opt_A ? ($radix = $opt_A) : ($radix = 'o');
defined $opt_s && ($offset1 = $opt_s);
open(FH,"$ARGV[0]") || die "Can't open $ARGV[0] for read: $!";
binmode(FH);
seek(FH,$offset1,0);
$opt_o = 1 if ! ($opt_b || $opt_c || $opt_d || $opt_f || $opt_i ||
$opt_l || $opt_o || $opt_x);
while ($len = read(FH,$data,16)) {
$ml = ''; # multi-line indention
if ( &diffdata || $opt_v) {
printf("%.8$radix ", $offset1);
defined $opt_b && do { &octal1; printf("%s$strfmt\n", $ml, @arr);
$ml = ' ' };
defined $opt_c && do { &char1; printf("%s$strfmt\n", $ml, @arr);
$ml = ' ' };
defined $opt_d && do { &udecimal; printf("%s$strfmt\n", $ml, @arr);
$ml = ' ' };
defined $opt_f && do { &float; printf("%s$strfmt\n", $ml, @arr);
$ml = ' ' };
defined $opt_i && do { &decimal; printf("%s$strfmt\n", $ml, @arr);
$ml = ' ' };
defined $opt_l && do { &long; printf("%s$strfmt\n", $ml, @arr);
$ml = ' ' };
defined $opt_o && do { &octal2; printf("%s$strfmt\n", $ml, @arr);
$ml = ' ' };
defined $opt_x && do { &hex; printf("%s$strfmt\n", $ml, @arr);
$ml = ' ' };
}
else {
print "*\n";
}
$offset1 += $len;
$lastline = $data . '|';
}
printf("%.8$radix\n", $offset1);
close FH;
exit 0;
sub octal1 {
$upformat = 'c*'; # for -b
$pffmt = '%.3o ';
@arr = unpack($upformat,$data);
$strfmt = $pffmt x $len;
}
sub char1 {
$upformat = 'c*'; # for -c
$pffmt = '%s';
$strfmt = $pffmt;
@arr = ();
my $val = undef;
my $val1 = undef;
my @arr1 = unpack($upformat,$data);
foreach $val (@arr1) {
if (exists $charescs{$val}) {
$arr[0] .= $charescs{$val} . " ";
}
else {
$val1 = " " . chr($val) . " " ;
$arr[0] .= $val1;
}
}
}
sub udecimal {
$upformat = 'S*'; # for -d
$pffmt = '%5u ';
@arr = unpack($upformat,$data);
$strfmt = $pffmt x ($len / 2);
my $remainder = $len - ((scalar @arr) * 2);
($remainder) && do {
my $offset = $len - $remainder;
my $rest = "0" x 32 . substr($data, $offset, $remainder);
push @arr, unpack("N", pack("B32", substr($rest, -32)));
$strfmt .= '%5u';
};
}
sub float {
$upformat = 'f*'; # for -f
$pffmt = '%6.6e ';
@arr = unpack($upformat,$data);
$strfmt = $pffmt x (scalar @arr);
my $remainder = $len - ((scalar @arr) * 4);
($remainder) && do {
my $offset = $len - $remainder;
my $rest = "0" x 32 . substr($data, $offset, $remainder);
push @arr, unpack("f", pack("B32", substr($rest, -32)));
$strfmt .= '%6.6e';
};
}
sub decimal {
$upformat = 's*'; # for -i
$pffmt = '%5d ';
@arr = unpack($upformat,$data);
$strfmt = $pffmt x (scalar @arr);
my $remainder = $len - ((scalar @arr) * 2);
($remainder) && do {
my $offset = $len - $remainder;
my $rest = "0" x 32 . substr($data, $offset, $remainder);
push @arr, unpack("N", pack("B32", substr($rest, -32)));
$strfmt .= '%5d';
};
}
sub long {
$upformat = 'L*'; # for -l
$pffmt = '%10ld ';
@arr = unpack($upformat,$data);
$strfmt = $pffmt x (scalar @arr);
my $remainder = $len - ((scalar @arr) * 4);
$remainder && do {
my $offset = $len - $remainder;
my $rest = "0" x 32 . substr($data, $offset, $remainder);
push @arr, unpack("N", pack("B32", substr($rest, -32)));
$strfmt .= '%10ld';
};
}
sub octal2 {
$upformat = 's*'; # for -o
$pffmt = '%.6o ';
@arr = unpack($upformat,$data);
$strfmt = $pffmt x (scalar @arr);
my $remainder = $len - ((scalar @arr) * 2);
($remainder) && do {
my $offset = $len - $remainder;
my $rest = "0" x 32 . substr($data, $offset, $remainder);
push @arr, unpack("N", pack("B32", substr($rest, -32)));
$strfmt .= '%.6o';
};
}
sub hex {
$upformat = 's*'; # for -x
$pffmt = '%.4x ';
@arr = unpack($upformat,$data);
$strfmt = $pffmt x (scalar @arr);
my $remainder = $len - ((scalar @arr) * 2);
($remainder) && do {
my $offset = $len - $remainder;
my $rest = "0" x 32 . substr($data, $offset, $remainder);
push @arr, unpack("N", pack("B32", substr($rest, -32)));
$strfmt .= '%.4x';
};
}
sub diffdata {
my $currdata = $data . '|';
return ($currdata eq $lastline) ? 0 : 1;
}
sub help {
print "od [-abcdfhiloxv] [-A radix] filename\n";
exit 0;
}
__END__
=head1 NAME
od - dump files in octal and other formats
=head1 SYNOPSIS
B<od.pl> [ I<-abcdfhiloxv> ] [ I<-A radix> ] F<filename>
=head1 DESCRIPTION
The B<od.pl> writes to the standard output the contents of the given
files, or of the standard input if the name `-' is given. Each line
of the output consists of the offset in the input file in the leftmost
column of each line, followed by one or more columns of data from the
file, in a format controlled by the options. By default, od prints the
file offsets in octal and the file data as two-byte octal numbers.
=head1 SEE ALSO
od(1)
=head1 AUTHOR
Mark Kahn, I<mkahn@vbe.com>.
=head1 COPYRIGHT and LICENSE
This program is copyright (c) Mark Kahn 1999.
This program is free and open software. You may use, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.