#!/usr/bin/perl

=begin metadata

Name: od
Description: dump files in octal and other formats
Author: Mark Kahn, mkahn@vbe.com
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_b $opt_c $opt_d $opt_f $opt_i $opt_j $opt_l $opt_N
$opt_o $opt_v $opt_x /;

my ($offset1, $radix, $data, @arr, $len, $fh, $lim);
my ($lastline, $upformat, $pffmt, $strfmt, $ml);

my %charescs = (
    0  => ' \0',
    7  => ' \a',
    8  => ' \b',
    9  => ' \t',
    10 => ' \n',
    11 => ' \v',
    12 => ' \f',
    13 => ' \r',
    92 => ' \\\\',
);

$offset1 = 0;
$lastline = '';

my $Program = basename($0);

getopts('A:bcdfij:lN:ovx') 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;
    }
    $offset1 = $opt_j;
}
if (defined $opt_N) {
    if ($opt_N =~ m/\D/) {
	warn "$Program: bad argument to -N: '$opt_N'\n";
	exit EX_FAILURE;
    }
    $lim = $opt_N;
}

if (defined $ARGV[0] && $ARGV[0] ne '-') {
    unless (open $fh, '<', $ARGV[0]) {
	warn "$Program: cannot open '$ARGV[0]': $!\n";
	exit EX_FAILURE;
    }
}
else {
    $fh = *STDIN;
}

binmode $fh;
if ($offset1) {
    foreach (1 .. $offset1) {
	$len = read $fh, $data, 1;
	if ($len == 0) {
	    warn "$Program: cannot skip past end of input\n";
	    exit EX_FAILURE;
	}
	unless (defined $len) {
	    warn "$Program: read error: $!\n";
	    exit EX_FAILURE;
	}
	undef $data;
    }
}
if (defined($lim) && $lim == 0) {
    printf("%.8$radix\n", $offset1) if $radix;
    close $fh;
    exit EX_SUCCESS;
}

$opt_o = 1 if ! ($opt_b || $opt_c || $opt_d || $opt_f || $opt_i ||
		 $opt_l || $opt_o || $opt_x);

my $fmt;
if ($opt_b) {
    $fmt = \&octal1;
}
elsif ($opt_c) {
    $fmt = \&char1;
}
elsif ($opt_d) {
    $fmt = \&udecimal;
}
elsif ($opt_f) {
    $fmt = \&float;
}
elsif ($opt_i) {
    $fmt = \&decimal;
}
elsif ($opt_l) {
    $fmt = \&long;
}
elsif ($opt_o) {
    $fmt = \&octal2;
}
elsif ($opt_x) {
    $fmt = \&hex;
}
else {
    help();
}

my $buf;
my $nread = 0;
while ($len = read($fh, $buf, 1)) {
    $data .= $buf;
    $nread++;

    my $is_limit = defined($lim) && $nread == $lim;
    if (length($data) == LINESZ || $is_limit || eof($fh)) {
	$ml = ''; # multi-line indention
	if (&diffdata || $opt_v) {
	    printf("%.8$radix ", $offset1) if $radix;
	    &$fmt;
	    printf("%s$strfmt\n", $ml, @arr);
	    $ml = ' ' x 9;
	}
	else {
	    print "*\n";
	}
	$lastline = $data . '|';
	$offset1 += length $data;
	undef $data;
    }
    last if $is_limit;
}
unless (defined $len) {
    warn "$Program: read error: $!\n";
    exit EX_FAILURE;
}

printf("%.8$radix\n", $offset1) if $radix;
close $fh;
exit EX_SUCCESS;

sub octal1 {
    $upformat = 'C*'; # for -b
    $pffmt = '%.3o ';
    @arr = unpack($upformat,$data);
    $strfmt = $pffmt x (scalar @arr);
}

sub char1 {
    $upformat = 'C*'; # for -c
    $pffmt = '%s';
    $strfmt = $pffmt;

    @arr = ();
    my @arr1 = unpack($upformat,$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) . " ";
	}
    }
}

sub udecimal {
    $upformat = 'S*'; # for -d
    $data .= "\0" if ($len & 1); # zero-fill 16 bit input
    $pffmt = '%5u ';
    @arr = unpack($upformat,$data);
    $strfmt = $pffmt x (scalar @arr);
}

sub float {
    $upformat = 'f*'; # for -f
    my $remain = $len % 4;
    $data .= "\0" x $remain if ($remain); # zero-fill 32 bit input
    $pffmt = '%6.6e ';
    @arr = unpack($upformat,$data);
    $strfmt = $pffmt x (scalar @arr);
}

sub decimal {
    $upformat = 's*'; # for -i
    $data .= "\0" if ($len & 1); # zero-fill 16 bit input
    $pffmt = '%5d ';
    @arr = unpack($upformat,$data);
    $strfmt = $pffmt x (scalar @arr);
}

sub long {
    $upformat = 'L*'; # for -l
    my $remain = $len % 4;
    $data .= "\0" x $remain if ($remain); # zero-fill 32 bit input
    $pffmt = '%10ld ';
    @arr = unpack($upformat,$data);
    $strfmt = $pffmt x (scalar @arr);
}

sub octal2 {
    $upformat = 'S*'; # for -o
    $data .= "\0" if ($len & 1); # zero-fill 16 bit input
    $pffmt = '%.6o ';
    @arr = unpack($upformat,$data);
    $strfmt = $pffmt x (scalar @arr);
}

sub hex {
    $upformat = 'S*'; # for -x
    $data .= "\0" if ($len & 1); # zero-fill 16 bit input
    $pffmt = '%.4x ';
    @arr = unpack($upformat,$data);
    $strfmt = $pffmt x (scalar @arr);
}

sub diffdata {
    my $currdata = $data . '|';
    return ($currdata eq $lastline) ? 0 : 1;
}

sub help {
    print "usage: od [-bcdfiloxv] [-A radix] [-j skip_bytes] [-N limit_bytes] filename\n";
    exit EX_FAILURE;
}
__END__

=head1 NAME

od - dump files in octal and other formats

=head1 SYNOPSIS

B<od> [ I<-abcdfiloxv> ] [I<-j skip_n_bytes>] [I<-N read_n_bytes>] [ 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.
