#!@PERL@
#
#  $Id$
#
eval "exec @PERL@ -S $0 $*"
    if $running_under_some_shell;

# dump shared memory segment   tony@divnc.com

require 'sys/shm.ph';
require 'getopts.pl';
&Getopts("vhi:k:f:l:b:w");	# verbose, help, id, key, first, length, word, base

if ($opt_h || ($opt_i && $opt_k))
{
    print STDERR <<NO_MORE_HELP;
shmdump

    Dump contents of specifed shared memory segment.

Usage: $0  [options]

    -h          -- help
    -v          -- possibly more verbose
    -i shmid    -- shm id
    -k shmkey   -- shm key
    -f first    -- start of partial dump
    -l length   -- length of partial dump
    -w          -- dump as 4byte words instead of bytes
    -b base     -- use 'base' as base address for output

    anything else == this help message
NO_MORE_HELP
    exit 1;
}

$verbose = $opt_v;
$id = $opt_i;
$key = $opt_k;
$offset = $opt_f;
$print_length = $opt_l;
$base = $opt_b;
$word_dump = $opt_w;

if ($key)
{
    # ensure key is an integer
    $key = oct($key) if $key =~ /^0/;
    die "Could not convert key to id; $!" unless $id = shmget($key, 1, 0);
}

# ensure integerhood in case of leading '0x'
$base = oct($base) if $base =~ /^0/;
$offset = oct($offset) if $offset =~ /^0/;
$print_length = oct($print_length) if $print_length =~ /^0/;

if ( ! shmctl($id, &IPC_STAT, $shmid_ds))
{
    die "shmctl(2) for id $id failed -- (I was trying to get size): $!";
}

# Pick the length out.
# It is at byte offset 0x30 on hpux9 and probably hpux10
# Also get the key if we don't have it already.  Don't need it tho...
$length = unpack("I", substr($shmid_ds, 0x30, 4));
$key = unpack("I", substr($shmid_ds, 0x14, 4)) if ! $key;

# poke around looking for length and key
# print "I guess: length: $length,  key: $key\n";
# print "****$shmid_ds****\n"; die "";

# make sure offset and print length make sense
$print_length = $length if ! $print_length;
if (($offset + $print_length) > $length)
{
    die "offset ($offset) and length ($print_length) go beyond end of segment ($length bytes)";
}

printf("KEY: 0x%X (%d)  ", $key, $key) if ($key);
printf "ID: $id\n";
printf "   %d bytes (0x%X), %d words, logical base is 0x%X\n",
       $length, $length, $length / 4, $base;
if ($offset || ($print_length != $length))
{
    printf "   printing %X (%d) bytes starting at offset 0x%X (%d)\n",
           $print_length, $print_length, $offset, $offset;
}
printf "\n";

if ( ! shmread($id, $shm_data, $offset, $print_length))
{
    die "could not attach and read from shmid $id: $!";
}

# the dump code below derived from "Real Perl Programs" example "xdump"
# from Camel book

$base += $offset;
$offset = 0;
for ($len = $print_length; $len >= 16; )
{
    $data = substr($shm_data, $offset, 16);

    @array = unpack('N4', $data);
    $data =~ tr/\0-\37\177-\377/./;
    printf "%8.8lX   %8.8lX %8.8lX %8.8lX %8.8lX   |%s|\n",
            $base, @array, $data;

    $offset += 16;
    $base += 16;
    $len -= 16;
}

# Now finish up the end a byte at a time

if ($len)
{
    $data = substr($shm_data, $offset, $len);
    @array = unpack('C*', $data);
    for (@array) 
    {
        $_ = sprintf('%2.2X', $_);
    }

    push(@array, '  ') while $len++ < 16;

    $data =~ tr/\0-\37\177-\377/./;
    $data =~ s/[^ -~]/./g;

    printf "%8.8lX   ", $base;
    printf "%s%s%s%s %s%s%s%s %s%s%s%s %s%s%s%s   |%-16s|\n",
           @array, $data;
}