use strict;
use warnings;
use POSIX qw(floor);

sgt_header(5);
# call sgt_item 5 times with appropriate values.

sub sgt_header {
  # You need to know how many rows you will be writing
  my $items = shift;
  print pack("V",0x0740); # Magic number?
  print pack("V",11); # Major version number?
  print pack("V",144); # Possibly minor version?
  print pack("V",$items); # Number of rows
  print pack('a2xxx','Gr'); # Not sure yet - have seen this change
}

sub sgt_item {
  # $stock is a hash reference, you may want to use odbc
  # connector to sage to get most of these fields other
  # than the actual stock quantity
  my $stock = shift;
  # obviously these should be generated somewhere
  my $date = '07/07/2009';
  my $reference = 'STK TAKE';

  # The first section of each item is a null padded and 
  # null terminated ascii stock code to 30 chars
  # (the maximum length of a stock code)
  print pack('a30x',$stock->{stock_code});
  # maximum description length is 60, again null padded
  # and null terminated
  print pack('a60x',$stock->{description});
  # same for date and reference
  print pack('a10x',$date);
  print pack('a8x',$reference);
  # Four numbers follow of 64 bits long each, see num sub.
  # Actual qty counted, price, previous qty in stock
  # and finally the adjustment. It is odd that sage needs
  # anything more than just the adjustment, and I have no
  # idea what might happen if you give it the wrong values
  # for everything else.
  print num($stock->{qty_actual});
  print num($stock->{last_purchase_price});
  print num($stock->{qty_in_stock});
  print num($stock->{qty_stocktake} - $stock->{qty_in_stock});
}

sub num {
  # This is the "interesting" function that took all the
  # thinking. Everything else is fairly obvious if you 
  # take a look at the files.
  # See explanation in post
  # We're using 64 bit maths here, so don't warn about it
  no warnings 'portable';
  my $in = shift;
  # zero appears to be inconsistent with the formula, so
  # check for that first.
  return pack('H16','0000000000000080') if (!defined($in) || $in == 0);
  # Is there a better way to check sign?
  my $offset = ($in == abs($in)) ? 0x3ff : 0xbff;
  $in = abs($in);
  my $pow=floor(log($in)/log(2));
  my $lbound = 2**$pow;
  my $highbits = ($pow+$offset)*0x10000000000000;
  my $lowbits = (($in-$lbound)/$lbound)*0x10000000000000;
  return pack('Q',$highbits | $lowbits);
}