#!/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 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.