#!/usr/bin/perl

=begin metadata

Name: od
Description: dump files in octal and other formats
Author: Mark Kahn, mkahn@vbe.com
Author: Michael Mikonos
License: perl

=end metadata

=cut


use strict;

use File::Basename qw(basename);
use Getopt::Std qw(getopts);

use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;
use constant LINESZ => 16;
use constant PRINTMAX => 126;

use vars qw/ $opt_A $opt_a $opt_B $opt_b $opt_c $opt_d $opt_e $opt_F $opt_f
$opt_H $opt_i $opt_j $opt_l $opt_N $opt_O $opt_o $opt_s $opt_v $opt_X $opt_x /;

our $VERSION = '1.1';

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:aBbcdeFfHij:lN:OosvXx') 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 = \&udecimal;
}
elsif ($opt_e || $opt_F) {
    $fmt = \&float8;
}
elsif ($opt_f) {
    $fmt = \&float;
}
elsif ($opt_H || $opt_X) {
    $fmt = \&hex4;
}
elsif ($opt_i || $opt_s) {
    $fmt = \&decimal;
}
elsif ($opt_l) {
    $fmt = \&long;
}
elsif ($opt_O) {
    $fmt = \&octal4;
}
elsif ($opt_B || $opt_o) {
    $fmt = \&octal2;
}
elsif ($opt_x) {
    $fmt = \&hex2;
}
else {
    $fmt = \&octal2;
}

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 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] .= sprintf '%4s', $charname{$n};
        }
        else {
	    $arr[0] .= "  " . chr($n) . " ";
        }
    }
    $strfmt = '%s';
}

sub udecimal {
    @arr = unpack 'S*', $data . zeropad(length($data), 2);
    $strfmt = '%5u ' x (scalar @arr);
}

sub float {
    @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 decimal {
    @arr = unpack 's*', $data . zeropad(length($data), 2);
    $strfmt = '%5d ' 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 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 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 [-aBbcdeFfHilOosXxv] [-A radix] [-j skip_bytes] [-N limit_bytes] [file]...\n";
    exit EX_FAILURE;
}
__END__

=head1 NAME

od - dump files in octal and other formats

=head1 SYNOPSIS

B<od> [ I<-aBbcdeFfHilOosXxv> ] [I<-j skip_n_bytes>] [I<-N read_n_bytes>] [ I<-A radix> ] [ F<file>... ]

=head1 DESCRIPTION

B<od> writes  to  the  standard output the contents of the given
files, or of the standard input if no files are specified.  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.

=head2 OPTIONS

The following options are available:

=over 4

=item -A Radix

Select offset prefix format: 'd' for decimal, 'o' for octal, 'x' for hexadecimal, 'n' for none.

=item -a

Dump characters in 7-bit ASCII format, ignoring the highest bit of each byte.
The names of ASCII control characters are displayed.

=item -B

Same as -o

=item -b

Single-byte octal display.

=item -c

Display characters literally, with non-printable characters displayed as C escape sequences.

=item -d

Two-byte unsigned decimal display.

=item -e

Eight-byte floating point display.

=item -F

Same as -e

=item -f

Show input as floating point numbers in exponent form.

=item -H

Four-byte hex display.

=item -i

Show two-byte signed decimal integers.

=item -j Skip

Ignore the first Skip bytes of input.

=item -l

Show four-byte signed decimal integers.

=item -N Bytes

Set the number of maximum input bytes read.

=item -O

Four-byte octal display.

=item -o

Format input as two-byte octal numbers.

=item -s

Same as -i

=item -X

Same as -H

=item -x

Use two-byte hexadecimal format.

=item -v

Show all lines, even if they are identical to the previous line.

=back

=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.
