#!/usr/bin/perl -s -W

# Program to parse Superbase SBF files
# see file format docs at:
# http://isrc.interapps.com/file_formats/thesuperbasedatafile..sbf..htm

# Copyright (C) 2008  Gemma Peter
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.


use strict;

undef $/;

my $sbf_file = $ARGV[0];

my $header;
open(FH,$sbf_file) or die('Couldn\'t open file');

sysread(FH,$header,60);

# get the file info from the header
my %fileinfo;

($fileinfo{'DChain'},
$fileinfo{'DCount'},
$fileinfo{'SerialNo'},
$fileinfo{'NumRecs'},
$fileinfo{'NumberBlocks'},
$fileinfo{'BlockSize'},
$fileinfo{'NumUsers'},
$fileinfo{'NumWrite'},
$fileinfo{'Reserved'},
$fileinfo{'Version'},
$fileinfo{'AVersion'}) = 
unpack("H8 H8 L L L S C C H66 S C",$header);

###DEBUG###
#print "DChain: ".$fileinfo{'DChain'}."\n";
#print "DCount: ".$fileinfo{'DCount'}."\n";
#print "SerialNo: ".$fileinfo{'SerialNo'}."\n";
#print "NumRecs: ".$fileinfo{'NumRecs'}."\n";
#print "NumberBlocks: ".$fileinfo{'NumberBlocks'}."\n";
#print "BlockSize: ".$fileinfo{'BlockSize'}."\n";
#print "NumUsers: ".$fileinfo{'NumUsers'}."\n";
#print "NumWrite: ".$fileinfo{'NumWrite'}."\n";
#print "Reserved: ".$fileinfo{'Reserved'}."\n";
#print "Version: ".$fileinfo{'Version'}."\n";
#print "AVersion: ".$fileinfo{'AVersion'}."\n"; 

# now look at each block and make array of records

my @records;
my $CurrentRecord = '';

my $i = 1;
while ($i <= $fileinfo{'NumberBlocks'})
{
	my $block;
  my $offset = $i * $fileinfo{'BlockSize'};
  sysseek(FH,$offset,0);
	sysread(FH,$block,$fileinfo{'BlockSize'}); 
	
	my $NextPointer;
	my $RecordFlags;
	my $RecordData;
	($NextPointer, $RecordFlags, $RecordData) = unpack("H6 B8 a124",$block);
  
	###DEBUG###
	#print $RecordFlags."\n";
	#print $NextPointer."\n";
	#print $RecordData."\n";
	#print $block."\n";
  #print $i.": ".$RecordData."\n";	


	# records can span more than one block, the RecordFlags are used to determine the start of a new record
  if ($RecordFlags eq '10000000') #we have a new record
	{
		#push old one onto pile
		push(@records,$CurrentRecord);
		$CurrentRecord = '';
	}
  
	$CurrentRecord .= $RecordData;

  $i++; #next block  
}

close(FH);


exit;