# fix.pl -- 
# Author          : Simon E Spero
# Created On      : Wed Aug 14 12:32:49 1991
# Next Modified By: Simon E Spero
# Next Modified On: Wed Aug 14 16:58:46 1991
# Update Count    : 87
# Status          : Tested on: pmax, sun4

# This package provides a set of functions for working on files containing
# fixed length records. It simulates BASIC+ virtual arrays (I knew I'd seen
# them somewhere before, Larry). 
#
#      functions: fixopen($name,$format) - open a fix-file
#                 fixclose($handle) - closes a file
#                 fixget($handle,$indices)  - get some records
#                 fixset($handle,$index,$values)  - store a record
#                 fixmax($handle)  - number of records - 1
#
#

#
# This package conforms to Tom Christiansen's exception standard [except.pl]
#
#  Exception strings are of the form 
#   EXCEPTION: tag[,tag]* '(' Explanation ')\n'
# eg:
#   EXCEPTION: SEEK,IO,FIX ( Seek to end of file failed )
# 
#  the following exception tags are used
#
# 
#   OPEN_WRITE, OPEN_READ  : botched open
#   SEEK                   : bothched seek
#   TELL                   : botched tell
#   READ                   : failed read
#   WRITE                  : failed write
#   IO                     : IO error
#   ARGUMENTS              : bad arguments to subroutine
#   FIX                    : error in this package
#


package fix;

#
# global variables
#
# %format 
# %size
# %next 

$template='KillerWombatsFromHell00';

#
# raise an exception
#
sub raise {
    die "EXCEPTION: $_[0]\n";
}


	

#                                                                   
# $handle = &fixopen(file,format)
#   format should either be suitable for pack/unpack 
#   or a number. The pack format must be  a constant size (no '*')

sub main'fixopen {
    local($file,$format) =@_;

    local($handle,$size,$type,$cnt);
    local($foo,$bar,$gorp,$x,$y,$z,$a,$b,$aleph,$bet,$_);
    if ($format+0 eq $format) {
	$size = $format;
    } else {
	$format =~ /\*/ &&
	    &raise("ARGUMENTS,FIX ($format is variable length in fixopen)");
	$format =~ s/\s//g;
	$size = length(pack($format,"a wombat of substance"));
    }
    $size ||
	&raise("ARGUMENTS,FIX ($format has size 0 in fixopen)");

    $DEBUG && print STDERR "fixopen($file,$format) - size = $size\n";

    $handle = $template++;

     if (! -f $file || -w $file) {
	 open($handle,"+>>$file") || 
	     &raise("OPEN_WRITE,FIX,IO (can't open $file in fixopen)");
     } else {
	 open($handle,"$file") ||
	     &raise("OPEN_READ,FIX,IO (can't open $file in fixopen)");
     }
    $format{$handle} = $format;
    $size{$handle} = $size;
    $next{$handle} = -1;
    return $handle;
}

#
# fixclose($handle)
#

sub main'fixclose {
    local($handle) = @_;
    
    $size{$handle} || 
	&raise("FIX (unknown handle $handle)");
    close($handle);
    delete $size{$handle};
    delete $format{$handle};
    delete $next{$handle};
}


#
# $x = fixget(handle,index)  $x == $handle[index]
# @x = fixget(handle,index)  @x == unpack(format, $handle[index])
# @y = fixget(handle,index,indices) @y = @handle[index,...indices]
#

sub main'fixget {
    local($handle);
    local($tmp,$size,$next);
    local(@tmp);
    $handle = shift(@_);
    ($size = $size{$handle}) ||
	&raise("FIX (unknown handle $handle)");
    $next = $next{$handle};
    if ($#_ == 0) {
	$next ==  $_[0] || 
	    seek($handle,$size * @_[0] ,0) || 
		&raise("SEEK,IO,FIX (can't seek in fixget)");
	if(read($handle,$tmp,$size) != $size) {
	    &raise("READ,IO,FIX (bad read in fixget)");
	}
	$next{$handle} = $_[0]+1;
	return (wantarray ?
	          unpack($format{$handle},$tmp) 
		: $tmp);
    } else {
	for (@_) {	       
	    $_ == $next ||
		seek($handle,$size * $_ ,0) || 
		    &raise("SEEK,IO,FIX (can't seek in fixget)");
	    if(read($handle,$tmp,$size) != $size) {
		&raise("READ,IO,FIX (bad read in fixget)");
	    }
	    push(tmp,$tmp);
	    $next = $_ +1;
	}
	return @tmp;
	$next{$handle} = $next;
    }
}



#                                                                   
# fixset(handle,index,value)         $handle[index] = value
# fixset(handle,index,value,values)  $handle[index] = pack(format,value,values)
#

sub main'fixset {
    local($handle,$index);
    local($tmp,$size,$next);

    $handle=shift(@_);
    ($size = $size{$handle}) ||
	&raise("FIX (unknown handle $handle)");

    $next = $next{$handle};

    $index = shift(@_);

    if ($#_==0) {
	$tmp = @_[0];
    } else {
	$tmp=pack($format{$handle},@_);
    }
    length($tmp) == $size || 
	&raise("ARGUMENTS,FIX (value wrong size in fixset)");

    $next == $_ ||
	seek($handle,$size * $_ ,0) || 
	    &raise("SEEK,IO,FIX (can't seek in fixset)");

    (print $handle $tmp) ||
	&raise("WRITE,IO,FIX (can't write to file)");
    

}

#
# $size = fixmax(handle) 
#

sub main'fixmax {
    local($handle) =@_;
    local($size);

    ($size = $size{$handle}) ||
	&raise("FIX (unknown handle $handle)");
    seek($handle,0,2) || 
	&raise("SEEK,IO,FIX (can't seek in fixmax)");
    return tell($handle)/$size  - 1;

}

######
######
######
1;
